Skip to content

Commit

Permalink
more documentation
Browse files Browse the repository at this point in the history
  • Loading branch information
@jan-imbi
jan-imbi committed Sep 20, 2023
1 parent 30d8ea4 commit 7a29ffc
Show file tree
Hide file tree
Showing 16 changed files with 738 additions and 478 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@ Collate:
'mlmse_score.R'
'n2c2_helpers.R'
'twostagedesign_with_cache.R'
'plot_design.R'
'plot.R'
'priors.R'
'print.R'
URL: https://jan-imbi.github.io/adestr/
Expand Down
14 changes: 12 additions & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ S3method("[",EstimatorScoreResultList)
S3method(format,EstimatorScoreResultList)
export(Bias)
export(BiasReduced)
export(Centrality)
export(Coverage)
export(Expectation)
export(FirstStageSampleMean)
Expand Down Expand Up @@ -53,20 +54,29 @@ export(get_example_design)
export(get_example_statistics)
export(get_stagewise_estimators)
export(get_statistics_from_paper)
export(plot_p)
exportClasses(EstimatorScore)
exportClasses(IntervalEstimator)
exportClasses(PValue)
exportClasses(PointEstimator)
exportClasses(Statistic)
exportMethods(plot)
import(adoptr)
import(ggplot2)
import(ggpubr)
import(latex2exp)
import(methods)
importFrom(Rdpack,reprompt)
importFrom(cubature,hcubature)
importFrom(forcats,as_factor)
importFrom(future.apply,future_apply)
importFrom(ggplot2,facet_wrap)
importFrom(ggplot2,geom_line)
importFrom(ggplot2,geom_segment)
importFrom(ggplot2,geom_tile)
importFrom(ggplot2,ggplot)
importFrom(ggplot2,scale_color_manual)
importFrom(ggplot2,scale_fill_gradient)
importFrom(ggplot2,scale_x_continuous)
importFrom(ggpubr,theme_pubclean)
importFrom(grDevices,xy.coords)
importFrom(latex2exp,TeX)
importFrom(progressr,progressor)
Expand Down
37 changes: 24 additions & 13 deletions R/analyze.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,42 +52,54 @@ setMethod("analyze", signature("data.frame"),
warning("data_distribution was set to Normal because sigma was specified.")
data_distribution <- Normal(two_armed = data_distribution@two_armed)
}
if (!is.list(statistics)){
statistics <- list(statistics)
}
sdata <- summarize_data(data)
if (missing(sigma)){
sigma <- sqrt(sdata$svar)
if (is(data_distribution, "Normal")){
warning("data_distribution is of class Normal but sigma was not specified. Estimating sigma from the data.")
}
}
arglist <- c(sdata, design = design, sigma = sigma, two_armed = data_distribution@two_armed)
if (!is.list(statistics)){
statistics <- list(statistics)
if ((1L + data_distribution@two_armed) != sdata$n_groups){
stop(sprintf("Number of groups suggested by data_distribution is %i, but number of groups present in the data is %i.",
(1L + data_distribution@two_armed), sdata$n_groups))
}
test_val <-
if (is(data_distribution, "Normal"))
z_test(sdata$smean1,
sdata$n1,
if(data_distribution@two_armed) c(sdata$n_s1_g1, sdata$n_s1_g2) else sdata$n1,
sigma,
data_distribution@two_armed)
else
t_test(sdata$smean1,
sdata$svar1,
sdata$n1,
if(data_distribution@two_armed) c(sdata$n_s1_g1, sdata$n_s1_g2) else sdata$n1,
data_distribution@two_armed)
if (length(statistics)>1) {
if (abs(sdata@n1 - design@n1 * (1L + data_distribution@two_armed))/ (design@n1 * (1L + data_distribution@two_armed)) > 0.1)
warning("Planned first-stage sample size differs from actually observed sample size by more than 10%. Results may be unreliable.")
if (abs(sdata@n_s1_g1 - design@n1)/ (design@n1) > 0.1)
warning("Planned first-stage sample size in group 1 differs from actually observed sample size by more than 10%. Results may be unreliable.")
if (data_distribution@two_armed){
if (abs(sdata@n_s1_g2 - design@n1)/ (design@n1) > 0.1)
warning("Planned first-stage sample size in group 2 differs from actually observed sample size by more than 10%. Results may be unreliable.")
}
calc_n2 <- n2(design, test_val, round=FALSE)
if (sdata$n_stages==2L){
obs_n2 <- sdata@n2
if (abs(obs_n2 - calc_n2 * (1L + data_distribution@two_armed))/ (calc_n2 * (1L + data_distribution@two_armed)) > 0.1)
warning("Planned second-stage sample size differs from actually observed sample size by more than 10%. Results may be unreliable.")
if (abs(sdata@n_s2_g1 - calc_n2 )/ (calc_n2) > 0.1)
warning("Planned second-stage sample size in group 1 differs from actually observed sample size by more than 10%. Results may be unreliable.")
if (data_distribution@two_armed) {
if (abs(sdata@n_s2_g2 - calc_n2 )/ (calc_n2) > 0.1)
warning("Planned second-stage sample size in group 2 differs from actually observed sample size by more than 10%. Results may be unreliable.") }
if (test_val > design@c1e | test_val < design@c1f)
warning("Second-stage data was recorded but trial should have been stopped at interim. Results may be unreliable.")
}
if (test_val <= design@c1e & test_val >= design@c1f & sdata$n_stages==1L)
warning("Calculating statics for interim data, although the trial should continue to the second stage. Results may be unreliable.")
if (test_val <= design@c1e & test_val >= design@c1f & sdata$n_stages==1L &
!all(sapply(statistics, \(x) is(x, "RepeatedCI")||is(x, "LinearShiftRepeatedPValue")))) {
warning("Calculating final statics for interim data, although the trial should continue to the second stage. Results may be unreliable.")
}
}
arglist <- c(sdata, design = design, sigma = sigma, two_armed = data_distribution@two_armed)
results <- lapply(statistics, .analzye,
data_distribution = data_distribution,
use_full_twoarm_sampling_distribution = use_full_twoarm_sampling_distribution,
Expand Down Expand Up @@ -146,7 +158,6 @@ summarize_data <- function(data, reference_value = 0, endpoint_name = "endpoint"
if (! (group_name %in% names(data)) ){
stop(sprintf("no variable with the name %s is present in data.", group_name))
}

if (!is.factor(data$group))
stop("group needs to be a factor.")
if (length(levels(data$group)) > 2L )
Expand Down

0 comments on commit 7a29ffc

Please sign in to comment.