From cee044ab4fc079ed69c8741301bec309482e3801 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Mon, 1 Jul 2024 09:20:25 +0100 Subject: [PATCH 01/39] simulation vignette updated to quarto --- vignettes/Simulation_Example_Quarto.qmd | 154 ++++++++++++++++++++++++ 1 file changed, 154 insertions(+) create mode 100644 vignettes/Simulation_Example_Quarto.qmd diff --git a/vignettes/Simulation_Example_Quarto.qmd b/vignettes/Simulation_Example_Quarto.qmd new file mode 100644 index 0000000..fbdb120 --- /dev/null +++ b/vignettes/Simulation_Example_Quarto.qmd @@ -0,0 +1,154 @@ +--- +title: "Simulation Example of Bayesian MCPMod for Continuous Data" +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(BayesianMCPMod) +library(clinDR) +library(dplyr) + +set.seed(7015) +``` + +# Background and data + +In this vignette, we will show the use of the Bayesian MCPMod package for trial planning for continuous distributed data. +As in [the analysis example vignette](analysis_normal.html), we focus on the indication MDD and make use of historical data that is included in the clinDR package. +More specifically, trial results for BRINTELLIX will be utilized to establish an informative prior for the control group. + +# Calculation of a MAP prior +In a first step, a meta analytic predictive prior will be calculated using historical data from 5 trials with main endpoint Change from baseline in MADRS score after 8 weeks. +Please note that only information from the control group will be integrated leading to an informative mixture prior for the control group, while for the active groups a non-informative prior will be specified. + +```{r Historical Data} +data("metaData") +testdata <- as.data.frame(metaData) +dataset <- filter(testdata, bname == "BRINTELLIX") +histcontrol <- filter(dataset, dose == 0, primtime == 8, indication == "MAJOR DEPRESSIVE DISORDER") + +hist_data <- data.frame( + trial = histcontrol$nctno, + est = histcontrol$rslt, + se = histcontrol$se, + sd = histcontrol$sd, + n = histcontrol$sampsize) + +sd_tot <- with(hist_data, sum(sd * n) / sum(n)) +``` +We will make use of the same getPriorList() function as in the [analysis example vignette](analysis_normal.html) to create a MAP prior. +```{r Setting Prior without execution, eval = FALSE} +dose_levels <- c(0, 2.5, 5, 10, 20) + +prior_list <- getPriorList( + hist_data = hist_data, + dose_levels = dose_levels, + robust_weight = 0.3) +``` +```{r Setting Prior, echo = FALSE} +dose_levels <- c(0, 2.5, 5, 10, 20) + +prior_list <- list( + Ctr = RBesT::mixnorm( + comp1 = c(w = 0.446213, m = -12.774661, s = 1.393130), + comp1 = c(w = 0.253787, m = 3.148116, s = 3.148116), + robust = c(w = 0.3, m = 9.425139, s = 9.425139), + sigma = sd_tot), + DG_1 = RBesT::mixnorm( + comp1 = c(w = 1, m = -12.816875, n = 1), + sigma = sd_tot, + param = "mn"), + DG_2 = RBesT::mixnorm( + comp1 = c(w = 1, m = -12.816875, n = 1), + sigma = sd_tot, + param = "mn"), + DG_3 = RBesT::mixnorm( + comp1 = c(w = 1, m = -12.816875, n = 1), + sigma = sd_tot, + param = "mn"), + DG_4 = RBesT::mixnorm( + comp1 = c(w = 1, m = -12.816875, n = 1), + sigma = sd_tot, + param = "mn") +) +``` + +# Specification of new trial design + +For the hypothetical new trial, we plan with 4 active dose levels \eqn{2.5, 5, 10, 20} and we specify a broad set of potential dose-response relationships, including a linear, an exponential, an emax and 2 sigEMax models. +Furthermore, we assume a maximum effect of -3 on top of control (i.e. assuming that active treatment can reduce the MADRS score after 8 weeks by up to 15.8) and plan a trial with 80 patients for all active groups and 60 patients for control. +```{r} +exp <- DoseFinding::guesst( + d = 5, + p = c(0.2), + model = "exponential", + Maxd = max(dose_levels)) + +emax <- DoseFinding::guesst( + d = 2.5, + p = c(0.9), + model = "emax") + +sigemax <- DoseFinding::guesst( + d = c(2.5, 5), + p = c(0.1, 0.6), + model = "sigEmax") + +sigemax2 <- DoseFinding::guesst( + d = c(2, 4), + p = c(0.3, 0.8), + model = "sigEmax") + +mods <- DoseFinding::Mods( + linear = NULL, + emax = emax, + exponential = exp, + sigEmax = rbind(sigemax, sigemax2), + doses = dose_levels, + maxEff = -3, + placEff = -12.8) + +n_patients <- c(60, 80, 80, 80, 80) +``` + +# Calculation of success probabilities + +To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. +For illustration purposes, the number of simulated trial results is reduced to 100 in this example. +```{r} +success_probabilities <- assessDesign( + n_patients = n_patients, + mods = mods, + prior_list = prior_list, + sd = sd_tot, + n_sim = 100) # speed up example run-time + +success_probabilities +``` +As an alternative, we will evaluate a design with the same overall sample size but allocating more patients on the highest dose group and control. +```{r} +success_probabilities_uneq <- assessDesign( + n_patients = c(80, 60, 60, 60, 120), + mods = mods, + prior_list = prior_list, + sd = sd_tot, + n_sim = 100) # speed up example run-time +success_probabilities_uneq +``` \ No newline at end of file From a0f6e33ea1034a2418f4b107ce82eb2960156912 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 2 Jul 2024 10:09:53 +0100 Subject: [PATCH 02/39] analysis vignette with uninformative prior --- vignettes/analysis_normal_update.qmd | 218 +++++++++++++++++++++++++++ 1 file changed, 218 insertions(+) create mode 100644 vignettes/analysis_normal_update.qmd diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd new file mode 100644 index 0000000..ae6c99b --- /dev/null +++ b/vignettes/analysis_normal_update.qmd @@ -0,0 +1,218 @@ +--- +title: "Analysis Example of Bayesian MCPMod for Continuous Data" +output: rmarkdown::html_vignette +number_sections: true +vignette: > + %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +devtools::load_all() +#library(BayesianMCPMod) +library(clinDR) +library(dplyr) + +set.seed(7015) +``` + +# Background and data + +In this vignette we will show the use of the Bayesian MCPMod package for continuous distributed data. +The focus lies on the utilization of an informative prior and the Bayesian MCPMod evaluation of a single trial. +We will use data that is included in the clinDR package. +More specifically, trial results of BRINTELLIX will be used to illustrate the specification of an informative prior and the usage of such a prior for the Bayesian evaluation of a (hypothetical) new trial. +BRINTELLIX is a medication used to treat major depressive disorder. +Various clinical trials with different dose groups, including control groups, were conducted. + +# Prior Specification + +Ideally, priors are grounded in historical data. This approach allows for the synthesis of +prior knowledge with current data, enhancing the accuracy of trial evaluations. + +The focus of this vignette is more generic, however. We specify weakly-informative +priors across all dose groups to allow the trial data to have a stronger influence on the analysis. + +```{r} +dose_levels <- c(0, 2.5, 5, 10) + +prior_list <- lapply(dose_levels, function(dose_group) { + RBesT::mixnorm(weak = c(w = 1, m = 0, s = 200), sigma = 10) +}) + +names(prior_list) <- c("Ctr", paste0("DG_", dose_levels[-1])) +``` +# Specifications for the new trial + +To be able to apply the Bayesian MCPMod approach, candidate models need to be specified using functions from the R package DoseFinding. +Since there are only 3 active dose levels we will limit the set of candidate models to a linear, an exponential, and an emax model. +Note that the linear candidate model does not require a guesstimate. +```{r Pre-Specification of candidate models} +exp_guesst <- DoseFinding::guesst( + d = 5, + p = c(0.2), + model = "exponential", + Maxd = max(dose_levels)) + +emax_guesst <- DoseFinding::guesst( + d = 2.5, + p = c(0.9), + model = "emax") + +mods <- DoseFinding::Mods( + linear = NULL, + emax = emax_guesst, + exponential = exp_guesst, + doses = dose_levels, + maxEff = -1, + placEff = -12.8) +``` +We will use the trial with ct.gov number NCT00735709 as exemplary new trial. +```{r new trial} +data("metaData") +dataset <- filter(as.data.frame(metaData), bname == "BRINTELLIX") + +new_trial <- filter( + dataset, + primtime == 8, + indication == "MAJOR DEPRESSIVE DISORDER", + protid == 5) + +n_patients <- c(128, 124, 129, 122) +``` +# Combination of prior information and trial results +As outlined in Fleischer et al. [Bayesian MCPMod. Pharmaceutical Statistics. 2022; 21(3): 654-670.], in a first step the posterior is calculated combining the prior information with the estimated results of the new trial. Via the summary function it is possible to print out the summary information of the posterior distributions. +```{r Trial results} +posterior <- getPosterior( + prior = prior_list, + mu_hat = new_trial$rslt, + se_hat = new_trial$se, + calc_ess = TRUE) + +summary(posterior) +``` +# Execution of Bayesian MCPMod Test step + +For the execution of the testing step of Bayesian MCPMod a critical value on the probability scale will be determined for a given alpha level. +This critical value is calculated using the re-estimated contrasts for the frequentist MCPMod to ensure that, when using non-informative priors, the actual error level for falsely declaring a significant trial in the Bayesian MCPMod is controlled by the specified alpha level. + +A pseudo-optimal contrast matrix is generated based on the variability of the posterior distribution (see Fleischer et al. 2022 for more details). +```{r Preparation of input for Bayesian MCPMod Test step} +crit_pval <- getCritProb( + mods = mods, + dose_levels = dose_levels, + se_new_trial = new_trial$se, + alpha_crit_val = 0.05) + +contr_mat <- getContr( + mods = mods, + dose_levels = dose_levels, + sd_posterior = summary(posterior)[, 2]) +``` +Please note that there are different ways to derive the contrasts. +The following code shows the implementation of some of these ways but it is not executed and the contrast specification above is used. +```{r , eval = FALSE} +# i) the frequentist contrast +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + dose_weights = n_patients, + prior_list = prior_list) +# ii) re-estimated frequentist contrasts +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + se_new_trial = new_trial$se) +# iii) Bayesian approach using number of patients for new trial and prior distribution +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + dose_weights = n_patients, + prior_list = prior_list) +``` +The Bayesian MCP testing step is then executed based on the posterior information, the provided contrasts and the multiplicity adjusted critical value. +```{r Execution of Bayesian MCPMod Test step} +BMCP_result <- performBayesianMCP( + posterior_list = posterior, + contr = contr_mat, + crit_prob_adj = crit_pval) + +BMCP_result +``` +The testing step is significant indicating a non-flat dose-response shape. +In detail, all 3 models are significant and the p-value for the emax model indicates deviation from the null hypothesis the most. + +# Model fitting and visualization of results + +In the model fitting step the posterior distribution is used as basis. +Both simplified and full fitting are performed. +For the simplified fit, the multivariate normal distribution of the control group is approximated and reduced by a one-dimensional normal distribution. +The actual fit (on this approximated posterior distribution) is then performed using generalized least squares criterion. +In contrast, for the full fit, the non-linear optimization problem is addressed via the Nelder Mead algorithm. + +The output of the fit includes information about the predicted effects for the included dose levels, the generalized AIC, and the corresponding weights. +For the considered case, the simplified and the full fit are very similar. +```{r Model fitting} +# Option a) Simplified approach by using approximated posterior distribution +fit_simple <- getModelFits( + models = names(mods), + dose_levels = dose_levels, + posterior = posterior, + simple = TRUE) + +# Option b) Making use of the complete posterior distribution +fit <- getModelFits( + models = names(mods), + dose_levels = dose_levels, + posterior = posterior, + simple = FALSE) +``` +Via the predict() function, one can also receive estimates for dose levels that were not included in the trial. +```{r Predict} +predict(fit, doses = c(0, 2.5, 4, 5, 7, 10)) +``` +It is possible to plot the fitted dose response models and an AIC based average model (black lines). +```{r Plot simple vs fit} +plot(fit_simple) +plot(fit) +``` + +To assess the uncertainty, one can additionally visualize credible bands (orange shaded areas, default levels are 50% and 95%). +These credible bands are calculated with a bootstrap method as follows: +Samples from the posterior distribution are drawn and for every sample the simplified fitting step and a prediction is performed. +These predictions are then used to identify and visualize the specified quantiles. +```{r Plot with bootstrap} +plot(fit, cr_bands = TRUE) +``` + +The bootstrap based quantiles can also be directly calculated via the getBootstrapQuantiles() function. +For this example, only 6 quantiles are bootstrapped for each model fit. +```{r Bootstrap} +getBootstrapQuantiles( + model_fits = fit, + quantiles = c(0.025, 0.5, 0.975), + doses = c(0, 2.5, 4, 5, 7, 10), + n_samples = 6 +) +``` +Technical note: The median quantile of the bootstrap based procedure is not necessary similar to the main model fit, as they are derived via different procedures. +The main fit, i.e. the black lines in the plot, show the best fit of a certain model based on minimizing the residuals for the posterior distribution, while the bootstrap based 50% quantile shows the median fit of the random sampling and fitting procedure. + +# Additional note +It is also possible to perform the testing and modeling step in a combined fashion via the performBayesianMCPMod() function. +This code serves merely as an example and is not run in this vignette. +```{r, eval = FALSE} +performBayesianMCPMod( + posterior_list = posterior, + contr = contr_mat, + crit_prob_adj = crit_pval, + simple = FALSE) +``` From a2a8ffedcb74cc5b2796114a14ae86719aaa745c Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 2 Jul 2024 10:09:53 +0100 Subject: [PATCH 03/39] devtools --- vignettes/Simulation_Example_Quarto.qmd | 16 +- vignettes/analysis_normal_update.qmd | 218 ++++++++++++++++++++++++ 2 files changed, 224 insertions(+), 10 deletions(-) create mode 100644 vignettes/analysis_normal_update.qmd diff --git a/vignettes/Simulation_Example_Quarto.qmd b/vignettes/Simulation_Example_Quarto.qmd index fbdb120..6ed2fd7 100644 --- a/vignettes/Simulation_Example_Quarto.qmd +++ b/vignettes/Simulation_Example_Quarto.qmd @@ -1,16 +1,11 @@ --- title: "Simulation Example of Bayesian MCPMod for Continuous Data" -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - bibliography: references.bib +output: rmarkdown::html_vignette +number_sections: true vignette: > %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} @@ -21,7 +16,8 @@ knitr::opts_chunk$set( ``` ```{r setup} -library(BayesianMCPMod) +devtools::load_all() +#library(BayesianMCPMod) library(clinDR) library(dplyr) diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd new file mode 100644 index 0000000..ae6c99b --- /dev/null +++ b/vignettes/analysis_normal_update.qmd @@ -0,0 +1,218 @@ +--- +title: "Analysis Example of Bayesian MCPMod for Continuous Data" +output: rmarkdown::html_vignette +number_sections: true +vignette: > + %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +devtools::load_all() +#library(BayesianMCPMod) +library(clinDR) +library(dplyr) + +set.seed(7015) +``` + +# Background and data + +In this vignette we will show the use of the Bayesian MCPMod package for continuous distributed data. +The focus lies on the utilization of an informative prior and the Bayesian MCPMod evaluation of a single trial. +We will use data that is included in the clinDR package. +More specifically, trial results of BRINTELLIX will be used to illustrate the specification of an informative prior and the usage of such a prior for the Bayesian evaluation of a (hypothetical) new trial. +BRINTELLIX is a medication used to treat major depressive disorder. +Various clinical trials with different dose groups, including control groups, were conducted. + +# Prior Specification + +Ideally, priors are grounded in historical data. This approach allows for the synthesis of +prior knowledge with current data, enhancing the accuracy of trial evaluations. + +The focus of this vignette is more generic, however. We specify weakly-informative +priors across all dose groups to allow the trial data to have a stronger influence on the analysis. + +```{r} +dose_levels <- c(0, 2.5, 5, 10) + +prior_list <- lapply(dose_levels, function(dose_group) { + RBesT::mixnorm(weak = c(w = 1, m = 0, s = 200), sigma = 10) +}) + +names(prior_list) <- c("Ctr", paste0("DG_", dose_levels[-1])) +``` +# Specifications for the new trial + +To be able to apply the Bayesian MCPMod approach, candidate models need to be specified using functions from the R package DoseFinding. +Since there are only 3 active dose levels we will limit the set of candidate models to a linear, an exponential, and an emax model. +Note that the linear candidate model does not require a guesstimate. +```{r Pre-Specification of candidate models} +exp_guesst <- DoseFinding::guesst( + d = 5, + p = c(0.2), + model = "exponential", + Maxd = max(dose_levels)) + +emax_guesst <- DoseFinding::guesst( + d = 2.5, + p = c(0.9), + model = "emax") + +mods <- DoseFinding::Mods( + linear = NULL, + emax = emax_guesst, + exponential = exp_guesst, + doses = dose_levels, + maxEff = -1, + placEff = -12.8) +``` +We will use the trial with ct.gov number NCT00735709 as exemplary new trial. +```{r new trial} +data("metaData") +dataset <- filter(as.data.frame(metaData), bname == "BRINTELLIX") + +new_trial <- filter( + dataset, + primtime == 8, + indication == "MAJOR DEPRESSIVE DISORDER", + protid == 5) + +n_patients <- c(128, 124, 129, 122) +``` +# Combination of prior information and trial results +As outlined in Fleischer et al. [Bayesian MCPMod. Pharmaceutical Statistics. 2022; 21(3): 654-670.], in a first step the posterior is calculated combining the prior information with the estimated results of the new trial. Via the summary function it is possible to print out the summary information of the posterior distributions. +```{r Trial results} +posterior <- getPosterior( + prior = prior_list, + mu_hat = new_trial$rslt, + se_hat = new_trial$se, + calc_ess = TRUE) + +summary(posterior) +``` +# Execution of Bayesian MCPMod Test step + +For the execution of the testing step of Bayesian MCPMod a critical value on the probability scale will be determined for a given alpha level. +This critical value is calculated using the re-estimated contrasts for the frequentist MCPMod to ensure that, when using non-informative priors, the actual error level for falsely declaring a significant trial in the Bayesian MCPMod is controlled by the specified alpha level. + +A pseudo-optimal contrast matrix is generated based on the variability of the posterior distribution (see Fleischer et al. 2022 for more details). +```{r Preparation of input for Bayesian MCPMod Test step} +crit_pval <- getCritProb( + mods = mods, + dose_levels = dose_levels, + se_new_trial = new_trial$se, + alpha_crit_val = 0.05) + +contr_mat <- getContr( + mods = mods, + dose_levels = dose_levels, + sd_posterior = summary(posterior)[, 2]) +``` +Please note that there are different ways to derive the contrasts. +The following code shows the implementation of some of these ways but it is not executed and the contrast specification above is used. +```{r , eval = FALSE} +# i) the frequentist contrast +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + dose_weights = n_patients, + prior_list = prior_list) +# ii) re-estimated frequentist contrasts +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + se_new_trial = new_trial$se) +# iii) Bayesian approach using number of patients for new trial and prior distribution +contr_mat_prior <- getContr( + mods = mods, + dose_levels = dose_levels, + dose_weights = n_patients, + prior_list = prior_list) +``` +The Bayesian MCP testing step is then executed based on the posterior information, the provided contrasts and the multiplicity adjusted critical value. +```{r Execution of Bayesian MCPMod Test step} +BMCP_result <- performBayesianMCP( + posterior_list = posterior, + contr = contr_mat, + crit_prob_adj = crit_pval) + +BMCP_result +``` +The testing step is significant indicating a non-flat dose-response shape. +In detail, all 3 models are significant and the p-value for the emax model indicates deviation from the null hypothesis the most. + +# Model fitting and visualization of results + +In the model fitting step the posterior distribution is used as basis. +Both simplified and full fitting are performed. +For the simplified fit, the multivariate normal distribution of the control group is approximated and reduced by a one-dimensional normal distribution. +The actual fit (on this approximated posterior distribution) is then performed using generalized least squares criterion. +In contrast, for the full fit, the non-linear optimization problem is addressed via the Nelder Mead algorithm. + +The output of the fit includes information about the predicted effects for the included dose levels, the generalized AIC, and the corresponding weights. +For the considered case, the simplified and the full fit are very similar. +```{r Model fitting} +# Option a) Simplified approach by using approximated posterior distribution +fit_simple <- getModelFits( + models = names(mods), + dose_levels = dose_levels, + posterior = posterior, + simple = TRUE) + +# Option b) Making use of the complete posterior distribution +fit <- getModelFits( + models = names(mods), + dose_levels = dose_levels, + posterior = posterior, + simple = FALSE) +``` +Via the predict() function, one can also receive estimates for dose levels that were not included in the trial. +```{r Predict} +predict(fit, doses = c(0, 2.5, 4, 5, 7, 10)) +``` +It is possible to plot the fitted dose response models and an AIC based average model (black lines). +```{r Plot simple vs fit} +plot(fit_simple) +plot(fit) +``` + +To assess the uncertainty, one can additionally visualize credible bands (orange shaded areas, default levels are 50% and 95%). +These credible bands are calculated with a bootstrap method as follows: +Samples from the posterior distribution are drawn and for every sample the simplified fitting step and a prediction is performed. +These predictions are then used to identify and visualize the specified quantiles. +```{r Plot with bootstrap} +plot(fit, cr_bands = TRUE) +``` + +The bootstrap based quantiles can also be directly calculated via the getBootstrapQuantiles() function. +For this example, only 6 quantiles are bootstrapped for each model fit. +```{r Bootstrap} +getBootstrapQuantiles( + model_fits = fit, + quantiles = c(0.025, 0.5, 0.975), + doses = c(0, 2.5, 4, 5, 7, 10), + n_samples = 6 +) +``` +Technical note: The median quantile of the bootstrap based procedure is not necessary similar to the main model fit, as they are derived via different procedures. +The main fit, i.e. the black lines in the plot, show the best fit of a certain model based on minimizing the residuals for the posterior distribution, while the bootstrap based 50% quantile shows the median fit of the random sampling and fitting procedure. + +# Additional note +It is also possible to perform the testing and modeling step in a combined fashion via the performBayesianMCPMod() function. +This code serves merely as an example and is not run in this vignette. +```{r, eval = FALSE} +performBayesianMCPMod( + posterior_list = posterior, + contr = contr_mat, + crit_prob_adj = crit_pval, + simple = FALSE) +``` From e1e646969935b0f675c47f6107ce86edba49e8d3 Mon Sep 17 00:00:00 2001 From: Bossert Date: Thu, 4 Jul 2024 09:40:33 +0100 Subject: [PATCH 04/39] Addition in Simulation Example --- vignettes/Simulation_Example_Quarto.qmd | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/vignettes/Simulation_Example_Quarto.qmd b/vignettes/Simulation_Example_Quarto.qmd index 6ed2fd7..d177b37 100644 --- a/vignettes/Simulation_Example_Quarto.qmd +++ b/vignettes/Simulation_Example_Quarto.qmd @@ -147,4 +147,19 @@ success_probabilities_uneq <- assessDesign( sd = sd_tot, n_sim = 100) # speed up example run-time success_probabilities_uneq +``` + +For this specific trial setting the adapted allocation ratio leads to increased success probabilities under all assumed dose response relationships. + +Instead of specifying the assumed effects via the models it is also possible to directly specify the effects for the individual dose levels via the dr_means input. +This allows e.g. also the simulation of scenarios with a prior-data conflict. +```{r} +success_probabilities <- assessDesign( + n_patients = c(60, 80, 80, 80, 80), + mods = mods, + prior_list = prior_list, + sd = sd_tot, + dr_means = c(-12, -14, -15, -16, -17), + n_sim = 100) # speed up example run-time +success_probabilities ``` \ No newline at end of file From a0b061f454ca8b86c57b91a09080d30ae386af39 Mon Sep 17 00:00:00 2001 From: Bossert Date: Thu, 4 Jul 2024 09:47:20 +0100 Subject: [PATCH 05/39] Minor update, to be able to render --- vignettes/analysis_normal_noninformative.qmd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/vignettes/analysis_normal_noninformative.qmd b/vignettes/analysis_normal_noninformative.qmd index f1b5659..b6c0807 100644 --- a/vignettes/analysis_normal_noninformative.qmd +++ b/vignettes/analysis_normal_noninformative.qmd @@ -14,7 +14,8 @@ vignette: > --- ```{r setup} -library(BayesianMCPMod) +devtools::load_all() +#library(BayesianMCPMod) library(RBesT) library(clinDR) library(dplyr) From dafb2971ce5706368cf757b76e76acf5d14638c4 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Thu, 4 Jul 2024 10:42:00 +0100 Subject: [PATCH 06/39] update analysis vignette with informative prior --- vignettes/analysis_normal_update.qmd | 488 ++++++++++++++---- .../{ => outdatet}/Simulation_Example.Rmd | 0 vignettes/{ => outdatet}/analysis_normal.Rmd | 0 .../analysis_normal_noninformative.qmd | 0 4 files changed, 378 insertions(+), 110 deletions(-) rename vignettes/{ => outdatet}/Simulation_Example.Rmd (100%) rename vignettes/{ => outdatet}/analysis_normal.Rmd (100%) rename vignettes/{ => outdatet}/analysis_normal_noninformative.qmd (100%) diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd index ae6c99b..c50c579 100644 --- a/vignettes/analysis_normal_update.qmd +++ b/vignettes/analysis_normal_update.qmd @@ -1,125 +1,348 @@ --- title: "Analysis Example of Bayesian MCPMod for Continuous Data" -output: rmarkdown::html_vignette -number_sections: true +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + bibliography: references.bib vignette: > %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} --- -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` ```{r setup} devtools::load_all() #library(BayesianMCPMod) +library(RBesT) library(clinDR) library(dplyr) +library(tibble) +library(reactable) set.seed(7015) ``` -# Background and data +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false -In this vignette we will show the use of the Bayesian MCPMod package for continuous distributed data. -The focus lies on the utilization of an informative prior and the Bayesian MCPMod evaluation of a single trial. -We will use data that is included in the clinDR package. -More specifically, trial results of BRINTELLIX will be used to illustrate the specification of an informative prior and the usage of such a prior for the Bayesian evaluation of a (hypothetical) new trial. -BRINTELLIX is a medication used to treat major depressive disorder. -Various clinical trials with different dose groups, including control groups, were conducted. +#' Display Parameters Table +#' +#' This function generates a markdown table displaying the names and values of parameters +#' from a named list. +#' +#' @param named_list A named list where each name represents a parameter name and the list +#' element represents the parameter value. Date values in the list are automatically +#' converted to character strings for display purposes. +#' +#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". +#' The function does not return a value but displays the table directly to the output. +#' +#' @importFrom knitr kable +#' @examples +#' params <- list("Start Date" = as.Date("2020-01-01"), +#' "End Date" = as.Date("2020-12-31"), +#' "Threshold" = 10) +#' display_params_table(params) +#' +#' @export +display_params_table <- function(named_list) { + display_table <- data.frame() + value_names <- data.frame() + for (i in 1:length(named_list)) { + # dates will display as numeric by default, so convert to char first + if (class(named_list[[i]]) == "Date") { + named_list[[i]] = as.character(named_list[[i]]) + } + if (!is.null(names(named_list[[i]]))) { + value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) + } + values <- data.frame(I(list(named_list[[i]]))) + display_table <- rbind(display_table, values) + } + + round_numeric <- function(x, digits = 3) { + if (is.numeric(x)) { + return(round(x, digits)) + } else { + return(x) + } + } + + display_table[1] <- lapply(display_table[1], function(sublist) { + lapply(sublist, round_numeric) + }) + + class(display_table[[1]]) <- "list" + + if (nrow(value_names) == 0) { + knitr::kable( + cbind(names(named_list), display_table), + col.names = c("Name", "Value") + ) + } else { + knitr::kable( + cbind(names(named_list), value_names, display_table), + col.names = c("Name", "Value Labels", "Value") + ) + } +} +``` -# Prior Specification +# Introduction -Ideally, priors are grounded in historical data. This approach allows for the synthesis of -prior knowledge with current data, enhancing the accuracy of trial evaluations. +This vignette demonstrates the application of the {BayesianMCPMod} package for +analyzing a phase 2 dose-finding trial using the Bayesian MCPMod approach. -The focus of this vignette is more generic, however. We specify weakly-informative -priors across all dose groups to allow the trial data to have a stronger influence on the analysis. +# Calculation of a MAP prior -```{r} +In a first step, a meta analytic prior will be calculated using historical data from 4 trials with main endpoint Change from baseline in MADRS score after 8 weeks. +Please note that only information from the control group will be integrated leading to an informative mixture prior for the control group, while for the active groups a non-informative prior will be specified. +```{r Historical Data for Control Arm} +data("metaData") +dataset <- filter(as.data.frame(metaData), bname == "BRINTELLIX") +histcontrol <- filter( + dataset, + dose == 0, + primtime == 8, + indication == "MAJOR DEPRESSIVE DISORDER", + protid != 5) + +hist_data <- data.frame( + trial = histcontrol$nctno, + est = histcontrol$rslt, + se = histcontrol$se, + sd = histcontrol$sd, + n = histcontrol$sampsize) +``` +Here, we suggest a function to construct a list of prior distributions for the different dose groups. +This function is adapted to the needs of this example. +Other applications may need a different way to construct prior distributions. +```{r Defining MAP prior function} +getPriorList <- function ( + + hist_data, + dose_levels, + dose_names = NULL, + robust_weight = 0.5 + +) { + + sd_tot <- with(hist_data, sum(sd * n) / sum(n)) + + gmap <- RBesT::gMAP( + formula = cbind(est, se) ~ 1 | trial, + weights = hist_data$n, + data = hist_data, + family = gaussian, + beta.prior = cbind(0, 100 * sd_tot), + tau.dist = "HalfNormal", + tau.prior = cbind(0, sd_tot / 4)) + + prior_ctr <- RBesT::automixfit(gmap) + + if (!is.null(robust_weight)) { + + prior_ctr <- suppressMessages(RBesT::robustify( + priormix = prior_ctr, + weight = robust_weight, + sigma = sd_tot)) + + } + + prior_trt <- RBesT::mixnorm( + comp1 = c(w = 1, m = summary(prior_ctr)[1], n = 1), + sigma = sd_tot, + param = "mn") + + prior_list <- c(list(prior_ctr), + rep(x = list(prior_trt), + times = length(dose_levels[-1]))) + + if (is.null(dose_names)) { + + dose_names <- c("Ctr", paste0("DG_", seq_along(dose_levels[-1]))) + + } + + names(prior_list) <- dose_names + + return (prior_list) + +} +``` +With the dose levels to be investigated, the prior distribution can be constructed. +```{r Getting the MAP prior} dose_levels <- c(0, 2.5, 5, 10) -prior_list <- lapply(dose_levels, function(dose_group) { - RBesT::mixnorm(weak = c(w = 1, m = 0, s = 200), sigma = 10) -}) +prior_list <- getPriorList( + hist_data = hist_data, + dose_levels = dose_levels, + robust_weight = 0.3) -names(prior_list) <- c("Ctr", paste0("DG_", dose_levels[-1])) +getESS(prior_list) ``` -# Specifications for the new trial -To be able to apply the Bayesian MCPMod approach, candidate models need to be specified using functions from the R package DoseFinding. -Since there are only 3 active dose levels we will limit the set of candidate models to a linear, an exponential, and an emax model. -Note that the linear candidate model does not require a guesstimate. -```{r Pre-Specification of candidate models} -exp_guesst <- DoseFinding::guesst( - d = 5, - p = c(0.2), - model = "exponential", - Maxd = max(dose_levels)) +# Dose-Response Model Shapes +Candidate models are specified using the {DoseFinding} package. Models can be +parameterized using guesstimates or by directly providing distribution parameters. +Note that the linear candidate model does not require parameterization. + +[**Note:** The LinLog model is rarely used and not currently supported by `{BayesianMCPMod}`.]{.aside} + +In the code below, the models are "guesstimated" using the `DoseFinding::guesst` function. +The `d` option usually takes a single value (a dose level), and the corresponding `p` +for the maximum effect achieved at `d`. + + +```{r} +# Guesstimate estimation +exp_guesst <- DoseFinding::guesst( + model = "exponential", + d = 5, p = 0.2, Maxd = max(dose_levels) +) emax_guesst <- DoseFinding::guesst( - d = 2.5, - p = c(0.9), - model = "emax") + model = "emax", + d = 2.5, p = 0.9 +) +sigEmax_guesst <- DoseFinding::guesst( + model = "sigEmax", + d = c(2.5, 5), p = c(0.5, 0.95) +) +logistic_guesst <- DoseFinding::guesst( + model = "logistic", + d = c(5, 10), p = c(0.1, 0.85) +) +``` + +In some cases, you need to provide more information. For instance, `sigEmax` +requires a pair of `d` and `p` values, and `exponential` requires the specification of +the maximum dose for the trial (`Maxd`). + +[See the help files for model specifications by typing `?DoseFinding::guesst` in your console]{.aside} + + +Of course, you can also specify the models directly on the parameter scale (without using `DoseFinding::guesst`). + +For example, you can get a betaMod model by specifying `delta1` and `delta2` +parameters (`scale` is assumed to be `1.2` of the maximum dose), or a quadratic model with the `delta2` parameter. + +```{r} +betaMod_params <- c(delta1 = 1, delta2 = 1) +quadratic_params <- c(delta2 = -0.1) +``` + +Now, we can go ahead and create a `Mods` object, which will be used in the remainder +of the vignette. + +```{r} mods <- DoseFinding::Mods( linear = NULL, - emax = emax_guesst, + # guesstimate scale exponential = exp_guesst, + emax = emax_guesst, + sigEmax = sigEmax_guesst, + logistic = logistic_guesst, + # parameter scale + betaMod = betaMod_params, + quadratic = quadratic_params, + # Options for all models doses = dose_levels, maxEff = -1, - placEff = -12.8) + placEff = -12.8 +) + +plot(mods) ``` -We will use the trial with ct.gov number NCT00735709 as exemplary new trial. -```{r new trial} + +The `mods` object we just created above contains the full model parameters, which can be helpful for +understanding how the guesstimates are translated onto the parameter scale. + +```{r} +display_params_table(mods) +``` + +And we can see the assumed treatment effects for the specified dose groups below: + +```{r} +knitr::kable(DoseFinding::getResp(mods, doses = dose_levels)) +``` + +## Trial Data + +We will use the trial with ct.gov number NCT00735709 as our phase 2 trial data, +available in the `{clinDR}` package [@nct00735709_2024a]. + +```{r} data("metaData") -dataset <- filter(as.data.frame(metaData), bname == "BRINTELLIX") -new_trial <- filter( - dataset, - primtime == 8, +trial_data <- dplyr::filter( + dplyr::filter(tibble::tibble(metaData), bname == "BRINTELLIX"), + primtime == 8, indication == "MAJOR DEPRESSIVE DISORDER", - protid == 5) + protid == 5 +) n_patients <- c(128, 124, 129, 122) ``` -# Combination of prior information and trial results -As outlined in Fleischer et al. [Bayesian MCPMod. Pharmaceutical Statistics. 2022; 21(3): 654-670.], in a first step the posterior is calculated combining the prior information with the estimated results of the new trial. Via the summary function it is possible to print out the summary information of the posterior distributions. -```{r Trial results} + +# Posterior Calculation + +In the first step of Bayesian MCPMod, the posterior is calculated by combining +the prior information with the estimated results of the trial [@fleischer_2022]. + +```{r} posterior <- getPosterior( - prior = prior_list, - mu_hat = new_trial$rslt, - se_hat = new_trial$se, - calc_ess = TRUE) + prior_list = prior_list, + mu_hat = trial_data$rslt, + se_hat = trial_data$se, + calc_ess = TRUE +) -summary(posterior) +knitr::kable(summary(posterior)) ``` -# Execution of Bayesian MCPMod Test step -For the execution of the testing step of Bayesian MCPMod a critical value on the probability scale will be determined for a given alpha level. -This critical value is calculated using the re-estimated contrasts for the frequentist MCPMod to ensure that, when using non-informative priors, the actual error level for falsely declaring a significant trial in the Bayesian MCPMod is controlled by the specified alpha level. +# Bayesian MCPMod Test Step + +The testing step of Bayesian MCPMod is executed using a critical value on the +probability scale and a pseudo-optimal contrast matrix. -A pseudo-optimal contrast matrix is generated based on the variability of the posterior distribution (see Fleischer et al. 2022 for more details). -```{r Preparation of input for Bayesian MCPMod Test step} +The critical value is calculated using (re-estimated) contrasts for frequentist +MCPMod to ensure error control when using weakly-informative priors. + +A pseudo-optimal contrast matrix is generated based on the variability of the +posterior distribution (see [@fleischer_2022] for more details). + +```{r} crit_pval <- getCritProb( mods = mods, dose_levels = dose_levels, - se_new_trial = new_trial$se, - alpha_crit_val = 0.05) + se_new_trial = trial_data$se, + alpha_crit_val = 0.05 +) contr_mat <- getContr( mods = mods, dose_levels = dose_levels, - sd_posterior = summary(posterior)[, 2]) + sd_posterior = summary(posterior)[, 2] +) ``` + Please note that there are different ways to derive the contrasts. -The following code shows the implementation of some of these ways but it is not executed and the contrast specification above is used. -```{r , eval = FALSE} +The following code shows the implementation of some of these ways but it is not +executed and the contrast specification above is used. + +```{r} +#| eval: false + # i) the frequentist contrast contr_mat_prior <- getContr( mods = mods, @@ -130,7 +353,7 @@ contr_mat_prior <- getContr( contr_mat_prior <- getContr( mods = mods, dose_levels = dose_levels, - se_new_trial = new_trial$se) + se_new_trial = trial_data$se) # iii) Bayesian approach using number of patients for new trial and prior distribution contr_mat_prior <- getContr( mods = mods, @@ -138,81 +361,126 @@ contr_mat_prior <- getContr( dose_weights = n_patients, prior_list = prior_list) ``` -The Bayesian MCP testing step is then executed based on the posterior information, the provided contrasts and the multiplicity adjusted critical value. -```{r Execution of Bayesian MCPMod Test step} + +The Bayesian MCP testing step is then executed: + +```{r} BMCP_result <- performBayesianMCP( posterior_list = posterior, contr = contr_mat, crit_prob_adj = crit_pval) +``` + +Summary information: +```{r} BMCP_result ``` -The testing step is significant indicating a non-flat dose-response shape. -In detail, all 3 models are significant and the p-value for the emax model indicates deviation from the null hypothesis the most. -# Model fitting and visualization of results +The testing step is significant, indicating a non-flat dose-response shape. +All models are significant, with the `emax` model indicating the greatest deviation +from the null hypothesis. + +# Model Fitting and Visualization In the model fitting step the posterior distribution is used as basis. + Both simplified and full fitting are performed. -For the simplified fit, the multivariate normal distribution of the control group is approximated and reduced by a one-dimensional normal distribution. -The actual fit (on this approximated posterior distribution) is then performed using generalized least squares criterion. -In contrast, for the full fit, the non-linear optimization problem is addressed via the Nelder Mead algorithm. - -The output of the fit includes information about the predicted effects for the included dose levels, the generalized AIC, and the corresponding weights. -For the considered case, the simplified and the full fit are very similar. -```{r Model fitting} -# Option a) Simplified approach by using approximated posterior distribution -fit_simple <- getModelFits( - models = names(mods), - dose_levels = dose_levels, - posterior = posterior, - simple = TRUE) -# Option b) Making use of the complete posterior distribution +For the simplified fit, the multivariate normal distribution of the control group +is approximated and reduced by a one-dimensional normal distribution. + +The actual fit (on this approximated posterior distribution) is then performed +using generalized least squares criterion. In contrast, for the full fit, the +non-linear optimization problem is addressed via the Nelder-Mead algorithm +[@neldermead_2024a] implemented by the `{nloptr}` package. + +The output of the fit includes information about the predicted effects for the +included dose levels, the generalized AIC, and the corresponding weights. + +For the considered case, the simplified and the full fit are very similar, so we +present the full fit. + +```{r} +# If simple = TRUE, uses approx posterior +# Here we use complete posterior distribution fit <- getModelFits( - models = names(mods), + models = mods, dose_levels = dose_levels, posterior = posterior, simple = FALSE) ``` -Via the predict() function, one can also receive estimates for dose levels that were not included in the trial. -```{r Predict} -predict(fit, doses = c(0, 2.5, 4, 5, 7, 10)) + +Estimates for dose levels not included in the trial: + +```{r} +display_params_table(stats::predict(fit, doses = c(0, 2.5, 4, 5, 7, 10))) ``` -It is possible to plot the fitted dose response models and an AIC based average model (black lines). -```{r Plot simple vs fit} -plot(fit_simple) + +Plots of fitted dose-response models and an AIC-based average model: + +```{r} plot(fit) ``` -To assess the uncertainty, one can additionally visualize credible bands (orange shaded areas, default levels are 50% and 95%). +To assess the uncertainty, one can additionally visualize credible bands +(orange shaded areas, default levels are 50% and 95%). + These credible bands are calculated with a bootstrap method as follows: -Samples from the posterior distribution are drawn and for every sample the simplified fitting step and a prediction is performed. -These predictions are then used to identify and visualize the specified quantiles. -```{r Plot with bootstrap} + +- Samples from the posterior distribution are drawn and for every sample the +simplified fitting step and a prediction is performed. + +- These predictions are then used to identify and visualize the specified quantiles. + +```{r} plot(fit, cr_bands = TRUE) ``` -The bootstrap based quantiles can also be directly calculated via the getBootstrapQuantiles() function. +The bootstrap based quantiles can also be directly calculated via the +`getBootstrapQuantiles()` function. + For this example, only 6 quantiles are bootstrapped for each model fit. -```{r Bootstrap} -getBootstrapQuantiles( + +```{r} +bootstrap_quantiles <- getBootstrapQuantiles( model_fits = fit, quantiles = c(0.025, 0.5, 0.975), doses = c(0, 2.5, 4, 5, 7, 10), n_samples = 6 ) ``` -Technical note: The median quantile of the bootstrap based procedure is not necessary similar to the main model fit, as they are derived via different procedures. -The main fit, i.e. the black lines in the plot, show the best fit of a certain model based on minimizing the residuals for the posterior distribution, while the bootstrap based 50% quantile shows the median fit of the random sampling and fitting procedure. + +```{r} +#| code-fold: true +reactable::reactable( + data = bootstrap_quantiles, + groupBy = "models", + columns = list( + doses = colDef(aggregate = "count", format = list(aggregated = colFormat(suffix = " doses"))), + "2.5%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))), + "50%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))), + "97.5%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))) + ) +) +``` + +**Technical note:** The median quantile of the bootstrap based procedure is not +necessary similar to the main model fit, as they are derived via different procedures. + +The main fit (black line) minimizes residuals for the posterior distribution, +while the bootstrap median is the median fit of random sampling. # Additional note -It is also possible to perform the testing and modeling step in a combined fashion via the performBayesianMCPMod() function. -This code serves merely as an example and is not run in this vignette. -```{r, eval = FALSE} + +Testing and modeling can also be combined via `performBayesianMCPMod()`, +but this is not run here. + +```{r} +#| eval: false performBayesianMCPMod( - posterior_list = posterior, - contr = contr_mat, - crit_prob_adj = crit_pval, - simple = FALSE) + posterior_list = posterior, + contr = contr_mat, + crit_prob_adj = crit_pval, + simple = FALSE) ``` diff --git a/vignettes/Simulation_Example.Rmd b/vignettes/outdatet/Simulation_Example.Rmd similarity index 100% rename from vignettes/Simulation_Example.Rmd rename to vignettes/outdatet/Simulation_Example.Rmd diff --git a/vignettes/analysis_normal.Rmd b/vignettes/outdatet/analysis_normal.Rmd similarity index 100% rename from vignettes/analysis_normal.Rmd rename to vignettes/outdatet/analysis_normal.Rmd diff --git a/vignettes/analysis_normal_noninformative.qmd b/vignettes/outdatet/analysis_normal_noninformative.qmd similarity index 100% rename from vignettes/analysis_normal_noninformative.qmd rename to vignettes/outdatet/analysis_normal_noninformative.qmd From 0675def4f6f029cb812538b5c1ca8e4c37947014 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 5 Jul 2024 07:38:41 +0100 Subject: [PATCH 07/39] Comparison frequentist and bayesian vignette --- vignettes/Comparison_vignette.qmd | 1992 +++++++++++++++++++++++++++++ 1 file changed, 1992 insertions(+) create mode 100644 vignettes/Comparison_vignette.qmd diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd new file mode 100644 index 0000000..cebdc31 --- /dev/null +++ b/vignettes/Comparison_vignette.qmd @@ -0,0 +1,1992 @@ +--- +title: "Comparison frequentist & Bayesian" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + + +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false + +#' Display Parameters Table +#' +#' This function generates a markdown table displaying the names and values of parameters +#' from a named list. +#' +#' @param named_list A named list where each name represents a parameter name and the list +#' element represents the parameter value. Date values in the list are automatically +#' converted to character strings for display purposes. +#' +#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". +#' The function does not return a value but displays the table directly to the output. +#' +#' @importFrom knitr kable +#' @examples +#' params <- list("Start Date" = as.Date("2020-01-01"), +#' "End Date" = as.Date("2020-12-31"), +#' "Threshold" = 10) +#' display_params_table(params) +#' +#' @export +display_params_table <- function(named_list) { + display_table <- data.frame() + value_names <- data.frame() + for (i in 1:length(named_list)) { + # dates will display as numeric by default, so convert to char first + if (class(named_list[[i]]) == "Date") { + named_list[[i]] = as.character(named_list[[i]]) + } + if (!is.null(names(named_list[[i]]))) { + value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) + } + values <- data.frame(I(list(named_list[[i]]))) + display_table <- rbind(display_table, values) + } + + round_numeric <- function(x, digits = 3) { + if (is.numeric(x)) { + return(round(x, digits)) + } else { + return(x) + } + } + + display_table[1] <- lapply(display_table[1], function(sublist) { + lapply(sublist, round_numeric) + }) + + class(display_table[[1]]) <- "list" + + if (nrow(value_names) == 0) { + knitr::kable( + cbind(names(named_list), display_table), + col.names = c("Name", "Value") + ) + } else { + knitr::kable( + cbind(names(named_list), value_names, display_table), + col.names = c("Name", "Value Labels", "Value") + ) + } +} + +# function to solve power results for tables (different max eff) BayesianMCPMod +# return(successrates models, average) +extract_success_rates <- function(results_list, models) { + success_rates <- list() + + for (i in seq_along(results_list)) { + success_rate <- c() + for (model in models) { + success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) + } + success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate")) + } + + return(success_rates) + } + +# function to solve power results for tables (different nsample) BayesianMCPMod +#models % + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + + + +print_result_Bay_nsample <- function(results, scenario, variable) { + + result_table <- t(data.table( + Bay_1 = results$`Bay_nsample_c(40, 20, 20, 20, 40)`, + Bay_2 = results$`Bay_nsample_c(30, 30, 30, 30, 30)`, + Bay_3 = results$`Bay_nsample_c(48, 24, 24, 24, 48)`, + Bay_4 = results$`Bay_nsample_c(36, 36, 36, 36, 36)`)) + + result_table <- as.data.table(result_table) + names(result_table) <- scenario + #return(result_table) + + kable_result <- kable(cbind(variable, result_table))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + + + +library(BayesianMCPMod) +library(RBesT) +library(clinDR) +library(dplyr) +library(tibble) +library(reactable) +library(DoseFinding) +library(MCPModPack) +library(kableExtra) +library(data.table) +#library(here) +#invisible(here("functions_simulations.R")) +#source("functions_simulations.R") + +set.seed(7015) +``` + + +# Introduction + +This vignette demonstrates the application of the {BayesianMCPMod} package for sample size calculations and the comparison with the {MCPModPack} package. + +```{r} +####### General assumptions ######### +# simulations +n_sim <- 10 + +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) +nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") + +# define input parameters +doses.sim <- c(0,1,2,4,8) # dose levels +max.dose <- max(doses.sim) # specify max dose possibly available +plc.guess <- 0 # expected placebo effect +Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) +expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) +expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) +sd.sim <- c(0.4) + +#input paramters variability scenario +doses_var <- c(0, 1, 4, 8) +sd.sim_var <- 0.4 +Nsample_var <- c(25, 25, 25, 25) +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + + +# define model functions +emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") +exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) +logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) +sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") +quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") +beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=8.6, Maxd=max.dose) + +### define models to be tested in MCPMod +models <- Mods(linear=NULL, + emax = emax.g, + exponential = exp.g, + logistic=logit.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=8.6) # SB: Please add this to all Mods where we are using the beta model +) + +alpha <- 0.05 + +display_params_table(models) + + +kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) + + +kable(t(data.table(placebo_guess = plc.guess, + sd = sd.sim[1], + alpha = alpha )))%>% + kable_classic(full_width = TRUE) + +``` +## Scenarios + +In order to test and compare BayesianMCPMod and MCPModPack sample size calculations in different scenarios, the data +used for the comparisons will be simulated multiple times using different input values. +Every scenario will be named to make the differentiation between each scenario simpler. +Altogether, four different scenarios were simulated. + +```{r} + +#Specification of considered models for different scenarios for BayesianMCPMod + +min_scenario <- c("linear", "exponential", "emax") +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(min_models, main = "minimal Scenario") + + +monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(monotonic_models, main = "monotonic Scenario") + + +non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=8.6) +) +plot(non_monotonic_models,main = "non monotonic Scenario") + + +variability_scenario <- c("linear","exponential", "emax", "logistic", "sigEmax") + +kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c( "Doses variability scenario" = 5), font_size = 15) + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(var_models, main = "variability Scenario") + +``` + + + + +# MCPModPack + + + +```{r} + +#Specification of considered models for different scenarios for MCPModPack + +min_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667) + +monotonic_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +non_monotonic_modelsPack = list(linear = NA, + emax = 0.6666667 , + sigEmax = c(1.528629, 4.087463), + quadratic = -0.09688711 , + betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 8.6)) + +var_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +``` + +## minimal + +### maximum effect +```{r warning=FALSE} +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_min <- list() + +# Run simulation +func_sim <- function(models ,sim_models, sim_parameters){ + +sim_result = MCPModSimulation(endpoint_type = "Normal", + models = models, + alpha = alpha, + direction = "increasing", + model_selection = "aveAIC", + Delta = 0.1, + sim_models = sim_models, + sim_parameters = sim_parameters) +} + +# Simulation for different assumed models +power_min_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) +power_min_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) +power_min_emax <- func_sim(min_modelsPack,sim_models_min_emax, sim_parameters) + + + +#store results +results_min_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + Linear = c(power_min_linear$sim_results$power), + Exponential = c(power_min_exp$sim_results$power), + Emax = c(power_min_emax$sim_results$power), + Average = c(sum(power_min_linear$sim_results$power[1], power_min_exp$sim_results$power[1], power_min_emax$sim_results$power[1])/3, + sum(power_min_linear$sim_results$power[2], power_min_exp$sim_results$power[2], power_min_emax$sim_results$power[2])/3, + sum(power_min_linear$sim_results$power[3], power_min_exp$sim_results$power[3], power_min_emax$sim_results$power[3])/3, + sum(power_min_linear$sim_results$power[4], power_min_exp$sim_results$power[4], power_min_emax$sim_results$power[4])/3, + sum(power_min_linear$sim_results$power[5], power_min_exp$sim_results$power[5], power_min_emax$sim_results$power[5])/3) +) + +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +### Nsample +```{r warning=FALSE} +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +# store results +power_min_nsample_linear <- vector() +power_min_nsample_exp <- vector() +power_min_nsample_emax <- vector() + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + # Update nsample in simulation parameters + sim_parameters$n <- nsample_list[[i]] + + # Set max_effect to 0.2 + min_modelsPack$max_effect <- expectedEffect_fix + + # power values for different assumed true models + power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) + power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power + + power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) + power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power + + power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) + power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power + +} + +# store results +results_min_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(power_min_nsample_linear), + Exponential = c(power_min_nsample_exp), + Emax = c(power_min_nsample_emax), + Average = c(sum(power_min_nsample_linear[1], power_min_nsample_exp[1], power_min_nsample_emax[1])/3, + sum(power_min_nsample_linear[2], power_min_nsample_exp[2], power_min_nsample_emax[2])/3, + sum(power_min_nsample_linear[3], power_min_nsample_exp[3], power_min_nsample_emax[3])/3, + sum(power_min_nsample_linear[4], power_min_nsample_exp[4], power_min_nsample_emax[4])/3) +) + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +## monotonic + +### maximum effect +```{r warning=FALSE} + +sim_models_monotonic_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_emax= list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_monotonic <- list() + + +power_monotonic_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) +power_monotonic_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) +power_monotonic_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) +power_monotonic_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) +power_monotonic_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) + + +results_monotonic_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + Linear = power_monotonic_linear$sim_results$power, + Exponential = power_monotonic_exp$sim_results$power, + Emax = power_monotonic_emax$sim_results$power, + Logistic = power_monotonic_logistic$sim_results$power, + sigEmax = power_monotonic_sigemax$sim_results$power, + Average = c(sum(power_monotonic_linear$sim_results$power[1], power_monotonic_exp$sim_results$power[1], power_monotonic_emax$sim_results$power[1], power_monotonic_logistic$sim_results$power[1], power_monotonic_sigemax$sim_results$power[1])/5, + sum(power_monotonic_linear$sim_results$power[2], power_monotonic_exp$sim_results$power[2], power_monotonic_emax$sim_results$power[2], power_monotonic_logistic$sim_results$power[2], power_monotonic_sigemax$sim_results$power[2])/5, + sum(power_monotonic_linear$sim_results$power[3], power_monotonic_exp$sim_results$power[3],power_monotonic_emax$sim_results$power[3], power_monotonic_logistic$sim_results$power[3], power_monotonic_sigemax$sim_results$power[3])/5, + sum(power_monotonic_linear$sim_results$power[4], power_monotonic_exp$sim_results$power[4],power_monotonic_emax$sim_results$power[4], power_monotonic_logistic$sim_results$power[4], power_monotonic_sigemax$sim_results$power[4])/5, + sum(power_monotonic_linear$sim_results$power[5], power_monotonic_exp$sim_results$power[5],power_monotonic_emax$sim_results$power[5], power_monotonic_logistic$sim_results$power[5], power_monotonic_sigemax$sim_results$power[5])/5) +) + +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) + + +``` + +### Nsample +```{r warning=FALSE} +# assume maximum effect = 0.2 +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +# store results +power_monotonic_nsample_linear <- vector() +power_monotonic_nsample_exp <- vector() +power_monotonic_nsample_emax <- vector() +power_monotonic_nsample_logistic <- vector() +power_monotonic_nsample_sigemax <- vector() + + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + # Update nsample in simulation parameters + sim_parameters$n <- nsample_list[[i]] + + + # power values for different assumed true models + power_nsample_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) + power_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power + + power_nsample_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) + power_monotonic_nsample_exp[i] <- power_nsample_exp$sim_results$power + + power_nsample_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) + power_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power + + power_nsample_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) + power_monotonic_logistic <- power_nsample_logistic$sim_results$power + + power_nsample_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) + power_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power + +} + + +results_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_monotonic_nsample_linear, + Exponential = power_monotonic_nsample_exp, + Emax = power_monotonic_nsample_emax, + Logistic = power_monotonic_logistic, + sigEmax = power_monotonic_nsample_sigemax) + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario" = 6), font_size = 15, bold = TRUE) + + +``` +## non - monotonic + +### maximum effects + +```{r warning=FALSE} + +sim_models_non_monotonic_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_emax = list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_sigemax = list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_quadratic = list(quadratic = -0.09688711, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 8.6), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + +power_non_monotonic_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) +power_non_monotonic_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) +power_non_monotonic_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) +power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) +#power_non_monotonic_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) + +#linear, emax, sigemax, quadratic +results_non_monotonic_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + Linear = power_non_monotonic_linear$sim_results$power, + Emax = power_non_monotonic_emax$sim_results$power, + sigEmax = power_non_monotonic_sigemax$sim_results$power, + quadratic = power_non_monotonic_quadratic$sim_results$power) + + +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 5), font_size = 15, bold = TRUE) + + +``` + +### Nsample + +```{r warning=FALSE} +#beta model fehlt!!! + +# assume maximum effect = 0.2 +sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix + +# store results +power_non_monotonic_nsample_linear <- vector() +power_non_monotonic_nsample_emax <- vector() +power_non_monotonic_nsample_quadratic <- vector() +power_non_monotonic_nsample_sigemax <- vector() + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + # Update nsample in simulation parameters + sim_parameters$n <- nsample_list[[i]] + + + # power values for different assumed true models + power_nsample_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) + power_non_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power + + power_nsample_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) + power_non_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power + + power_nsample_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) + power_non_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power + + power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) + power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power + + +} + +results_non_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_non_monotonic_nsample_linear, + Emax = power_non_monotonic_nsample_emax, + sigEmax = power_non_monotonic_nsample_sigemax, + quadratic = power_non_monotonic_nsample_quadratic +) + + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 5), font_size = 15, bold = TRUE) + + + + +``` + +## variability +### maximum effect + +```{r warning=FALSE} + + +sim_models_var_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_emax = list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_sigemax = list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_logistic = list(logistic = c(1.5, 0.2275598), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters_var = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +power_var_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) +power_var_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) +power_var_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +power_var_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) +power_var_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) + +results_var_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + Linear = power_var_linear$sim_results$power, + Exponential = power_var_exp$sim_results$power, + Emax = power_var_emax$sim_results$power, + Logistic = power_var_logistic$sim_results$power, + sigEmax = power_var_sigemax$sim_results$power +) + +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 6), font_size = 15, bold = TRUE) + + +``` + +### Nsample +```{r warning=FALSE} +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix +sim_models_var_sigemax$max_effect <- expectedEffect_fix +sim_models_var_logistic$max_effect <- expectedEffect_fix + +# store results +power_var_nsample_linear <- vector() +power_var_nsample_exp <- vector() +power_var_nsample_logistic <- vector() +power_var_nsample_sigemax <- vector() +power_var_nsample_emax <- vector() + +# Loop over nsample values +for (i in seq_along(nsample_list_var)) { + + # Update nsample in simulation parameters + sim_parameters_var$n <- nsample_list_var[[i]] + + + # power values for different assumed true models + power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) + power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power + + power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) + power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power + + power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) + power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power + + power_nsample_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) + power_var_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power + + power_nsample_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) + power_var_nsample_logistic[i] <- power_nsample_logistic$sim_results$power + +} + + +results_var_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_var_nsample_linear, + Exponential = power_var_nsample_exp, + Emax = power_var_nsample_emax, + sigEmax = power_var_nsample_sigemax, + Logistic = power_var_nsample_logistic +) + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 6), font_size = 15, bold = TRUE) + +``` + + +# BayesianMCPMod + + +# Prior Specification +We use an uninformativ prior. + +```{r} +uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") + +) +``` + +To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. + +## minimal +### Maximum effect + +First we assume a fix sample size of 40 patients per group and different maximum effects. + +```{r} + +# list to store results +results_list_Bay_min <- list() + +# Simulation with different maximum effects +results_list_Bay_min <- purrr::map( c(0.05,0.1,0.2,0.3,0.5), function(i) { + min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = i, + direction = "increasing") + #optimal contrasts + contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + # Store result in list + results_list_Bay_min[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_min +}) + + +results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) + +minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) + +minimal_Bay$kable_result + + + +``` +### Nsample + +Now we assume an fix maximum effect of 0.2 and different sample sizes. + +```{r} +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + + +# Initialize list to store results +results_list_nsample_min_Bay <- list() + +#Models with maxEff = 0.2 +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + #optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + +# Simulations +success_probabilities_min <- assessDesign( + n_patients = nsample_list[[i]], + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_nsample_min_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_min + +} + + +results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) + +minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) +minimal_nsample_Bay$kable_result + + + +``` + + + +## monotonic scenario + +### Maximum effect + +```{r} +results_list_Bay_monotonic <- list() + + +results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { + + monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = i, + direction = "increasing") + + #optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_Bay_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_monotonic + +}) +##power results in vector for tables +results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) + + +monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) + +monotonic_Bay$kable_result + + + +``` + +### Nsample +```{r} +# Initialize list to store results +results_list_nsample_monotonic_Bay <- list() + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +# optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + + +success_probabilities_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_nsample_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_monotonic + +} + +results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) + + +monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) +monotonic_nsample_Bay$kable_result + + +``` + + +## non-monotonic scenario +### Maximum effect +```{r} +results_list_Bay_non_monotonic <- list() + +results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { + + non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = i, + direction = "increasing", + addArgs = list(scal=8.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_Bay_non_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_non_monotonic + +}) + +results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) + +non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) + +non_monotonic_Bay$kable_result + + +``` +### Nsample +```{r} +# Initialize list to store results +results_list_nsample_non_monotonic_Bay <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=8.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +# Loop over nsample values +for (i in seq_along(nsample_list)) { + + + +success_probabilities_non_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_nsample_non_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_non_monotonic + +} + +results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) + + +non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) +non_monotonic_nsample_Bay$kable_result + + +``` + + +## variability scenario +### Maximum effect +```{r} + +# prior +var_uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) + +results_list_Bay_var <- list() + + +results_list_Bay_var <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { + +var_models <- Mods(linear = NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = i, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + +# Store result in list + results_list_Bay_var[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_var +}) + +results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) + +variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) + +variability_Bay$kable_result + + +``` +###Nsample +```{r} +results_list_nsample_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +# Loop over nsample values +for (i in seq_along(nsample_list_var)) { + + + +success_probabilities_var <- assessDesign( + n_patients = nsample_list_var[[i]], + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + +# Store result in list + results_list_nsample_Bay_var[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_var + +} + +results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) + + +var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) +var_nsample_Bay$kable_result + + +##############test purr::map + + + +#results_list_nsample_Bay_var <- purrr::map(nsample_list_var, function(i) { + +# success_probabilities_var <- assessDesign( +# n_patients = i, +# mods = var_models, +# prior_list = var_uninf_prior_list, +# sd = sd.sim_var, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contM) + + # Return result +# list(paste0("nsample_", i), success_probabilities_var) + +#}) + +``` + + +# Comparison + +## maximum effect +### minimal scenario +```{r} +results_min_max_eff <- data.table( + linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$Linear), + exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$Exponential), + emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$Emax), + expectedEffect = expectedEffect +) + +results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") + +plot_minimal <- ggplot2::ggplot(results_min_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green"))+ + labs(x = "assumed maximum effects", y = "power deviation")+ + ylim(c(-0.1, 0.1))+ + theme_classic() +plot_minimal +``` +### monotonic scenario +```{r} +results_monotonic_max_eff <- data.table( + linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$Linear), + exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$Exponential), + emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$Emax), + logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$Logistic), + sigemax = as.vector(monotonic_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP$sigEmax), + expectedEffect = expectedEffect +) + +results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") + +plot_monotonic <- ggplot2::ggplot(results_monotonic_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "assumed maximum effects", y = "power deviation")+ + ylim(c(-0.1, 0.1))+ + theme_classic() +plot_monotonic +``` + +### non - monotonic scenario + +```{r} +results_non_monotonic_max_eff <- data.table( + linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$Linear), + emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$Emax), + sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), + quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), + expectedEffect = expectedEffect + ) + +results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") + +plot_non_monotonic <- ggplot2::ggplot(results_non_monotonic_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "assumed maximum effects", y = "power deviation")+ + theme_classic() + +plot_non_monotonic +``` + +### variability scenario + +```{r} +results_var_max_eff <- data.table( + linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$Linear), + exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$Exponential), + emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$Emax), + logistic = as.vector(variability_Bay$result_table$logistic)-as.vector(results_var_MCP$Logistic), + sigemax = as.vector(variability_Bay$result_table$sigEmax)-as.vector(results_var_MCP$sigEmax), + expectedEffect = expectedEffect +) + +results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") + +plot_var <- ggplot2::ggplot(results_var_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "assumed maximum effects", y = "power deviation")+ + theme_classic() + +plot_var +``` +## Nsample + +```{r} +nsample_vector <- as.vector(c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)")) +``` + +### minimal scenario +```{r} + +results_min_nsample <- data.table( + linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), + exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), + emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), + nsample_vector = nsample_vector +) + +results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") + +plot_minimal_nsample <- ggplot2::ggplot(results_min_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green"))+ + labs(x = "sample sizes", y = "power deviation")+ + theme_classic() +plot_minimal_nsample + +``` + +### monotonic scenario + +```{r} +results_monotonic_nsample <- data.table( + linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), + exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), + emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), + logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), + sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), + nsample_vector = nsample_vector +) + +results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") + +plot_monotonic_nsample <- ggplot2::ggplot(results_monotonic_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "sample sizes", y = "power deviation")+ + theme_classic() +plot_monotonic_nsample +``` +### non-monotonic scenario + +```{r} +results_non_monotonic_nsample <- data.table( + linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), + emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), + sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), + quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), + nsample_vector = nsample_vector + ) + +results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") + +plot_non_monotonic_nsample <- ggplot2::ggplot(results_non_monotonic_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "sample sizes", y = "power deviation")+ + theme_classic() +plot_non_monotonic_nsample +``` + +### variability sceanrio + +```{r} +results_var_nsample <- data.table( + linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), + exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), + emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), + logistic = as.vector(var_nsample_Bay$result_table$logistic)-as.vector(results_var_MCP_nsample$Logistic), + sigemax = as.vector(var_nsample_Bay$result_table$sigEmax)-as.vector(results_var_MCP_nsample$sigEmax), + nsample_vector = nsample_vector +) + +results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") + +plot_var_nsample <- ggplot2::ggplot(results_var_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "sample sizes", y = "power deviation")+ + theme_classic() +plot_var_nsample +``` + +## different n_sim + +### minimal scenario + +```{r} + +# Define a vector of different n_sim values +n_sim_values <- c(100, 500, 1000, 5000, 10000) + +# Initialize a list to store the results +results_list_nsim_Bay <- list() + +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") +#optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + +# Loop over the n_sim_values +for (i in n_sim_values) { + # Run the simulation with the current n_sim value + success_probabilities <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = i, + alpha_crit_val = alpha, + contr = contM) + + # Store the results in the list + results_list_nsim_Bay[[as.character(i)]] <- success_probabilities +} + + +results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) + + +``` + + +```{r warning=FALSE} +#Warning: the line search routine failed, possibly due to insufficient numeric precision +#Are 10.000 simulations enough? MCPModPack only up to <=10000? + +# Initialize a list to store the results +results_list_nsim_MCP = list( + power_min_nsim_linear = vector(), + power_min_nsim_exp = vector(), + power_min_nsim_emax = vector()) + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +# Loop over the n_sim_values +for (i in n_sim_values) { + sim_parameters$nsims <- i + + # power values for different assumed true models + power_nsim_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) + results_list_nsim_MCP$power_min_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power + + power_nsim_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) + results_list_nsim_MCP$power_min_nsim_exp[as.character(i)] <-power_nsim_exp$sim_results$power + + power_nsim_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) + results_list_nsim_MCP$power_min_nsim_emax[as.character(i)] <- power_nsim_exp$sim_results$power + +} +``` + + + + +```{r} +#safe results in data.table for plot +results_nsim <- data.table( + MCP_linear = results_list_nsim_MCP$power_min_nsim_linear, + MCP_exp = results_list_nsim_MCP$power_min_nsim_exp, + MCP_emax = results_list_nsim_MCP$power_min_nsim_emax, + Bay_linear = results_nsim_Bay$Bay_linear, + Bay_exp = results_nsim_Bay$Bay_exponential, + Bay_emax = results_nsim_Bay$Bay_emax) + +results_nsim_diff <- data.table( + linear = results_nsim$Bay_linear - results_nsim$MCP_linear, + exp = results_nsim$Bay_exp - results_nsim$MCP_exp, + emax = results_nsim$Bay_emax - results_nsim$MCP_emax, + n_sim = n_sim_values +) + +results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") + +plot_nsim <- ggplot2::ggplot(results_nsim_diff, aes(x = n_sim, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exp" = "blue", "emax" = "green"))+ + labs(x = "nsim", y = "power deviation")+ + theme_classic() +plot_nsim +``` +### monotonic scenario + +```{r} +# Initialize a list to store the results + results_list_nsim_Bay_monotonic <- list() + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +# Loop over the n_sim_values +for (i in n_sim_values) { + # Run the simulation with the current n_sim value + success_probabilities <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = i, + alpha_crit_val = alpha, + contr = contM) + + # Store the results in the list + results_list_nsim_Bay_monotonic[[as.character(i)]] <- success_probabilities +} + + +results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) + +``` +```{r warning=FALSE} +results_list_nsim_MCP_monotonic = list( + power_monotonic_nsim_linear = vector(), + power_monotonic_nsim_exp = vector(), + power_monotonic_nsim_emax = vector(), + power_monotonic_nsim_logistic = vector(), + power_monotonic_nsim_sigemax = vector()) + +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + + + +# Loop over the n_sim_values +for (i in n_sim_values) { + sim_parameters$nsims <- i + + # power values for different assumed true models + power_nsim_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) + results_list_nsim_MCP_monotonic$power_monotonic_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power + + power_nsim_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) + results_list_nsim_MCP_monotonic$power_monotonic_nsim_exp[as.character(i)] <-power_nsim_exp$sim_results$power + + power_nsim_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) + results_list_nsim_MCP_monotonic$power_monotonic_nsim_emax[as.character(i)] <- power_nsim_exp$sim_results$power + + power_nsim_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) + results_list_nsim_MCP_monotonic$power_monotonic_nsim_logistic[as.character(i)] <- power_nsim_logistic$sim_results$power + + power_nsim_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) + results_list_nsim_MCP_monotonic$power_monotonic_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power + + +} +``` + +```{r} +#safe results in data.table for plot +results_nsim_monotonic <- data.table( + MCP_linear = results_list_nsim_MCP_monotonic$power_monotonic_nsim_linear, + MCP_exp = results_list_nsim_MCP_monotonic$power_monotonic_nsim_exp, + MCP_emax = results_list_nsim_MCP_monotonic$power_monotonic_nsim_emax, + MCP_logistic = results_list_nsim_MCP_monotonic$power_monotonic_nsim_logistic, + MCP_sigemax = results_list_nsim_MCP_monotonic$power_monotonic_nsim_sigemax, + Bay_linear = results_nsim_Bay_monotonic$Bay_linear, + Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_logistic = results_nsim_Bay_monotonic$Bay_logistic, + Bay_sigemax = results_nsim_Bay_monotonic$Bay_sigEmax) + +results_nsim_diff_monotonic <- data.table( + linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, + exp = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, + emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, + logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, + sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, + n_sim = n_sim_values +) + +results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") + +plot_nsim_monotonic <- ggplot2::ggplot(results_nsim_diff_monotonic, aes(x = n_sim, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exp" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "nsim", y = "power deviation")+ + theme_classic() +plot_nsim_monotonic +``` +### non - monotonic scenario + +```{r} +# Initialize list to store results +results_list_nsim_Bay_non_monotonic <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=8.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +# Loop over the n_sim_values +for (i in n_sim_values) { + # Run the simulation with the current n_sim value + success_probabilities <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = i, + alpha_crit_val = alpha, + contr = contM) + + # Store the results in the list + results_list_nsim_Bay_non_monotonic[[as.character(i)]] <- success_probabilities +} + + +results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +results_list_nsim_MCP_non_monotonic = list( + power_non_monotonic_nsim_linear = vector(), + power_non_monotonic_nsim_emax = vector(), + power_non_monotonic_nsim_sigemax= vector(), + power_non_monotonic_nsim_quadratic = vector(), + power_non_monotonic_nsim_beta = vector()) + +sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix + + +# Loop over the n_sim_values +for (i in n_sim_values) { + sim_parameters$nsims <- i + + # power values for different assumed true models + power_nsim_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) + results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power + + power_nsim_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) + results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_emax[as.character(i)] <-power_nsim_emax$sim_results$power + + power_nsim_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) + results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power + + power_nsim_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) + results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_quadratic[as.character(i)] <- power_nsim_quadratic$sim_results$power + + #power_nsim_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) + #results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_beta[as.character(i)] <- power_nsim_beta$sim_results$power + + + +} +``` + +```{r} +#safe results in data.table for plot +results_nsim_non_monotonic <- data.table( + MCP_linear = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_linear, + MCP_emax = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_emax, + MCP_sigemax = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, + MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, + Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, + Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic) + +results_nsim_diff_non_monotonic <- data.table( + linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, + emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, + sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, + quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + n_sim = n_sim_values +) + + +results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") + +plot_nsim_non_monotonic <- ggplot2::ggplot(results_nsim_diff_non_monotonic, aes(x = n_sim, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ + labs(x = "nsim", y = "power deviation")+ + theme_classic() +plot_nsim_non_monotonic + +``` +### variability scenario + + +```{r} + +# Initialize list to store results +# results_list_nsim_Bay_var <- list() +# +# var_models <- Mods(linear=NULL, +# exponential = exp.g, +# emax = emax.g, +# logistic=logit.g, +# sigEmax = sigEmax.g, +# doses = doses_var, +# placEff = plc.guess, +# maxEff = expectedEffect_fix, +# direction = "increasing") +# +# contM <- getContr(mods = var_models, +# dose_levels = doses_var, +# prior_list = var_uninf_prior_list, +# dose_weights = c(1,1,1,1)) +# +# # Loop over the n_sim_values +# for (i in n_sim_values) { +# # Run the simulation with the current n_sim value +# success_probabilities <- assessDesign( +# n_patients = Nsample_var, +# mods = var_models, +# prior_list = uninf_prior_list, +# sd = sd.sim_var, +# n_sim = i, +# alpha_crit_val = alpha, +# contr = contM) +# +# # Store the results in the list +# results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities +# } +# +# +# results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +results_list_nsim_MCP_var = list( + power_var_nsim_linear = vector(), + power_var_nsim_exp = vector(), + power_var_nsim_emax= vector(), + power_var_nsim_sigemax = vector(), + power_var_nsim_logistic = vector()) + +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix +sim_models_var_sigemax$max_effect <- expectedEffect_fix +sim_models_var_logistic$max_effect <- expectedEffect_fix + + + +# Loop over the n_sim_values +for (i in n_sim_values) { + sim_parameters_var$nsims <- i + + # power values for different assumed true models + power_nsim_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) + results_list_nsim_MCP_var$power_var_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power + + power_nsim_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) + results_list_nsim_MCP_var$power_var_nsim_exp[as.character(i)] <- power_nsim_exp$sim_results$power + + power_nsim_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) + results_list_nsim_MCP_var$power_var_nsim_emax[as.character(i)] <- power_nsim_emax$sim_results$power + + power_nsim_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) + results_list_nsim_MCP_var$power_var_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power + + power_nsim_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) + results_list_nsim_MCP_var$power_var_nsim_logistic[as.character(i)] <- power_nsim_logistic$sim_results$power + + + +} +``` + +```{r} +# results_nsim_var <- data.table( +# MCP_linear = results_list_nsim_MCP_var$power_var_nsim_linear, +# MCP_exp = results_list_nsim_MCP_var$power_var_nsim_exp, +# MCP_emax = results_list_nsim_MCP_var$power_var_nsim_emax, +# MCP_sigemax = results_list_nsim_MCP_var$power_var_nsim_sigemax, +# MCP_logistic = results_list_nsim_MCP_var$power_var_nsim_logistic, +# Bay_linear = results_nsim_Bay_var$Bay_linear +# ) +``` + + + +```{r} +save(results_list_nsim_Bay, results_nsim_Bay, results_list_nsim_MCP, results_nsim_Bay_monotonic, results_nsim_Bay_non_monotonic, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, + file = "n_sim_data.RData") +``` From 070a9653fd01039de44777d465ef9c0403e9344e Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 5 Jul 2024 10:49:49 +0100 Subject: [PATCH 08/39] warning and message false --- vignettes/analysis_normal_update.qmd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd index c50c579..4048cf5 100644 --- a/vignettes/analysis_normal_update.qmd +++ b/vignettes/analysis_normal_update.qmd @@ -7,6 +7,10 @@ format: toc: true number-sections: true bibliography: references.bib + code-summary: setup + code-fold: true + message: false + warning: false vignette: > %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} %\VignetteEncoding{UTF-8} @@ -27,10 +31,6 @@ set.seed(7015) ``` ```{r} -#| code-summary: setup -#| code-fold: true -#| message: false -#| warning: false #' Display Parameters Table #' From 82440f54bd51ffa74d27a8c51966846c49dc0fc5 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 5 Jul 2024 11:29:37 +0100 Subject: [PATCH 09/39] setup chunk --- vignettes/Simulation_Example_Quarto.qmd | 18 +++++++++++++++++- vignettes/analysis_normal_update.qmd | 13 ++++++++----- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/vignettes/Simulation_Example_Quarto.qmd b/vignettes/Simulation_Example_Quarto.qmd index d177b37..38b64ab 100644 --- a/vignettes/Simulation_Example_Quarto.qmd +++ b/vignettes/Simulation_Example_Quarto.qmd @@ -2,6 +2,17 @@ title: "Simulation Example of Bayesian MCPMod for Continuous Data" output: rmarkdown::html_vignette number_sections: true +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + bibliography: references.bib + code-summary: setup + #code-fold: true + message: false + warning: false vignette: > %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} %\VignetteEngine{knitr::rmarkdown} @@ -15,7 +26,12 @@ knitr::opts_chunk$set( ) ``` -```{r setup} +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false + devtools::load_all() #library(BayesianMCPMod) library(clinDR) diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd index 4048cf5..dae882c 100644 --- a/vignettes/analysis_normal_update.qmd +++ b/vignettes/analysis_normal_update.qmd @@ -8,7 +8,7 @@ format: number-sections: true bibliography: references.bib code-summary: setup - code-fold: true + #code-fold: true message: false warning: false vignette: > @@ -18,7 +18,13 @@ vignette: > --- -```{r setup} + +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false + devtools::load_all() #library(BayesianMCPMod) library(RBesT) @@ -28,9 +34,6 @@ library(tibble) library(reactable) set.seed(7015) -``` - -```{r} #' Display Parameters Table #' From d641f0b426b41abe17a64ea0f4fd8ed9e92ad216 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 5 Jul 2024 11:43:28 +0100 Subject: [PATCH 10/39] comment se_hat to be updatet for final --- vignettes/analysis_normal_update.qmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal_update.qmd index dae882c..99bba12 100644 --- a/vignettes/analysis_normal_update.qmd +++ b/vignettes/analysis_normal_update.qmd @@ -306,7 +306,7 @@ the prior information with the estimated results of the trial [@fleischer_2022]. posterior <- getPosterior( prior_list = prior_list, mu_hat = trial_data$rslt, - se_hat = trial_data$se, + se_hat = trial_data$se, # se_hat to be updatet to s_hat in final!? calc_ess = TRUE ) From 5c01ccd8f01d66fcb7a747e1d48b50f73128b958 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 9 Jul 2024 11:44:11 +0100 Subject: [PATCH 11/39] update comparison vignette --- vignettes/Comparison_vignette.qmd | 577 +++++++++++++++++++++--------- 1 file changed, 408 insertions(+), 169 deletions(-) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd index cebdc31..b29fea1 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -1,5 +1,5 @@ --- -title: "Comparison frequentist & Bayesian" +title: "Vignette BayesianMCPMod" subtitle: "WORK IN PROGRESS" date: today format: @@ -173,6 +173,16 @@ print_result_Bay_nsample <- function(results, scenario, variable) { list(result_table = result_table, kable_result = kable_result) } +plot_power_deviation <- function(data, x, xlab){ + plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + labs(x = xlab, y = "power deviation")+ + theme_classic() + return(plot) +} library(BayesianMCPMod) @@ -185,9 +195,9 @@ library(DoseFinding) library(MCPModPack) library(kableExtra) library(data.table) -#library(here) -#invisible(here("functions_simulations.R")) -#source("functions_simulations.R") +library(here) +# invisible(here("functions_simulations.R")) +# source("functions_simulations.R") set.seed(7015) ``` @@ -310,7 +320,7 @@ non_monotonic_models <- Mods(linear=NULL, placEff = plc.guess, maxEff = expectedEffect_fix, direction = "increasing", - addArgs = list(scal=8.6) + addArgs = list(scal=9.6) ) plot(non_monotonic_models,main = "non monotonic Scenario") @@ -568,11 +578,11 @@ power_monotonic_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax results_monotonic_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = power_monotonic_linear$sim_results$power, - Exponential = power_monotonic_exp$sim_results$power, - Emax = power_monotonic_emax$sim_results$power, - Logistic = power_monotonic_logistic$sim_results$power, - sigEmax = power_monotonic_sigemax$sim_results$power, + Linear = c(power_monotonic_linear$sim_results$power), + Exponential = c(power_monotonic_exp$sim_results$power), + Emax = c(power_monotonic_emax$sim_results$power), + Logistic = c(power_monotonic_logistic$sim_results$power), + sigEmax = c(power_monotonic_sigemax$sim_results$power), Average = c(sum(power_monotonic_linear$sim_results$power[1], power_monotonic_exp$sim_results$power[1], power_monotonic_emax$sim_results$power[1], power_monotonic_logistic$sim_results$power[1], power_monotonic_sigemax$sim_results$power[1])/5, sum(power_monotonic_linear$sim_results$power[2], power_monotonic_exp$sim_results$power[2], power_monotonic_emax$sim_results$power[2], power_monotonic_logistic$sim_results$power[2], power_monotonic_sigemax$sim_results$power[2])/5, sum(power_monotonic_linear$sim_results$power[3], power_monotonic_exp$sim_results$power[3],power_monotonic_emax$sim_results$power[3], power_monotonic_logistic$sim_results$power[3], power_monotonic_sigemax$sim_results$power[3])/5, @@ -682,24 +692,101 @@ sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, power_non_monotonic_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) power_non_monotonic_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) power_non_monotonic_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) -power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) +#power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) #power_non_monotonic_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) + + + +``` +### quadratic with DoseFinding package +```{r} +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` + +``` +### beta with DoseFinding package +```{r} +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_beta <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)` +``` + + +```{r} #linear, emax, sigemax, quadratic results_non_monotonic_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), Linear = power_non_monotonic_linear$sim_results$power, Emax = power_non_monotonic_emax$sim_results$power, sigEmax = power_non_monotonic_sigemax$sim_results$power, - quadratic = power_non_monotonic_quadratic$sim_results$power) + quadratic = power_non_monotonic_quadratic, + beta = power_non_monotonic_beta) kable(results_non_monotonic_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 5), font_size = 15, bold = TRUE) - - + add_header_above(c("Power results different expected effects" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) ``` ### Nsample @@ -718,6 +805,7 @@ power_non_monotonic_nsample_linear <- vector() power_non_monotonic_nsample_emax <- vector() power_non_monotonic_nsample_quadratic <- vector() power_non_monotonic_nsample_sigemax <- vector() +power_non_monotonic_nsample_beta <- vector() # Loop over nsample values for (i in seq_along(nsample_list)) { @@ -736,29 +824,181 @@ for (i in seq_along(nsample_list)) { power_nsample_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) power_non_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power - power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) - power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power + #power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) + #power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power } + + + + +``` + +### quadratic with DoseFinding + +```{r} +#allocation = c(1,1,1,1,1) +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] +``` + +### beta with DoseFinding + +```{r} +#allocation = c(1,1,1,1,1) +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[1] +power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[1] +power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[2] +``` + + +```{r} results_non_monotonic_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), Linear = power_non_monotonic_nsample_linear, Emax = power_non_monotonic_nsample_emax, sigEmax = power_non_monotonic_nsample_sigemax, - quadratic = power_non_monotonic_nsample_quadratic + quadratic = power_non_monotonic_nsample_quadratic, + beta = power_non_monotonic_nsample_beta ) kable(results_non_monotonic_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 5), font_size = 15, bold = TRUE) + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) - - - ``` ## variability @@ -958,6 +1198,19 @@ Now we assume an fix maximum effect of 0.2 and different sample sizes. # Define the list of sample sizes nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) # Initialize list to store results results_list_nsample_min_Bay <- list() @@ -970,12 +1223,7 @@ min_models <- Mods(linear=NULL, placEff = plc.guess, maxEff = expectedEffect_fix, direction = "increasing") - #optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - + # Loop over nsample values for (i in seq_along(nsample_list)) { @@ -988,7 +1236,7 @@ success_probabilities_min <- assessDesign( sd = sd.sim, n_sim = n_sim, alpha_crit_val = alpha, - contr = contM) + contr = contrasts_list[[i]]) # Store result in list @@ -1054,6 +1302,7 @@ results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monot monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) + monotonic_Bay$kable_result @@ -1075,11 +1324,19 @@ monotonic_models <- Mods(linear=NULL, maxEff = expectedEffect_fix, direction = "increasing") -# optimal contrasts +#optimal contrasts +#allocation c(1,1,1,1,1) contM <- getContr(mods = monotonic_models, dose_levels = doses.sim, prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) # Loop over nsample values for (i in seq_along(nsample_list)) { @@ -1093,7 +1350,7 @@ success_probabilities_monotonic <- assessDesign( sd = sd.sim, n_sim = n_sim, alpha_crit_val = alpha, - contr = contM) + contr = contrasts_list[[i]]) # Store result in list @@ -1127,7 +1384,7 @@ results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i placEff = plc.guess, maxEff = i, direction = "increasing", - addArgs = list(scal=8.6)) + addArgs = list(scal=9.6)) #optimal contrasts contM <- getContr(mods = non_monotonic_models, @@ -1172,13 +1429,20 @@ non_monotonic_models <- Mods(linear=NULL, placEff = plc.guess, maxEff = expectedEffect_fix, direction = "increasing", - addArgs = list(scal=8.6)) + addArgs = list(scal=9.6)) #optimal contrasts contM <- getContr(mods = non_monotonic_models, dose_levels = doses.sim, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) + +contM_2 <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) + +contrasts_list = list(contM_2, contM, contM_2, contM) # Loop over nsample values for (i in seq_along(nsample_list)) { @@ -1192,7 +1456,7 @@ success_probabilities_non_monotonic <- assessDesign( sd = sd.sim, n_sim = n_sim, alpha_crit_val = alpha, - contr = contM) + contr = contrasts_list[[i]]) # Store result in list @@ -1276,11 +1540,18 @@ var_models <- Mods(linear=NULL, maxEff = expectedEffect_fix, direction = "increasing") +#optimal contrasts contM <- getContr(mods = var_models, dose_levels = doses_var, prior_list = var_uninf_prior_list, dose_weights = c(1,1,1,1)) +contM_2 <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(2,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + # Loop over nsample values for (i in seq_along(nsample_list_var)) { @@ -1293,7 +1564,7 @@ success_probabilities_var <- assessDesign( sd = sd.sim_var, n_sim = n_sim, alpha_crit_val = alpha, - contr = contM) + contr = contrasts_list[[i]]) # Store result in list @@ -1336,6 +1607,15 @@ var_nsample_Bay$kable_result ## maximum effect ### minimal scenario ```{r} +#table with results +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 5), font_size = 15, bold = TRUE) + +minimal_Bay$kable_result + +#difference of power values results_min_max_eff <- data.table( linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$Linear), exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$Exponential), @@ -1345,16 +1625,14 @@ results_min_max_eff <- data.table( results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") -plot_minimal <- ggplot2::ggplot(results_min_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green"))+ - labs(x = "assumed maximum effects", y = "power deviation")+ - ylim(c(-0.1, 0.1))+ - theme_classic() +plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect") plot_minimal ``` +```{r} + +``` + + ### monotonic scenario ```{r} results_monotonic_max_eff <- data.table( @@ -1368,17 +1646,12 @@ results_monotonic_max_eff <- data.table( results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") -plot_monotonic <- ggplot2::ggplot(results_monotonic_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "assumed maximum effects", y = "power deviation")+ - ylim(c(-0.1, 0.1))+ - theme_classic() +plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect") plot_monotonic ``` + + ### non - monotonic scenario ```{r} @@ -1387,19 +1660,13 @@ results_non_monotonic_max_eff <- data.table( emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$Emax), sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), + beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), expectedEffect = expectedEffect ) results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") -plot_non_monotonic <- ggplot2::ggplot(results_non_monotonic_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "assumed maximum effects", y = "power deviation")+ - theme_classic() - +plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect") plot_non_monotonic ``` @@ -1417,14 +1684,7 @@ results_var_max_eff <- data.table( results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") -plot_var <- ggplot2::ggplot(results_var_max_eff, aes(x = expectedEffect, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "assumed maximum effects", y = "power deviation")+ - theme_classic() - +plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect") plot_var ``` ## Nsample @@ -1445,13 +1705,7 @@ results_min_nsample <- data.table( results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") -plot_minimal_nsample <- ggplot2::ggplot(results_min_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green"))+ - labs(x = "sample sizes", y = "power deviation")+ - theme_classic() +plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") plot_minimal_nsample ``` @@ -1470,13 +1724,7 @@ results_monotonic_nsample <- data.table( results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") -plot_monotonic_nsample <- ggplot2::ggplot(results_monotonic_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "sample sizes", y = "power deviation")+ - theme_classic() +plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") plot_monotonic_nsample ``` ### non-monotonic scenario @@ -1487,18 +1735,13 @@ results_non_monotonic_nsample <- data.table( emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), + beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), nsample_vector = nsample_vector ) results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") -plot_non_monotonic_nsample <- ggplot2::ggplot(results_non_monotonic_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "sample sizes", y = "power deviation")+ - theme_classic() +plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") plot_non_monotonic_nsample ``` @@ -1516,13 +1759,8 @@ results_var_nsample <- data.table( results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") -plot_var_nsample <- ggplot2::ggplot(results_var_nsample, aes(x = nsample_vector, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "sample sizes", y = "power deviation")+ - theme_classic() + +plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") plot_var_nsample ``` @@ -1641,20 +1879,14 @@ results_nsim <- data.table( results_nsim_diff <- data.table( linear = results_nsim$Bay_linear - results_nsim$MCP_linear, - exp = results_nsim$Bay_exp - results_nsim$MCP_exp, + exponential = results_nsim$Bay_exp - results_nsim$MCP_exp, emax = results_nsim$Bay_emax - results_nsim$MCP_emax, n_sim = n_sim_values ) results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") -plot_nsim <- ggplot2::ggplot(results_nsim_diff, aes(x = n_sim, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exp" = "blue", "emax" = "green"))+ - labs(x = "nsim", y = "power deviation")+ - theme_classic() +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim") plot_nsim ``` ### monotonic scenario @@ -1754,7 +1986,7 @@ results_nsim_monotonic <- data.table( results_nsim_diff_monotonic <- data.table( linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, - exp = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, + exponential = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, @@ -1763,13 +1995,7 @@ results_nsim_diff_monotonic <- data.table( results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") -plot_nsim_monotonic <- ggplot2::ggplot(results_nsim_diff_monotonic, aes(x = n_sim, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exp" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "nsim", y = "power deviation")+ - theme_classic() +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim") plot_nsim_monotonic ``` ### non - monotonic scenario @@ -1844,8 +2070,8 @@ for (i in n_sim_values) { power_nsim_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power - power_nsim_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) - results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_quadratic[as.character(i)] <- power_nsim_quadratic$sim_results$power + #power_nsim_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) + #results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_quadratic[as.character(i)] <- power_nsim_quadratic$sim_results$power #power_nsim_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) #results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_beta[as.character(i)] <- power_nsim_beta$sim_results$power @@ -1871,20 +2097,14 @@ results_nsim_diff_non_monotonic <- data.table( linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, - quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + #quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, n_sim = n_sim_values ) results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") -plot_nsim_non_monotonic <- ggplot2::ggplot(results_nsim_diff_non_monotonic, aes(x = n_sim, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "quadratic" = "blue", "emax" = "green", "logistic" = "orange", "sigemax" = "purple"))+ - labs(x = "nsim", y = "power deviation")+ - theme_classic() +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim") plot_nsim_non_monotonic ``` @@ -1894,41 +2114,41 @@ plot_nsim_non_monotonic ```{r} # Initialize list to store results -# results_list_nsim_Bay_var <- list() -# -# var_models <- Mods(linear=NULL, -# exponential = exp.g, -# emax = emax.g, -# logistic=logit.g, -# sigEmax = sigEmax.g, -# doses = doses_var, -# placEff = plc.guess, -# maxEff = expectedEffect_fix, -# direction = "increasing") -# -# contM <- getContr(mods = var_models, -# dose_levels = doses_var, -# prior_list = var_uninf_prior_list, -# dose_weights = c(1,1,1,1)) -# -# # Loop over the n_sim_values -# for (i in n_sim_values) { -# # Run the simulation with the current n_sim value -# success_probabilities <- assessDesign( -# n_patients = Nsample_var, -# mods = var_models, -# prior_list = uninf_prior_list, -# sd = sd.sim_var, -# n_sim = i, -# alpha_crit_val = alpha, -# contr = contM) -# -# # Store the results in the list -# results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities -# } -# -# -# results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) +results_list_nsim_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +# Loop over the n_sim_values +for (i in n_sim_values) { + # Run the simulation with the current n_sim value + success_probabilities <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = i, + alpha_crit_val = alpha, + contr = contM) + + # Store the results in the list + results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities +} + + +results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) ``` ```{r, warning=FALSE} @@ -1974,19 +2194,38 @@ for (i in n_sim_values) { ``` ```{r} -# results_nsim_var <- data.table( -# MCP_linear = results_list_nsim_MCP_var$power_var_nsim_linear, -# MCP_exp = results_list_nsim_MCP_var$power_var_nsim_exp, -# MCP_emax = results_list_nsim_MCP_var$power_var_nsim_emax, -# MCP_sigemax = results_list_nsim_MCP_var$power_var_nsim_sigemax, -# MCP_logistic = results_list_nsim_MCP_var$power_var_nsim_logistic, -# Bay_linear = results_nsim_Bay_var$Bay_linear -# ) +#safe results in data.table for plot +results_nsim_var <- data.table( + MCP_linear = results_list_nsim_MCP_var$power_var_nsim_linear, + MCP_exp = results_list_nsim_MCP_var$power_var_nsim_exp, + MCP_emax = results_list_nsim_MCP_var$power_var_nsim_emax, + MCP_sigemax = results_list_nsim_MCP_var$power_var_nsim_sigemax, + MCP_logistic = results_list_nsim_MCP_var$power_var_nsim_logistic, + Bay_linear = results_nsim_Bay_var$Bay_linear, + Bay_exp = results_nsim_Bay_var$Bay_exponential, + Bay_emax = results_nsim_Bay_var$Bay_emax, + Bay_sigemax = results_nsim_Bay_var$Bay_sigEmax, + Bay_logistic = results_nsim_Bay_var$Bay_logistic +) + +results_nsim_diff_var <- data.table( + linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, + exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, + emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, + sigemax = results_nsim_var$Bay_sigemax - results_nsim_var$MCP_sigemax, + logistic = results_nsim_var$Bay_logistic - results_nsim_var$MCP_logistic, + n_sim = n_sim_values + ) + +results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") + +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim") +plot_nsim_var ``` ```{r} -save(results_list_nsim_Bay, results_nsim_Bay, results_list_nsim_MCP, results_nsim_Bay_monotonic, results_nsim_Bay_non_monotonic, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, - file = "n_sim_data.RData") +# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, +# file = "simulation_data.RData") ``` From 1c948f3fb9293fd0400698f9f36ca0803acdbad5 Mon Sep 17 00:00:00 2001 From: Bossert Date: Tue, 9 Jul 2024 13:29:11 +0100 Subject: [PATCH 12/39] Modification of printout function for BayesianMCP --- R/s3methods.R | 32 +++++++++++++++----------------- 1 file changed, 15 insertions(+), 17 deletions(-) diff --git a/R/s3methods.R b/R/s3methods.R index c714a0d..3000f1c 100644 --- a/R/s3methods.R +++ b/R/s3methods.R @@ -16,31 +16,29 @@ print.BayesianMCPMod <- function ( #' @export print.BayesianMCP <- function(x, ...) { - cat("Bayesian Multiple Comparison Procedure\n\n") - - cat("Summary:\n") - cat(" Sign:", x[1, "sign"], "\n") - cat(" Critical Probability:", x[1, "crit_prob_adj"], "\n") - cat(" Maximum Posterior Probability:", x[1, "max_post_prob"], "\n\n") + #cat("Bayesian Multiple Comparison Procedure\n\n") n_sim <- nrow(x) - cat("Effective Sample Size (ESS) per Dose Group:\n") - print(attr(x, "ess_avg"), row.names = FALSE) - cat("\n") - - cat("Posterior Probabilities for Model Shapes:\n") - model_probs <- x[1, grep("^post_probs\\.", colnames(x))] - model_names <- gsub("post_probs\\.", "", names(model_probs)) - model_df <- data.frame(Model = model_names, Probability = unlist(model_probs)) - print(model_df, row.names = FALSE) - + #cat("Effective Sample Size (ESS) per Dose Group:\n") + #print(attr(x, "ess_avg"), row.names = FALSE) + #cat("\n") cat("Bayesian Multiple Comparison Procedure\n") if (n_sim == 1L) { + cat("Summary:\n") + cat(" Sign:", x[1, "sign"], "\n") + cat(" Critical Probability:", x[1, "crit_prob_adj"], "\n") + cat(" Maximum Posterior Probability:", x[1, "max_post_prob"], "\n\n") + attr(x, "critProbAdj") <- NULL attr(x, "successRate") <- NULL class(x) <- NULL - + cat("Posterior Probabilities for Model Shapes:\n") + model_probs <- x[1, grep("^post_probs\\.", colnames(x))] + model_names <- gsub("post_probs\\.", "", names(model_probs)) + model_df <- data.frame(Model = model_names, Probability = unlist(model_probs)) + print(model_df, row.names = FALSE) + print.default(x, ...) # if (any(!is.na(attr(x, "essAvg")))) { From 1bfe9313584dacb287130103f79dc07d4293ecdc Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 9 Jul 2024 13:31:04 +0100 Subject: [PATCH 13/39] update --- ...on_vignette.qmd => Comparison_vignett.qmd} | 90 ++++--------------- 1 file changed, 19 insertions(+), 71 deletions(-) rename vignettes/{Comparison_vignette.qmd => Comparison_vignett.qmd} (95%) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignett.qmd similarity index 95% rename from vignettes/Comparison_vignette.qmd rename to vignettes/Comparison_vignett.qmd index b29fea1..e2341c7 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignett.qmd @@ -1,5 +1,5 @@ --- -title: "Vignette BayesianMCPMod" +title: "Comparison Vignette BayesianMCPMod" subtitle: "WORK IN PROGRESS" date: today format: @@ -196,8 +196,8 @@ library(MCPModPack) library(kableExtra) library(data.table) library(here) -# invisible(here("functions_simulations.R")) -# source("functions_simulations.R") +#invisible(here("functions_simulations.R")) +#source("functions_simulations.R") set.seed(7015) ``` @@ -238,7 +238,7 @@ exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") -beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=8.6, Maxd=max.dose) +beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) ### define models to be tested in MCPMod models <- Mods(linear=NULL, @@ -252,7 +252,7 @@ models <- Mods(linear=NULL, placEff = plc.guess, maxEff = expectedEffect_fix, direction = "increasing", - addArgs = list(scal=8.6) # SB: Please add this to all Mods where we are using the beta model + addArgs = list(scal=9.6) # SB: Please add this to all Mods where we are using the beta model ) alpha <- 0.05 @@ -325,7 +325,7 @@ non_monotonic_models <- Mods(linear=NULL, plot(non_monotonic_models,main = "non monotonic Scenario") -variability_scenario <- c("linear","exponential", "emax", "logistic", "sigEmax") +variability_scenario <- c("linear","exponential", "emax") kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% kable_classic(full_width = TRUE)%>% @@ -334,8 +334,6 @@ kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% var_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, doses = doses_var, placEff = plc.guess, maxEff = expectedEffect_fix, @@ -370,7 +368,7 @@ non_monotonic_modelsPack = list(linear = NA, emax = 0.6666667 , sigEmax = c(1.528629, 4.087463), quadratic = -0.09688711 , - betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 8.6)) + betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6)) var_modelsPack = list(linear = NA, exponential = 4.447149, @@ -683,7 +681,7 @@ sim_models_non_monotonic_quadratic = list(quadratic = -0.09688711, sd = rep(sd.sim, length(doses.sim)), placebo_effect = plc.guess) -sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 8.6), +sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6), max_effect = c(0.05,0.1,0.2,0.3,0.5), sd = rep(sd.sim, length(doses.sim)), placebo_effect = plc.guess) @@ -1022,15 +1020,7 @@ sim_models_var_emax = list(emax = 0.6666667, sd = rep(sd.sim_var, length(doses_var)), placebo_effect = plc.guess) -sim_models_var_sigemax = list(sigemax = c(1.528629, 4.087463), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) -sim_models_var_logistic = list(logistic = c(1.5, 0.2275598), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) # Simulation parameters sim_parameters_var = list(n = Nsample_var, @@ -1043,22 +1033,18 @@ sim_parameters_var = list(n = Nsample_var, power_var_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) power_var_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) power_var_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) -power_var_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) -power_var_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) results_var_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), Linear = power_var_linear$sim_results$power, Exponential = power_var_exp$sim_results$power, - Emax = power_var_emax$sim_results$power, - Logistic = power_var_logistic$sim_results$power, - sigEmax = power_var_sigemax$sim_results$power + Emax = power_var_emax$sim_results$power ) kable(results_var_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 6), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects" = 4), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 4), font_size = 15, bold = TRUE) ``` @@ -1069,14 +1055,11 @@ kable(results_var_MCP)%>% sim_models_var_linear$max_effect <- expectedEffect_fix sim_models_var_exp$max_effect <- expectedEffect_fix sim_models_var_emax$max_effect <- expectedEffect_fix -sim_models_var_sigemax$max_effect <- expectedEffect_fix -sim_models_var_logistic$max_effect <- expectedEffect_fix + # store results power_var_nsample_linear <- vector() power_var_nsample_exp <- vector() -power_var_nsample_logistic <- vector() -power_var_nsample_sigemax <- vector() power_var_nsample_emax <- vector() # Loop over nsample values @@ -1096,11 +1079,6 @@ for (i in seq_along(nsample_list_var)) { power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power - power_nsample_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) - power_var_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power - - power_nsample_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) - power_var_nsample_logistic[i] <- power_nsample_logistic$sim_results$power } @@ -1109,15 +1087,13 @@ results_var_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), Linear = power_var_nsample_linear, Exponential = power_var_nsample_exp, - Emax = power_var_nsample_emax, - sigEmax = power_var_nsample_sigemax, - Logistic = power_var_nsample_logistic + Emax = power_var_nsample_emax ) kable(results_var_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 6), font_size = 15, bold = TRUE) + add_header_above(c("Power results different sample sizes" = 4), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 4), font_size = 15, bold = TRUE) ``` @@ -1493,8 +1469,6 @@ results_list_Bay_var <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { var_models <- Mods(linear = NULL, exponential = exp.g, emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, doses = doses_var, placEff = plc.guess, maxEff = i, @@ -1533,8 +1507,6 @@ results_list_nsample_Bay_var <- list() var_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, doses = doses_var, placEff = plc.guess, maxEff = expectedEffect_fix, @@ -1677,8 +1649,6 @@ results_var_max_eff <- data.table( linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$Linear), exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$Exponential), emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$Emax), - logistic = as.vector(variability_Bay$result_table$logistic)-as.vector(results_var_MCP$Logistic), - sigemax = as.vector(variability_Bay$result_table$sigEmax)-as.vector(results_var_MCP$sigEmax), expectedEffect = expectedEffect ) @@ -1752,8 +1722,6 @@ results_var_nsample <- data.table( linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), - logistic = as.vector(var_nsample_Bay$result_table$logistic)-as.vector(results_var_MCP_nsample$Logistic), - sigemax = as.vector(var_nsample_Bay$result_table$sigEmax)-as.vector(results_var_MCP_nsample$sigEmax), nsample_vector = nsample_vector ) @@ -2013,7 +1981,7 @@ non_monotonic_models <- Mods(linear=NULL, placEff = plc.guess, maxEff = expectedEffect_fix, direction = "increasing", - addArgs = list(scal=8.6)) + addArgs = list(scal=9.6)) #optimal contrasts contM <- getContr(mods = non_monotonic_models, @@ -2119,8 +2087,6 @@ results_list_nsim_Bay_var <- list() var_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, doses = doses_var, placEff = plc.guess, maxEff = expectedEffect_fix, @@ -2155,18 +2121,14 @@ results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, va results_list_nsim_MCP_var = list( power_var_nsim_linear = vector(), power_var_nsim_exp = vector(), - power_var_nsim_emax= vector(), - power_var_nsim_sigemax = vector(), - power_var_nsim_logistic = vector()) + power_var_nsim_emax= vector()) # assume maximum effect = 0.2 sim_models_var_linear$max_effect <- expectedEffect_fix sim_models_var_exp$max_effect <- expectedEffect_fix sim_models_var_emax$max_effect <- expectedEffect_fix -sim_models_var_sigemax$max_effect <- expectedEffect_fix -sim_models_var_logistic$max_effect <- expectedEffect_fix - +sim_parameters_var$n <- Nsample_var # Loop over the n_sim_values for (i in n_sim_values) { @@ -2182,14 +2144,6 @@ for (i in n_sim_values) { power_nsim_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) results_list_nsim_MCP_var$power_var_nsim_emax[as.character(i)] <- power_nsim_emax$sim_results$power - power_nsim_sigemax <- func_sim(var_modelsPack, sim_models_var_sigemax, sim_parameters_var) - results_list_nsim_MCP_var$power_var_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power - - power_nsim_logistic <- func_sim(var_modelsPack, sim_models_var_logistic, sim_parameters_var) - results_list_nsim_MCP_var$power_var_nsim_logistic[as.character(i)] <- power_nsim_logistic$sim_results$power - - - } ``` @@ -2199,21 +2153,15 @@ results_nsim_var <- data.table( MCP_linear = results_list_nsim_MCP_var$power_var_nsim_linear, MCP_exp = results_list_nsim_MCP_var$power_var_nsim_exp, MCP_emax = results_list_nsim_MCP_var$power_var_nsim_emax, - MCP_sigemax = results_list_nsim_MCP_var$power_var_nsim_sigemax, - MCP_logistic = results_list_nsim_MCP_var$power_var_nsim_logistic, Bay_linear = results_nsim_Bay_var$Bay_linear, Bay_exp = results_nsim_Bay_var$Bay_exponential, - Bay_emax = results_nsim_Bay_var$Bay_emax, - Bay_sigemax = results_nsim_Bay_var$Bay_sigEmax, - Bay_logistic = results_nsim_Bay_var$Bay_logistic + Bay_emax = results_nsim_Bay_var$Bay_emax ) results_nsim_diff_var <- data.table( linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, - sigemax = results_nsim_var$Bay_sigemax - results_nsim_var$MCP_sigemax, - logistic = results_nsim_var$Bay_logistic - results_nsim_var$MCP_logistic, n_sim = n_sim_values ) From fadc6d0b9bb3581567cec967508e1e6180ff87db Mon Sep 17 00:00:00 2001 From: Bossert Date: Tue, 9 Jul 2024 13:42:23 +0100 Subject: [PATCH 14/39] Minor update in printout --- R/s3methods.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/s3methods.R b/R/s3methods.R index 3000f1c..2952f49 100644 --- a/R/s3methods.R +++ b/R/s3methods.R @@ -39,7 +39,7 @@ print.BayesianMCP <- function(x, ...) { model_df <- data.frame(Model = model_names, Probability = unlist(model_probs)) print(model_df, row.names = FALSE) - print.default(x, ...) + # print.default(x, ...) # if (any(!is.na(attr(x, "essAvg")))) { # From 07094f10d261270eade06a019e881796d1319420 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Wed, 10 Jul 2024 12:48:21 +0100 Subject: [PATCH 15/39] minor corrections betamod --- vignettes/Comparison_vignett.qmd | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/vignettes/Comparison_vignett.qmd b/vignettes/Comparison_vignett.qmd index e2341c7..32b384d 100644 --- a/vignettes/Comparison_vignett.qmd +++ b/vignettes/Comparison_vignett.qmd @@ -707,7 +707,7 @@ alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -742,8 +742,8 @@ allocation <- c(1,1,1,1,1) alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) -resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -766,7 +766,7 @@ mod_nams <- DoseFinding:::getModNams(parList) colnames(power_df) <- mod_nams power_df[['mean power']] <- apply(power_df, 1, mean) result <- cbind(grd, power_df, dat_n) -power_non_monotonic_beta <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)` +power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` ``` @@ -846,7 +846,7 @@ alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -880,7 +880,7 @@ alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -918,8 +918,8 @@ allocation <- c(1,1,1,1,1) alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) -resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -942,8 +942,8 @@ mod_nams <- DoseFinding:::getModNams(parList) colnames(power_df) <- mod_nams power_df[['mean power']] <- apply(power_df, 1, mean) result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[1] -power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[2] +power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] # allocation = c(2,1,1,1,2) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) @@ -952,8 +952,8 @@ allocation <- c(2,1,1,1,2) alpha <- 0.05 addArgs <- list(off = 0.08, scal = 9.6) -resp_mod_list <- list(betaMod = rbind(c(1, 0.2))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1, 0.2)), sigEmax = rbind(c(1.528629, 4.087463))) +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) mods <- do.call(Mods, append(cand_mod_list, list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) cont_mat <- optContr(mods, w = allocation) @@ -976,8 +976,8 @@ mod_nams <- DoseFinding:::getModNams(parList) colnames(power_df) <- mod_nams power_df[['mean power']] <- apply(power_df, 1, mean) result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[1] -power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1,delta2=0.2,scal=9.6)`[2] +power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] ``` From d839bf091fdc79e5872ab146707ad1811821d759 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Thu, 11 Jul 2024 09:45:38 +0100 Subject: [PATCH 16/39] little change print function --- R/s3methods.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/s3methods.R b/R/s3methods.R index 2952f49..f22c784 100644 --- a/R/s3methods.R +++ b/R/s3methods.R @@ -41,12 +41,12 @@ print.BayesianMCP <- function(x, ...) { # print.default(x, ...) - # if (any(!is.na(attr(x, "essAvg")))) { - # - # cat("Average Posterior ESS\n") - # print(attr(x, "essAvg"), ...) - # - # } + if (any(!is.na(attr(x, "essAvg")))) { + + cat("Average Posterior ESS\n") + print(attr(x, "essAvg"), ...) + + } } else { From 6e430ff3ca7aab161c23f1b77a81e62e24771b6b Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Thu, 11 Jul 2024 11:52:13 +0100 Subject: [PATCH 17/39] non monotonic scenario with DoseFinding --- ...on_vignett.qmd => Comparison_vignette.qmd} | 648 +++++++++++++----- 1 file changed, 491 insertions(+), 157 deletions(-) rename vignettes/{Comparison_vignett.qmd => Comparison_vignette.qmd} (77%) diff --git a/vignettes/Comparison_vignett.qmd b/vignettes/Comparison_vignette.qmd similarity index 77% rename from vignettes/Comparison_vignett.qmd rename to vignettes/Comparison_vignette.qmd index 32b384d..3b90b3d 100644 --- a/vignettes/Comparison_vignett.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -1,5 +1,5 @@ --- -title: "Comparison Vignette BayesianMCPMod" +title: "Vignette BayesianMCPMod" subtitle: "WORK IN PROGRESS" date: today format: @@ -83,7 +83,6 @@ display_params_table <- function(named_list) { ) } } - # function to solve power results for tables (different max eff) BayesianMCPMod # return(successrates models, average) extract_success_rates <- function(results_list, models) { @@ -185,6 +184,7 @@ plot_power_deviation <- function(data, x, xlab){ } + library(BayesianMCPMod) library(RBesT) library(clinDR) @@ -195,9 +195,7 @@ library(DoseFinding) library(MCPModPack) library(kableExtra) library(data.table) -library(here) -#invisible(here("functions_simulations.R")) -#source("functions_simulations.R") + set.seed(7015) ``` @@ -367,8 +365,8 @@ monotonic_modelsPack = list(linear = NA, non_monotonic_modelsPack = list(linear = NA, emax = 0.6666667 , sigEmax = c(1.528629, 4.087463), - quadratic = -0.09688711 , - betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6)) + quadratic = -0.09688711) +#beta var_modelsPack = list(linear = NA, exponential = 4.447149, @@ -531,7 +529,7 @@ kable(results_min_MCP_nsample)%>% ### maximum effect ```{r warning=FALSE} - +# assumed dose - response models sim_models_monotonic_linear = list(linear = NA, max_effect = c(0.05,0.1,0.2,0.3,0.5), sd = rep(sd.sim, length(doses.sim)), @@ -557,6 +555,7 @@ sim_models_monotonic_emax= list(emax = 0.6666667, sd = rep(sd.sim, length(doses.sim)), placebo_effect = plc.guess) +# Simulation parameters sim_parameters = list(n = Nsample, doses = doses.sim, dropout_rate = 0.0, @@ -566,7 +565,7 @@ sim_parameters = list(n = Nsample, # Initialize list to store results results_list_monotonic <- list() - +# perform simulations power_monotonic_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) power_monotonic_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) power_monotonic_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) @@ -598,7 +597,7 @@ kable(results_monotonic_MCP)%>% ### Nsample ```{r warning=FALSE} -# assume maximum effect = 0.2 +# assumed dose- response model with assumed maximum effect = 0.2 sim_models_monotonic_linear$max_effect <- expectedEffect_fix sim_models_monotonic_exp$max_effect <- expectedEffect_fix sim_models_monotonic_emax$max_effect <- expectedEffect_fix @@ -638,7 +637,7 @@ for (i in seq_along(nsample_list)) { } - +# store results results_monotonic_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), Linear = power_monotonic_nsample_linear, @@ -660,43 +659,156 @@ kable(results_monotonic_MCP_nsample)%>% ### maximum effects ```{r warning=FALSE} +# assumed dose - response model +# sim_models_non_monotonic_linear = list(linear = NA, +# max_effect = c(0.05,0.1,0.2,0.3,0.5), +# sd = rep(sd.sim, length(doses.sim)), +# placebo_effect = plc.guess) +# +# sim_models_non_monotonic_emax = list(emax = 0.6666667, +# max_effect = c(0.05,0.1,0.2,0.3,0.5), +# sd = rep(sd.sim, length(doses.sim)), +# placebo_effect = plc.guess) +# +# sim_models_non_monotonic_sigemax = list(sigemax = c(1.528629, 4.087463), +# max_effect = c(0.05,0.1,0.2,0.3,0.5), +# sd = rep(sd.sim, length(doses.sim)), +# placebo_effect = plc.guess) +# +# sim_models_non_monotonic_quadratic = list(quadratic = -0.09688711, +# max_effect = c(0.05,0.1,0.2,0.3,0.5), +# sd = rep(sd.sim, length(doses.sim)), +# placebo_effect = plc.guess) +# +# sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6), +# max_effect = c(0.05,0.1,0.2,0.3,0.5), +# sd = rep(sd.sim, length(doses.sim)), +# placebo_effect = plc.guess) +# +# # Simulation parameters +# sim_parameters$n <- Nsample + +# perform simulation +# power_non_monotonic_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) +# power_non_monotonic_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) +# power_non_monotonic_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) +#power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) +#power_non_monotonic_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) -sim_models_non_monotonic_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) -sim_models_non_monotonic_emax = list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) + -sim_models_non_monotonic_sigemax = list(sigemax = c(1.528629, 4.087463), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) +``` +### linear with DoseFinding package +```{r} +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) -sim_models_non_monotonic_quadratic = list(quadratic = -0.09688711, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) -sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_linear <- result$linear +``` -power_non_monotonic_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) -power_non_monotonic_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) -power_non_monotonic_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) -#power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) -#power_non_monotonic_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) +### emax with DoseFinding package +```{r} +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) - +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` +### sigemax with DoseFinding package +```{r} +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` ``` + + ### quadratic with DoseFinding package ```{r} set.seed(7015) @@ -774,9 +886,9 @@ power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,sca #linear, emax, sigemax, quadratic results_non_monotonic_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = power_non_monotonic_linear$sim_results$power, - Emax = power_non_monotonic_emax$sim_results$power, - sigEmax = power_non_monotonic_sigemax$sim_results$power, + Linear = power_non_monotonic_linear, + Emax = power_non_monotonic_emax, + sigEmax = power_non_monotonic_sigemax, quadratic = power_non_monotonic_quadratic, beta = power_non_monotonic_beta) @@ -790,14 +902,13 @@ kable(results_non_monotonic_MCP)%>% ### Nsample ```{r warning=FALSE} -#beta model fehlt!!! - -# assume maximum effect = 0.2 -sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +# # assume maximum effect = 0.2 +# sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +# sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +# sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +# sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +# # store results power_non_monotonic_nsample_linear <- vector() power_non_monotonic_nsample_emax <- vector() @@ -805,35 +916,250 @@ power_non_monotonic_nsample_quadratic <- vector() power_non_monotonic_nsample_sigemax <- vector() power_non_monotonic_nsample_beta <- vector() -# Loop over nsample values -for (i in seq_along(nsample_list)) { - - # Update nsample in simulation parameters - sim_parameters$n <- nsample_list[[i]] +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) +# power_non_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) +# power_non_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# power_nsample_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) +# power_non_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power +# +# #power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) +# #power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power +# +# +# } - - # power values for different assumed true models - power_nsample_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) - power_non_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power - - power_nsample_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) - power_non_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power - - power_nsample_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) - power_non_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power - - #power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) - #power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power - - + +``` +### linear with DoseFinding +```{r} +#allocation = c(1,1,1,1,1) +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[2] <- result$linear[1] +power_non_monotonic_nsample_linear[4] <- result$linear[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[1] <- result$linear[1] +power_non_monotonic_nsample_linear[3] <- result$linear[2] +``` + + +### emax with DoseFinding +```{r} +#allocation = c(1,1,1,1,1) +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) } +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] +``` +### sigemax with DoseFinding +```{r} +#allocation = c(1,1,1,1,1) +set.seed(7015) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] ``` + ### quadratic with DoseFinding ```{r} @@ -982,6 +1308,7 @@ power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1 ```{r} +#store results results_non_monotonic_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), Linear = power_non_monotonic_nsample_linear, @@ -1003,8 +1330,7 @@ kable(results_non_monotonic_MCP_nsample)%>% ### maximum effect ```{r warning=FALSE} - - +# assumed dose - response model sim_models_var_linear = list(linear = NA, max_effect = c(0.05,0.1,0.2,0.3,0.5), sd = rep(sd.sim_var, length(doses_var)), @@ -1029,11 +1355,12 @@ sim_parameters_var = list(n = Nsample_var, go_threshold = 0.1, nsims = n_sim) - +# perform Simulations power_var_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) power_var_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) power_var_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +# store results results_var_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), Linear = power_var_linear$sim_results$power, @@ -1204,15 +1531,15 @@ min_models <- Mods(linear=NULL, for (i in seq_along(nsample_list)) { -# Simulations -success_probabilities_min <- assessDesign( - n_patients = nsample_list[[i]], - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) + # Simulations + success_probabilities_min <- assessDesign( + n_patients = nsample_list[[i]], + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) # Store result in list @@ -1252,20 +1579,21 @@ results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { maxEff = i, direction = "increasing") - #optimal contrasts -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -success_probabilities_monotonic <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) + # optimal contrasts + contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # perform Simulations + success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) # Store result in list @@ -1290,6 +1618,7 @@ monotonic_Bay$kable_result # Initialize list to store results results_list_nsample_monotonic_Bay <- list() +# dose - response models monotonic_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, @@ -1318,15 +1647,15 @@ contrasts_list = list(contM_2, contM, contM_2, contM) for (i in seq_along(nsample_list)) { - -success_probabilities_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) + # perform simulations + success_probabilities_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) # Store result in list @@ -1363,19 +1692,19 @@ results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i addArgs = list(scal=9.6)) #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) + contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) -success_probabilities_non_monotonic <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) + success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) # Store result in list @@ -1425,17 +1754,17 @@ for (i in seq_along(nsample_list)) { -success_probabilities_non_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) + success_probabilities_non_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) -# Store result in list + # Store result in list results_list_nsample_non_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_non_monotonic } @@ -1466,27 +1795,27 @@ results_list_Bay_var <- list() results_list_Bay_var <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { -var_models <- Mods(linear = NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = i, - direction = "increasing") - -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -success_probabilities_var <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) + var_models <- Mods(linear = NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = i, + direction = "increasing") + + contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + + success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) # Store result in list results_list_Bay_var[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_var @@ -1529,17 +1858,17 @@ for (i in seq_along(nsample_list_var)) { -success_probabilities_var <- assessDesign( - n_patients = nsample_list_var[[i]], - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - -# Store result in list + success_probabilities_var <- assessDesign( + n_patients = nsample_list_var[[i]], + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + + # Store result in list results_list_nsample_Bay_var[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_var } @@ -2049,6 +2378,11 @@ for (i in n_sim_values) { } ``` +```{r} + +``` + + ```{r} #safe results in data.table for plot results_nsim_non_monotonic <- data.table( @@ -2174,6 +2508,6 @@ plot_nsim_var ```{r} -# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, -# file = "simulation_data.RData") +save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, + file = "simulation_data.RData") ``` From 9c1014cf1892506c3b00f24df385687f29fb1d83 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Thu, 11 Jul 2024 14:10:41 +0100 Subject: [PATCH 18/39] start parallelisation --- vignettes/Comparison_vignette.qmd | 145 +++++++++++++++++++----------- 1 file changed, 92 insertions(+), 53 deletions(-) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd index 3b90b3d..13ba55b 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -183,7 +183,15 @@ plot_power_deviation <- function(data, x, xlab){ return(plot) } - +# parallel---------------------------------------------- +chunkVector <- function (x, n_chunks) { + if (n_chunks <= 1) { + chunk_list <- list(x) + } else { + chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) + } + return(chunk_list) +} library(BayesianMCPMod) library(RBesT) @@ -195,6 +203,12 @@ library(DoseFinding) library(MCPModPack) library(kableExtra) library(data.table) +library(doFuture) +library(doRNG) + +registerDoFuture() +plan(multisession) + set.seed(7015) @@ -383,9 +397,9 @@ var_modelsPack = list(linear = NA, # assumed dose - response model sim_models_min_linear = list(linear = NA, exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) sim_models_min_exp = list(exponential = 4.447149, max_effect = c(0.05,0.1,0.2,0.3,0.5), @@ -420,30 +434,40 @@ sim_result = MCPModSimulation(endpoint_type = "Normal", sim_parameters = sim_parameters) } -# Simulation for different assumed models -power_min_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) -power_min_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) -power_min_emax <- func_sim(min_modelsPack,sim_models_min_emax, sim_parameters) + +list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + #store results results_min_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = c(power_min_linear$sim_results$power), - Exponential = c(power_min_exp$sim_results$power), - Emax = c(power_min_emax$sim_results$power), - Average = c(sum(power_min_linear$sim_results$power[1], power_min_exp$sim_results$power[1], power_min_emax$sim_results$power[1])/3, - sum(power_min_linear$sim_results$power[2], power_min_exp$sim_results$power[2], power_min_emax$sim_results$power[2])/3, - sum(power_min_linear$sim_results$power[3], power_min_exp$sim_results$power[3], power_min_emax$sim_results$power[3])/3, - sum(power_min_linear$sim_results$power[4], power_min_exp$sim_results$power[4], power_min_emax$sim_results$power[4])/3, - sum(power_min_linear$sim_results$power[5], power_min_exp$sim_results$power[5], power_min_emax$sim_results$power[5])/3) -) + Linear = c(results_list_min[[1]]$sim_results$power), + Exponential = c(results_list_min[[2]]$sim_results$power), + Emax = c(results_list_min[[3]]$sim_results$power)) + # Average = c(sum(power_min_linear$sim_results$power[1], power_min_exp$sim_results$power[1], power_min_emax$sim_results$power[1])/3, + # sum(power_min_linear$sim_results$power[2], power_min_exp$sim_results$power[2], power_min_emax$sim_results$power[2])/3, + # sum(power_min_linear$sim_results$power[3], power_min_exp$sim_results$power[3], power_min_emax$sim_results$power[3])/3, + # sum(power_min_linear$sim_results$power[4], power_min_exp$sim_results$power[4], power_min_emax$sim_results$power[4])/3, + # sum(power_min_linear$sim_results$power[5], power_min_exp$sim_results$power[5], power_min_emax$sim_results$power[5])/3) + kable(results_min_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects " = 4), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 4), font_size = 15, bold = TRUE) @@ -483,6 +507,10 @@ power_min_nsample_linear <- vector() power_min_nsample_exp <- vector() power_min_nsample_emax <- vector() + + + + # Loop over nsample values for (i in seq_along(nsample_list)) { @@ -564,27 +592,32 @@ sim_parameters = list(n = Nsample, # Initialize list to store results results_list_monotonic <- list() - -# perform simulations -power_monotonic_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) -power_monotonic_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) -power_monotonic_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) -power_monotonic_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) -power_monotonic_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_logistic, sim_models_monotonic_sigemax, sim_models_monotonic_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + results_monotonic_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = c(power_monotonic_linear$sim_results$power), - Exponential = c(power_monotonic_exp$sim_results$power), - Emax = c(power_monotonic_emax$sim_results$power), - Logistic = c(power_monotonic_logistic$sim_results$power), - sigEmax = c(power_monotonic_sigemax$sim_results$power), - Average = c(sum(power_monotonic_linear$sim_results$power[1], power_monotonic_exp$sim_results$power[1], power_monotonic_emax$sim_results$power[1], power_monotonic_logistic$sim_results$power[1], power_monotonic_sigemax$sim_results$power[1])/5, - sum(power_monotonic_linear$sim_results$power[2], power_monotonic_exp$sim_results$power[2], power_monotonic_emax$sim_results$power[2], power_monotonic_logistic$sim_results$power[2], power_monotonic_sigemax$sim_results$power[2])/5, - sum(power_monotonic_linear$sim_results$power[3], power_monotonic_exp$sim_results$power[3],power_monotonic_emax$sim_results$power[3], power_monotonic_logistic$sim_results$power[3], power_monotonic_sigemax$sim_results$power[3])/5, - sum(power_monotonic_linear$sim_results$power[4], power_monotonic_exp$sim_results$power[4],power_monotonic_emax$sim_results$power[4], power_monotonic_logistic$sim_results$power[4], power_monotonic_sigemax$sim_results$power[4])/5, - sum(power_monotonic_linear$sim_results$power[5], power_monotonic_exp$sim_results$power[5],power_monotonic_emax$sim_results$power[5], power_monotonic_logistic$sim_results$power[5], power_monotonic_sigemax$sim_results$power[5])/5) + Linear = c(results_list_monotonic[[1]]$sim_results$power), + Emax = c(results_list_monotonic[[2]]$sim_results$power), + Logistic = c(results_list_monotonic[[3]]$sim_results$power), + sigEmax = c(results_list_monotonic[[4]]$sim_results$power) + # Average = c(sum(power_monotonic_linear$sim_results$power[1], power_monotonic_exp$sim_results$power[1], power_monotonic_emax$sim_results$power[1], power_monotonic_logistic$sim_results$power[1], power_monotonic_sigemax$sim_results$power[1])/5, + # sum(power_monotonic_linear$sim_results$power[2], power_monotonic_exp$sim_results$power[2], power_monotonic_emax$sim_results$power[2], power_monotonic_logistic$sim_results$power[2], power_monotonic_sigemax$sim_results$power[2])/5, + # sum(power_monotonic_linear$sim_results$power[3], power_monotonic_exp$sim_results$power[3],power_monotonic_emax$sim_results$power[3], power_monotonic_logistic$sim_results$power[3], power_monotonic_sigemax$sim_results$power[3])/5, + # sum(power_monotonic_linear$sim_results$power[4], power_monotonic_exp$sim_results$power[4],power_monotonic_emax$sim_results$power[4], power_monotonic_logistic$sim_results$power[4], power_monotonic_sigemax$sim_results$power[4])/5, + # sum(power_monotonic_linear$sim_results$power[5], power_monotonic_exp$sim_results$power[5],power_monotonic_emax$sim_results$power[5], power_monotonic_logistic$sim_results$power[5], power_monotonic_sigemax$sim_results$power[5])/5) ) kable(results_monotonic_MCP)%>% @@ -701,7 +734,7 @@ kable(results_monotonic_MCP_nsample)%>% ``` ### linear with DoseFinding package ```{r} -set.seed(7015) + mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -738,7 +771,7 @@ power_non_monotonic_linear <- result$linear ### emax with DoseFinding package ```{r} -set.seed(7015) + mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -774,7 +807,7 @@ power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` ### sigemax with DoseFinding package ```{r} -set.seed(7015) + mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -811,7 +844,7 @@ power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` ### quadratic with DoseFinding package ```{r} -set.seed(7015) + mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -847,7 +880,7 @@ power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` ``` ### beta with DoseFinding package ```{r} -set.seed(7015) + mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -943,8 +976,7 @@ power_non_monotonic_nsample_beta <- vector() ``` ### linear with DoseFinding ```{r} -#allocation = c(1,1,1,1,1) -set.seed(7015) +# allocation = c(1,1,1,1,1) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -1017,7 +1049,6 @@ power_non_monotonic_nsample_linear[3] <- result$linear[2] ### emax with DoseFinding ```{r} #allocation = c(1,1,1,1,1) -set.seed(7015) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -1090,7 +1121,6 @@ power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] ### sigemax with DoseFinding ```{r} #allocation = c(1,1,1,1,1) -set.seed(7015) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -1164,7 +1194,6 @@ power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087 ```{r} #allocation = c(1,1,1,1,1) -set.seed(7015) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -1237,7 +1266,6 @@ power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711 ```{r} #allocation = c(1,1,1,1,1) -set.seed(7015) mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) doses <- c(0,1,2,4,8) allocation <- c(1,1,1,1,1) @@ -1356,16 +1384,27 @@ sim_parameters_var = list(n = Nsample_var, nsims = n_sim) # perform Simulations -power_var_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) -power_var_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) -power_var_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) + +list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) + + }) + +} + # store results results_var_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = power_var_linear$sim_results$power, - Exponential = power_var_exp$sim_results$power, - Emax = power_var_emax$sim_results$power + Linear = results_list_var[[1]]$sim_results$power, + Exponential = results_list_var[[2]]$sim_results$power, + Emax = results_list_var[[3]]$sim_results$power ) kable(results_var_MCP)%>% From 7b1471058f24f2f678955e86ec851f979a3d96c0 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 12 Jul 2024 15:36:11 +0100 Subject: [PATCH 19/39] parallelisation and plot --- vignettes/Comparison_vignette.qmd | 689 ++++++++++++++++++++++-------- 1 file changed, 504 insertions(+), 185 deletions(-) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd index 13ba55b..9a079ab 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -109,7 +109,7 @@ extract_success_rates_nsample <- function(results_list, models) { for (model in models) { success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) } - success_rates[[paste0("Bay_", names(results_list)[i])]] <- c(success_rate, attr(results_list[[i]],"avgSuccessRate")) + success_rates[[paste0("Bay_", i )]] <- c(success_rate, attr(results_list[[i]],"avgSuccessRate")) } return(success_rates) @@ -156,10 +156,10 @@ print_result_Bay_max_eff <- function(results, scenario, variable) { print_result_Bay_nsample <- function(results, scenario, variable) { result_table <- t(data.table( - Bay_1 = results$`Bay_nsample_c(40, 20, 20, 20, 40)`, - Bay_2 = results$`Bay_nsample_c(30, 30, 30, 30, 30)`, - Bay_3 = results$`Bay_nsample_c(48, 24, 24, 24, 48)`, - Bay_4 = results$`Bay_nsample_c(36, 36, 36, 36, 36)`)) + Bay_1 = results$Bay_1, + Bay_2 = results$Bay_2, + Bay_3 = results$Bay_3, + Bay_4 = results$Bay_4)) result_table <- as.data.table(result_table) names(result_table) <- scenario @@ -179,10 +179,61 @@ plot_power_deviation <- function(data, x, xlab){ geom_hline(aes(yintercept = 0), linetype = 2)+ scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ labs(x = xlab, y = "power deviation")+ + #ylim(0.2, 0.2)+ with higher n_sim!!!!!!!!!!!! theme_classic() return(plot) } +#plot all max effects in one plot + +plot_max_eff <- function(results_MCP, results_Bay, scenario){ + +transformed_MCP <- t(results_MCP) +transformed_MCP <- as.data.table(transformed_MCP) +transformed_MCP <- transformed_MCP[-c(1),] + +data <- data.table( + Bay_0.05 = results_Bay$Bay_0.05, + Bay_0.1 = results_Bay$Bay_0.1, + Bay_0.2 = results_Bay$Bay_0.2, + Bay_0.3 = results_Bay$Bay_0.3, + Bay_0.5 = results_Bay$Bay_0.5, + MCP_0.05 = transformed_MCP$V1, + MCP_0.1 = transformed_MCP$V2, + MCP_0.2 = transformed_MCP$V3, + MCP_0.3 = transformed_MCP$V4, + MCP_0.5 = transformed_MCP$V5, + scenario = c(scenario, "average") +) + + + + + plot_max_eff <- ggplot(data = data)+ + geom_point(mapping = aes(x= data$scenario, y = data$Bay_0.05, colour = "MCPMod", shape = "0.05"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.05, colour = "BayesianMCPMod", shape = "0.05"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.1, colour = "MCPMod", shape = "0.1"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.1, colour = "BayesianMCPMod", shape = "0.1"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.2, colour = "MCPMod", shape = "0.2"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.2, colour = "BayesianMCPMod", shape = "0.2"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.3, colour = "MCPMod", shape = "0.3"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.3, colour = "BayesianMCPMod", shape = "0.3"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.5, colour = "MCPMod", shape = "0.5"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.5, colour = "BayesianMCPMod", shape = "0.5"), data = data, position = position_nudge(x = 0.15))+ + scale_color_manual(name = "Legend", values = c("MCPMod" = 'blue', "BayesianMCPMod" = "red"))+ + scale_shape_manual(name = "Expected effects", values = c("0.05" = 0, "0.1" = 1, "0.2" = 2, "0.3" = 3, "0.5" = 5))+ + ylim(0, 1)+ + ylab("power")+ + xlab("assumed true model")+ + labs(title = "All scenarios with different assumed maximum effects")+ + theme_bw() + + plot_max_eff + +} + + + # parallel---------------------------------------------- chunkVector <- function (x, n_chunks) { if (n_chunks <= 1) { @@ -438,7 +489,7 @@ sim_result = MCPModSimulation(endpoint_type = "Normal", list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) -results_list_min <- foreach(k = chunks, .combine = c) %dorng% { +results_list_min <- foreach(k = chunks, .combine = c) %dorng% { lapply(k, function (i) { @@ -453,21 +504,21 @@ results_list_min <- foreach(k = chunks, .combine = c) %dorng% { #store results results_min_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = c(results_list_min[[1]]$sim_results$power), - Exponential = c(results_list_min[[2]]$sim_results$power), - Emax = c(results_list_min[[3]]$sim_results$power)) - # Average = c(sum(power_min_linear$sim_results$power[1], power_min_exp$sim_results$power[1], power_min_emax$sim_results$power[1])/3, - # sum(power_min_linear$sim_results$power[2], power_min_exp$sim_results$power[2], power_min_emax$sim_results$power[2])/3, - # sum(power_min_linear$sim_results$power[3], power_min_exp$sim_results$power[3], power_min_emax$sim_results$power[3])/3, - # sum(power_min_linear$sim_results$power[4], power_min_exp$sim_results$power[4], power_min_emax$sim_results$power[4])/3, - # sum(power_min_linear$sim_results$power[5], power_min_exp$sim_results$power[5], power_min_emax$sim_results$power[5])/3) + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(result_list_min[[1]]), + exponential = c(results_list_min[[2]]$sim_results$power), + emax = c(results_list_min[[3]]$sim_results$power), + Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, + sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, + sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, + sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, + sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) kable(results_min_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 4), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 4), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) @@ -511,37 +562,71 @@ power_min_nsample_emax <- vector() -# Loop over nsample values -for (i in seq_along(nsample_list)) { - - # Update nsample in simulation parameters - sim_parameters$n <- nsample_list[[i]] - - # Set max_effect to 0.2 - min_modelsPack$max_effect <- expectedEffect_fix - - # power values for different assumed true models - power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) - power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power - - power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) - power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power - - power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) - power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# # Set max_effect to 0.2 +# min_modelsPack$max_effect <- expectedEffect_fix +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) +# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) +# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) +# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power +# +# } +# Set max_effect to 0.2 +min_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) + +#ind_tasks <- 1:12 + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) } + + + + + + # store results results_min_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(power_min_nsample_linear), - Exponential = c(power_min_nsample_exp), - Emax = c(power_min_nsample_emax), - Average = c(sum(power_min_nsample_linear[1], power_min_nsample_exp[1], power_min_nsample_emax[1])/3, - sum(power_min_nsample_linear[2], power_min_nsample_exp[2], power_min_nsample_emax[2])/3, - sum(power_min_nsample_linear[3], power_min_nsample_exp[3], power_min_nsample_emax[3])/3, - sum(power_min_nsample_linear[4], power_min_nsample_exp[4], power_min_nsample_emax[4])/3) + Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), + Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), + Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), + Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, + sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, + sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, + sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) ) kable(results_min_MCP_nsample)%>% @@ -593,7 +678,7 @@ sim_parameters = list(n = Nsample, # Initialize list to store results results_list_monotonic <- list() -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_logistic, sim_models_monotonic_sigemax, sim_models_monotonic_emax) +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { @@ -608,16 +693,17 @@ results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { results_monotonic_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = c(results_list_monotonic[[1]]$sim_results$power), - Emax = c(results_list_monotonic[[2]]$sim_results$power), - Logistic = c(results_list_monotonic[[3]]$sim_results$power), - sigEmax = c(results_list_monotonic[[4]]$sim_results$power) - # Average = c(sum(power_monotonic_linear$sim_results$power[1], power_monotonic_exp$sim_results$power[1], power_monotonic_emax$sim_results$power[1], power_monotonic_logistic$sim_results$power[1], power_monotonic_sigemax$sim_results$power[1])/5, - # sum(power_monotonic_linear$sim_results$power[2], power_monotonic_exp$sim_results$power[2], power_monotonic_emax$sim_results$power[2], power_monotonic_logistic$sim_results$power[2], power_monotonic_sigemax$sim_results$power[2])/5, - # sum(power_monotonic_linear$sim_results$power[3], power_monotonic_exp$sim_results$power[3],power_monotonic_emax$sim_results$power[3], power_monotonic_logistic$sim_results$power[3], power_monotonic_sigemax$sim_results$power[3])/5, - # sum(power_monotonic_linear$sim_results$power[4], power_monotonic_exp$sim_results$power[4],power_monotonic_emax$sim_results$power[4], power_monotonic_logistic$sim_results$power[4], power_monotonic_sigemax$sim_results$power[4])/5, - # sum(power_monotonic_linear$sim_results$power[5], power_monotonic_exp$sim_results$power[5],power_monotonic_emax$sim_results$power[5], power_monotonic_logistic$sim_results$power[5], power_monotonic_sigemax$sim_results$power[5])/5) + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_monotonic[[1]]$sim_results$power), + exp = c(results_list_monotonic[[2]]$sim_results$power), + emax = c(results_list_monotonic[[3]]$sim_results$power), + logistic = c(results_list_monotonic[[4]]$sim_results$power), + sigEmax = c(results_list_monotonic[[5]]$sim_results$power), + Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) ) kable(results_monotonic_MCP)%>% @@ -919,17 +1005,23 @@ power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,sca #linear, emax, sigemax, quadratic results_non_monotonic_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = power_non_monotonic_linear, - Emax = power_non_monotonic_emax, + linear = power_non_monotonic_linear, + emax = power_non_monotonic_emax, sigEmax = power_non_monotonic_sigemax, quadratic = power_non_monotonic_quadratic, - beta = power_non_monotonic_beta) + beta = power_non_monotonic_beta, + average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), + (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), + (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), + (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), + (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) + ) kable(results_non_monotonic_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) ``` ### Nsample @@ -1402,15 +1494,20 @@ results_list_var <- foreach(k = chunks, .combine = c) %dorng% { # store results results_var_MCP <- data.table( Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - Linear = results_list_var[[1]]$sim_results$power, - Exponential = results_list_var[[2]]$sim_results$power, - Emax = results_list_var[[3]]$sim_results$power + linear = results_list_var[[1]]$sim_results$power, + exponential = results_list_var[[2]]$sim_results$power, + emax = results_list_var[[3]]$sim_results$power, + average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), + (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), + (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), + (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), + (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) ) kable(results_var_MCP)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 4), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 4), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) ``` @@ -1493,17 +1590,60 @@ First we assume a fix sample size of 40 patients per group and different maximum # list to store results results_list_Bay_min <- list() -# Simulation with different maximum effects -results_list_Bay_min <- purrr::map( c(0.05,0.1,0.2,0.3,0.5), function(i) { - min_models <- Mods(linear=NULL, +# # Simulation with different maximum effects +# results_list_Bay_min <- purrr::map( c(0.05,0.1,0.2,0.3,0.5), function(i) { +# min_models <- Mods(linear=NULL, +# exponential = exp.g, +# emax = emax.g, +# doses = doses.sim, +# placEff = plc.guess, +# maxEff = i, +# direction = "increasing") +# #optimal contrasts +# contM <- getContr(mods = min_models, +# dose_levels = doses.sim, +# prior_list = uninf_prior_list, +# dose_weights = c(1,1,1,1,1)) +# +# # Simulation step +# success_probabilities_min <- assessDesign( +# n_patients = Nsample, +# mods = min_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contM) +# +# # Store result in list +# results_list_Bay_min[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_min +# }) +# +# +# results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) + + + +# parallel ------------------------------------------------------------------------------------- + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + min_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, doses = doses.sim, placEff = plc.guess, - maxEff = i, + maxEff = list_max_eff[[i]], direction = "increasing") #optimal contrasts - contM <- getContr(mods = min_models, +contM <- getContr(mods = min_models, dose_levels = doses.sim, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) @@ -1516,13 +1656,12 @@ results_list_Bay_min <- purrr::map( c(0.05,0.1,0.2,0.3,0.5), function(i) { sd = sd.sim, n_sim = n_sim, alpha_crit_val = alpha, - contr = contM) - - # Store result in list - results_list_Bay_min[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_min -}) - - + contr = contM) + + }) + +} + results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) @@ -1566,12 +1705,35 @@ min_models <- Mods(linear=NULL, maxEff = expectedEffect_fix, direction = "increasing") -# Loop over nsample values -for (i in seq_along(nsample_list)) { - +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# +# # Simulations +# success_probabilities_min <- assessDesign( +# n_patients = nsample_list[[i]], +# mods = min_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contrasts_list[[i]]) +# +# +# # Store result in list +# results_list_nsample_min_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_min +# +# } +# parallel ------------------------------------------------------- - # Simulations - success_probabilities_min <- assessDesign( + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_min <- assessDesign( n_patients = nsample_list[[i]], mods = min_models, prior_list = uninf_prior_list, @@ -1579,13 +1741,10 @@ for (i in seq_along(nsample_list)) { n_sim = n_sim, alpha_crit_val = alpha, contr = contrasts_list[[i]]) - - -# Store result in list - results_list_nsample_min_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_min - + + }) } - + results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) @@ -1606,16 +1765,59 @@ minimal_nsample_Bay$kable_result results_list_Bay_monotonic <- list() -results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { +# results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { +# +# monotonic_models <- Mods(linear=NULL, +# exponential = exp.g, +# emax = emax.g, +# logistic=logit.g, +# sigEmax = sigEmax.g, +# doses = doses.sim, +# placEff = plc.guess, +# maxEff = i, +# direction = "increasing") +# +# # optimal contrasts +# contM <- getContr(mods = monotonic_models, +# dose_levels = doses.sim, +# prior_list = uninf_prior_list, +# dose_weights = c(1,1,1,1,1)) +# +# # perform Simulations +# success_probabilities_monotonic <- assessDesign( +# n_patients = Nsample, +# mods = monotonic_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contM) +# +# +# # Store result in list +# results_list_Bay_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_monotonic +# +# }) + +# parallel ---------------------------------------- + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - monotonic_models <- Mods(linear=NULL, + lapply(k, function (i) { + + monotonic_models <- Mods(linear=NULL, exponential = exp.g, emax = emax.g, logistic=logit.g, sigEmax = sigEmax.g, doses = doses.sim, placEff = plc.guess, - maxEff = i, + maxEff = list_max_eff[[i]], direction = "increasing") # optimal contrasts @@ -1633,12 +1835,14 @@ results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { n_sim = n_sim, alpha_crit_val = alpha, contr = contM) + - -# Store result in list - results_list_Bay_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_monotonic + + }) -}) +} + + ##power results in vector for tables results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) @@ -1682,25 +1886,43 @@ contM_2 <- getContr(mods = monotonic_models, dose_weights = c(2,1,1,1,2)) contrasts_list = list(contM_2, contM, contM_2, contM) -# Loop over nsample values -for (i in seq_along(nsample_list)) { - +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# +# # perform simulations +# success_probabilities_monotonic <- assessDesign( +# n_patients = nsample_list[[i]], +# mods = monotonic_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contrasts_list[[i]]) +# +# +# # Store result in list +# results_list_nsample_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_monotonic +# +# } - # perform simulations - success_probabilities_monotonic <- assessDesign( +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_monotonic <- assessDesign( n_patients = nsample_list[[i]], mods = monotonic_models, prior_list = uninf_prior_list, sd = sd.sim, n_sim = n_sim, - alpha_crit_val = alpha, + alpha_crit_val = alpha, contr = contrasts_list[[i]]) - - -# Store result in list - results_list_nsample_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_monotonic - + }) } + results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) @@ -1717,23 +1939,65 @@ monotonic_nsample_Bay$kable_result ```{r} results_list_Bay_non_monotonic <- list() -results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { +# results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { +# +# non_monotonic_models <- Mods(linear=NULL, +# emax = emax.g, +# sigEmax = sigEmax.g, +# quadratic = quad.g, +# betaMod = beta.g, +# doses = doses.sim, +# placEff = plc.guess, +# maxEff = i, +# direction = "increasing", +# addArgs = list(scal=9.6)) +# +# #optimal contrasts +# contM <- getContr(mods = non_monotonic_models, +# dose_levels = doses.sim, +# prior_list = uninf_prior_list, +# dose_weights = c(1,1,1,1,1)) +# +# success_probabilities_non_monotonic <- assessDesign( +# n_patients = Nsample, +# mods = non_monotonic_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contM) +# +# +# # Store result in list +# results_list_Bay_non_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_non_monotonic +# +# }) + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - non_monotonic_models <- Mods(linear=NULL, + lapply(k, function (i) { + + + non_monotonic_models <- Mods(linear=NULL, emax = emax.g, sigEmax = sigEmax.g, quadratic = quad.g, betaMod = beta.g, doses = doses.sim, - placEff = plc.guess, - maxEff = i, + placEff = plc.guess, + maxEff = list_max_eff[[i]], direction = "increasing", addArgs = list(scal=9.6)) - + #optimal contrasts - contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, + contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) success_probabilities_non_monotonic <- assessDesign( @@ -1742,15 +2006,14 @@ results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i prior_list = uninf_prior_list, sd = sd.sim, n_sim = n_sim, - alpha_crit_val = alpha, + alpha_crit_val = alpha, contr = contM) -# Store result in list - results_list_Bay_non_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_non_monotonic + }) + +} -}) - results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) @@ -1788,25 +2051,44 @@ contM_2 <- getContr(mods = non_monotonic_models, contrasts_list = list(contM_2, contM, contM_2, contM) -# Loop over nsample values -for (i in seq_along(nsample_list)) { - +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# +# +# success_probabilities_non_monotonic <- assessDesign( +# n_patients = nsample_list[[i]], +# mods = non_monotonic_models, +# prior_list = uninf_prior_list, +# sd = sd.sim, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contrasts_list[[i]]) +# +# +# # Store result in list +# results_list_nsample_non_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_non_monotonic +# +# } - success_probabilities_non_monotonic <- assessDesign( +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_non_monotonic <- assessDesign( n_patients = nsample_list[[i]], mods = non_monotonic_models, prior_list = uninf_prior_list, sd = sd.sim, n_sim = n_sim, - alpha_crit_val = alpha, + alpha_crit_val = alpha, contr = contrasts_list[[i]]) - - - # Store result in list - results_list_nsample_non_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_non_monotonic - + }) } + results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) @@ -1832,33 +2114,42 @@ var_uninf_prior_list <- list( results_list_Bay_var <- list() -results_list_Bay_var <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { - var_models <- Mods(linear = NULL, +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + var_models <- Mods(linear = NULL, exponential = exp.g, emax = emax.g, doses = doses_var, - placEff = plc.guess, - maxEff = i, + placEff = plc.guess, + maxEff = list_max_eff[[i]], direction = "increasing") - - contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, + + contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, dose_weights = c(1,1,1,1)) - + success_probabilities_var <- assessDesign( n_patients = Nsample_var, mods = var_models, prior_list = var_uninf_prior_list, sd = sd.sim_var, n_sim = n_sim, - alpha_crit_val = alpha, + alpha_crit_val = alpha, contr = contM) -# Store result in list - results_list_Bay_var[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_var -}) + }) + +} + results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) @@ -1892,25 +2183,43 @@ contM_2 <- getContr(mods = var_models, dose_weights = c(2,1,1,2)) contrasts_list = list(contM_2, contM, contM_2, contM) -# Loop over nsample values -for (i in seq_along(nsample_list_var)) { - - +# # Loop over nsample values +# for (i in seq_along(nsample_list_var)) { +# +# +# +# success_probabilities_var <- assessDesign( +# n_patients = nsample_list_var[[i]], +# mods = var_models, +# prior_list = var_uninf_prior_list, +# sd = sd.sim_var, +# n_sim = n_sim, +# alpha_crit_val = alpha, +# contr = contrasts_list[[i]]) +# +# +# # Store result in list +# results_list_nsample_Bay_var[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_var +# +# } - success_probabilities_var <- assessDesign( +chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) + +results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + success_probabilities_var <- assessDesign( n_patients = nsample_list_var[[i]], mods = var_models, prior_list = var_uninf_prior_list, sd = sd.sim_var, n_sim = n_sim, - alpha_crit_val = alpha, + alpha_crit_val = alpha, contr = contrasts_list[[i]]) - - - # Store result in list - results_list_nsample_Bay_var[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_var - + + }) } + results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) @@ -1919,26 +2228,6 @@ var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c( var_nsample_Bay$kable_result -##############test purr::map - - - -#results_list_nsample_Bay_var <- purrr::map(nsample_list_var, function(i) { - -# success_probabilities_var <- assessDesign( -# n_patients = i, -# mods = var_models, -# prior_list = var_uninf_prior_list, -# sd = sd.sim_var, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contM) - - # Return result -# list(paste0("nsample_", i), success_probabilities_var) - -#}) - ``` @@ -1947,6 +2236,10 @@ var_nsample_Bay$kable_result ## maximum effect ### minimal scenario ```{r} + +plot_minimal_max_eff <- plot_max_eff(results_min_MCP, results_min_Bay, min_scenario) +plot_minimal_max_eff + #table with results kable(results_min_MCP)%>% kable_classic(full_width = TRUE)%>% @@ -1957,12 +2250,14 @@ minimal_Bay$kable_result #difference of power values results_min_max_eff <- data.table( - linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$Linear), - exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$Exponential), - emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$Emax), + linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$linear), + exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$exponential), + emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$emax), expectedEffect = expectedEffect ) + + results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect") @@ -1975,11 +2270,14 @@ plot_minimal ### monotonic scenario ```{r} +plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) +plot_monotonic_max_eff + results_monotonic_max_eff <- data.table( - linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$Linear), - exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$Exponential), - emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$Emax), - logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$Logistic), + linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$linear), + exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$exp), + emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$emax), + logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$logistic), sigemax = as.vector(monotonic_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP$sigEmax), expectedEffect = expectedEffect ) @@ -1995,9 +2293,12 @@ plot_monotonic ### non - monotonic scenario ```{r} +plot_non_monotonic_max_eff <- plot_max_eff(results_non_monotonic_MCP, results_non_monotonic_Bay, non_monotonic_scenario) +plot_non_monotonic_max_eff + results_non_monotonic_max_eff <- data.table( - linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$Linear), - emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$Emax), + linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), + emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), @@ -2012,11 +2313,15 @@ plot_non_monotonic ### variability scenario + ```{r} +plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) +plot_var_max_eff + results_var_max_eff <- data.table( - linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$Linear), - exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$Exponential), - emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$Emax), + linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$linear), + exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$exponential), + emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$emax), expectedEffect = expectedEffect ) @@ -2046,6 +2351,20 @@ results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") plot_minimal_nsample +################################## +library(tidyverse) + +# bar_data_min <- data.table( + Bay_linear = minimal_nsample_Bay$result_table$linear, + Bay_exp = minimal_nsample_Bay$result_table$exponential, + Bay_emax = minimal_nsample_Bay$result_table$emax, + diff_linear = results_min_nsample$linear, + diff_exp = results_min_nsample$exponential, + diff_emax = results_min_nsample$emax +) + + + ``` ### monotonic scenario @@ -2547,6 +2866,6 @@ plot_nsim_var ```{r} -save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, - file = "simulation_data.RData") +# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, +# file = "simulation_data.RData") ``` From 6681936cbc64248f8cfe80dff898438a266e3c5a Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Wed, 17 Jul 2024 14:25:17 +0100 Subject: [PATCH 20/39] nsample plot and parallelisation --- .../Comparison_vignette.qmd | 992 +++++++++++------- 1 file changed, 587 insertions(+), 405 deletions(-) rename vignettes/{ => Comparison_vignette}/Comparison_vignette.qmd (70%) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd similarity index 70% rename from vignettes/Comparison_vignette.qmd rename to vignettes/Comparison_vignette/Comparison_vignette.qmd index 9a079ab..d1fde40 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -146,7 +146,8 @@ print_result_Bay_max_eff <- function(results, scenario, variable) { kable_result <- kable(cbind(variable, result_table))%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE) + add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) list(result_table = result_table, kable_result = kable_result) } @@ -167,7 +168,8 @@ print_result_Bay_nsample <- function(results, scenario, variable) { kable_result <- kable(cbind(variable, result_table))%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE) + add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) list(result_table = result_table, kable_result = kable_result) } @@ -176,10 +178,12 @@ plot_power_deviation <- function(data, x, xlab){ plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ geom_point()+ geom_line() + + scale_x_continuous(breaks = c(100, 500, 1000, 2500, 5000)) + geom_hline(aes(yintercept = 0), linetype = 2)+ scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ labs(x = xlab, y = "power deviation")+ - #ylim(0.2, 0.2)+ with higher n_sim!!!!!!!!!!!! + ylim(-0.2, 0.2)+ #with higher n_sim!!!!!!!!!!!! + #scale_x_continuous(breaks = c(100, 500, 1000, 2500, 5000))+ theme_classic() return(plot) } @@ -273,7 +277,7 @@ This vignette demonstrates the application of the {BayesianMCPMod} package for s ```{r} ####### General assumptions ######### # simulations -n_sim <- 10 +n_sim <- 1000 # Define the list of sample sizes nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) @@ -443,6 +447,10 @@ var_modelsPack = list(linear = NA, ## minimal +######### child = 'Comparison_MCPModPack.qmd' + + + ### maximum effect ```{r warning=FALSE} # assumed dose - response model @@ -505,7 +513,7 @@ results_list_min <- foreach(k = chunks, .combine = c) %dorng% { #store results results_min_MCP <- data.table( max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(result_list_min[[1]]), + linear = c(results_list_min[[1]]$sim_results$power), exponential = c(results_list_min[[2]]$sim_results$power), emax = c(results_list_min[[3]]$sim_results$power), Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, @@ -611,12 +619,6 @@ results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.cha } - - - - - - # store results results_min_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), @@ -731,45 +733,83 @@ power_monotonic_nsample_logistic <- vector() power_monotonic_nsample_sigemax <- vector() -# Loop over nsample values -for (i in seq_along(nsample_list)) { - - # Update nsample in simulation parameters - sim_parameters$n <- nsample_list[[i]] +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) +# power_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) +# power_monotonic_nsample_exp[i] <- power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) +# power_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# power_nsample_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) +# power_monotonic_logistic <- power_nsample_logistic$sim_results$power +# +# power_nsample_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) +# power_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power +# +# } - - # power values for different assumed true models - power_nsample_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) - power_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power - - power_nsample_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) - power_monotonic_nsample_exp[i] <- power_nsample_exp$sim_results$power - - power_nsample_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) - power_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power - - power_nsample_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) - power_monotonic_logistic <- power_nsample_logistic$sim_results$power - - power_nsample_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) - power_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power + +# Set max_effect to 0.2 +monotonic_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) } + # store results results_monotonic_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = power_monotonic_nsample_linear, - Exponential = power_monotonic_nsample_exp, - Emax = power_monotonic_nsample_emax, - Logistic = power_monotonic_logistic, - sigEmax = power_monotonic_nsample_sigemax) + Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), + Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), + Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), + Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), + sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), +Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) kable(results_monotonic_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario" = 6), font_size = 15, bold = TRUE) + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) ``` @@ -777,47 +817,6 @@ kable(results_monotonic_MCP_nsample)%>% ### maximum effects -```{r warning=FALSE} -# assumed dose - response model -# sim_models_non_monotonic_linear = list(linear = NA, -# max_effect = c(0.05,0.1,0.2,0.3,0.5), -# sd = rep(sd.sim, length(doses.sim)), -# placebo_effect = plc.guess) -# -# sim_models_non_monotonic_emax = list(emax = 0.6666667, -# max_effect = c(0.05,0.1,0.2,0.3,0.5), -# sd = rep(sd.sim, length(doses.sim)), -# placebo_effect = plc.guess) -# -# sim_models_non_monotonic_sigemax = list(sigemax = c(1.528629, 4.087463), -# max_effect = c(0.05,0.1,0.2,0.3,0.5), -# sd = rep(sd.sim, length(doses.sim)), -# placebo_effect = plc.guess) -# -# sim_models_non_monotonic_quadratic = list(quadratic = -0.09688711, -# max_effect = c(0.05,0.1,0.2,0.3,0.5), -# sd = rep(sd.sim, length(doses.sim)), -# placebo_effect = plc.guess) -# -# sim_models_non_monotonic_beta = list( betaMod(dose = doses.sim, e0 = plc.guess, eMax = 5.5, delta1 = 1, delta2 = 0.2, scal= 9.6), -# max_effect = c(0.05,0.1,0.2,0.3,0.5), -# sd = rep(sd.sim, length(doses.sim)), -# placebo_effect = plc.guess) -# -# # Simulation parameters -# sim_parameters$n <- Nsample - -# perform simulation -# power_non_monotonic_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) -# power_non_monotonic_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) -# power_non_monotonic_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) -#power_non_monotonic_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) -#power_non_monotonic_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) - - - - -``` ### linear with DoseFinding package ```{r} @@ -1525,38 +1524,70 @@ power_var_nsample_linear <- vector() power_var_nsample_exp <- vector() power_var_nsample_emax <- vector() -# Loop over nsample values -for (i in seq_along(nsample_list_var)) { - - # Update nsample in simulation parameters - sim_parameters_var$n <- nsample_list_var[[i]] +# # Loop over nsample values +# for (i in seq_along(nsample_list_var)) { +# +# # Update nsample in simulation parameters +# sim_parameters_var$n <- nsample_list_var[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) +# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) +# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# +# } - - # power values for different assumed true models - power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) - power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power - - power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) - power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power - - power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) - power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power - +var_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list_var[[i]], + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) } results_var_MCP_nsample <- data.table( N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = power_var_nsample_linear, - Exponential = power_var_nsample_exp, - Emax = power_var_nsample_emax + Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), + Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), + Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), + Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), + (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), + (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), + (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) ) kable(results_var_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 4), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 4), font_size = 15, bold = TRUE) + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) ``` @@ -1765,41 +1796,7 @@ minimal_nsample_Bay$kable_result results_list_Bay_monotonic <- list() -# results_list_Bay_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { -# -# monotonic_models <- Mods(linear=NULL, -# exponential = exp.g, -# emax = emax.g, -# logistic=logit.g, -# sigEmax = sigEmax.g, -# doses = doses.sim, -# placEff = plc.guess, -# maxEff = i, -# direction = "increasing") -# -# # optimal contrasts -# contM <- getContr(mods = monotonic_models, -# dose_levels = doses.sim, -# prior_list = uninf_prior_list, -# dose_weights = c(1,1,1,1,1)) -# -# # perform Simulations -# success_probabilities_monotonic <- assessDesign( -# n_patients = Nsample, -# mods = monotonic_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contM) -# -# -# # Store result in list -# results_list_Bay_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_monotonic -# -# }) -# parallel ---------------------------------------- list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) @@ -1886,25 +1883,6 @@ contM_2 <- getContr(mods = monotonic_models, dose_weights = c(2,1,1,1,2)) contrasts_list = list(contM_2, contM, contM_2, contM) -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# -# # perform simulations -# success_probabilities_monotonic <- assessDesign( -# n_patients = nsample_list[[i]], -# mods = monotonic_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contrasts_list[[i]]) -# -# -# # Store result in list -# results_list_nsample_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_monotonic -# -# } chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) @@ -1939,39 +1917,6 @@ monotonic_nsample_Bay$kable_result ```{r} results_list_Bay_non_monotonic <- list() -# results_list_Bay_non_monotonic <- purrr::map(c(0.05,0.1,0.2,0.3,0.5), function(i) { -# -# non_monotonic_models <- Mods(linear=NULL, -# emax = emax.g, -# sigEmax = sigEmax.g, -# quadratic = quad.g, -# betaMod = beta.g, -# doses = doses.sim, -# placEff = plc.guess, -# maxEff = i, -# direction = "increasing", -# addArgs = list(scal=9.6)) -# -# #optimal contrasts -# contM <- getContr(mods = non_monotonic_models, -# dose_levels = doses.sim, -# prior_list = uninf_prior_list, -# dose_weights = c(1,1,1,1,1)) -# -# success_probabilities_non_monotonic <- assessDesign( -# n_patients = Nsample, -# mods = non_monotonic_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contM) -# -# -# # Store result in list -# results_list_Bay_non_monotonic[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_non_monotonic -# -# }) list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) @@ -2051,25 +1996,6 @@ contM_2 <- getContr(mods = non_monotonic_models, contrasts_list = list(contM_2, contM, contM_2, contM) -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# -# -# success_probabilities_non_monotonic <- assessDesign( -# n_patients = nsample_list[[i]], -# mods = non_monotonic_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contrasts_list[[i]]) -# -# -# # Store result in list -# results_list_nsample_non_monotonic_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_non_monotonic -# -# } chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) @@ -2183,25 +2109,8 @@ contM_2 <- getContr(mods = var_models, dose_weights = c(2,1,1,2)) contrasts_list = list(contM_2, contM, contM_2, contM) -# # Loop over nsample values -# for (i in seq_along(nsample_list_var)) { -# -# -# -# success_probabilities_var <- assessDesign( -# n_patients = nsample_list_var[[i]], -# mods = var_models, -# prior_list = var_uninf_prior_list, -# sd = sd.sim_var, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contrasts_list[[i]]) -# -# -# # Store result in list -# results_list_nsample_Bay_var[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_var -# -# } + +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) @@ -2273,6 +2182,15 @@ plot_minimal plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) plot_monotonic_max_eff +#table with results +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 7), font_size = 15, bold = TRUE) + +monotonic_Bay$kable_result + + results_monotonic_max_eff <- data.table( linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$linear), exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$exp), @@ -2296,6 +2214,14 @@ plot_monotonic plot_non_monotonic_max_eff <- plot_max_eff(results_non_monotonic_MCP, results_non_monotonic_Bay, non_monotonic_scenario) plot_non_monotonic_max_eff +# table results +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +non_monotonic_Bay$kable_result + results_non_monotonic_max_eff <- data.table( linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), @@ -2318,6 +2244,14 @@ plot_non_monotonic plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) plot_var_max_eff +#table with results +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +variability_Bay$kable_result + results_var_max_eff <- data.table( linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$linear), exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$exponential), @@ -2333,90 +2267,257 @@ plot_var ## Nsample ```{r} -nsample_vector <- as.vector(c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)")) +nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) ``` ### minimal scenario ```{r} -results_min_nsample <- data.table( - linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), - exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), - emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), - nsample_vector = nsample_vector -) +# results_min_nsample <- data.table( +# linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), +# exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), +# emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), +# nsample_vector = nsample_vector +# ) +# +# results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") +# +# plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") +# plot_minimal_nsample -results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +minimal_nsample_Bay$kable_result + -plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") -plot_minimal_nsample -################################## -library(tidyverse) -# bar_data_min <- data.table( - Bay_linear = minimal_nsample_Bay$result_table$linear, - Bay_exp = minimal_nsample_Bay$result_table$exponential, - Bay_emax = minimal_nsample_Bay$result_table$emax, - diff_linear = results_min_nsample$linear, - diff_exp = results_min_nsample$exponential, - diff_emax = results_min_nsample$emax +data_plot_nsample_min <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = minimal_nsample_Bay$result_table$linear, + end_linear = results_min_MCP_nsample$Linear, + start_exp = minimal_nsample_Bay$result_table$exponential, + end_exp = results_min_MCP_nsample$Exponential, + start_emax = minimal_nsample_Bay$result_table$emax, + end_emax = results_min_MCP_nsample$Emax ) +# Create the plot +ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes") + + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + + ``` + + + ### monotonic scenario ```{r} -results_monotonic_nsample <- data.table( - linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), - exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), - emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), - logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), - sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), - nsample_vector = nsample_vector +# results_monotonic_nsample <- data.table( +# linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), +# exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), +# emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), +# logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), +# sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), +# nsample_vector = nsample_vector +# ) +# +# results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") +# +# plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") +# plot_monotonic_nsample + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +monotonic_nsample_Bay$kable_result + +data_plot_nsample_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = monotonic_nsample_Bay$result_table$linear, + end_linear = results_monotonic_MCP_nsample$Linear, + start_exp = monotonic_nsample_Bay$result_table$exponential, + end_exp = results_monotonic_MCP_nsample$Exponential, + start_emax = monotonic_nsample_Bay$result_table$emax, + end_emax = results_monotonic_MCP_nsample$Emax, + start_logistic = monotonic_nsample_Bay$result_table$logistic, + end_logistic = results_monotonic_MCP_nsample$Logistic, + start_sigemax = monotonic_nsample_Bay$result_table$sigEmax, + end_sigemax = results_monotonic_MCP_nsample$sigEmax ) -results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") -plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") -plot_monotonic_nsample +# Create the plot +ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + ``` ### non-monotonic scenario ```{r} -results_non_monotonic_nsample <- data.table( - linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), - emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), - sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), - quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), - beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), - nsample_vector = nsample_vector - ) +# results_non_monotonic_nsample <- data.table( +# linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), +# emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), +# sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), +# quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), +# beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), +# nsample_vector = nsample_vector +# ) +# +# results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") +# +# plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") +# plot_non_monotonic_nsample + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 6), font_size = 15, bold = TRUE) + +non_monotonic_nsample_Bay$kable_result + +data_plot_nsample_non_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = non_monotonic_nsample_Bay$result_table$linear, + end_linear = results_non_monotonic_MCP_nsample$Linear, + start_emax = non_monotonic_nsample_Bay$result_table$emax, + end_emax = results_non_monotonic_MCP_nsample$Emax, + start_sigemax = non_monotonic_nsample_Bay$result_table$sigEmax, + end_sigemax = results_non_monotonic_MCP_nsample$sigEmax, + start_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, + end_quadratic = results_non_monotonic_MCP_nsample$quadratic, + start_beta = non_monotonic_nsample_Bay$result_table$betaMod, + end_beta = results_non_monotonic_MCP_nsample$beta +) + + +# Create the plot +ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + -results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") -plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") -plot_non_monotonic_nsample ``` ### variability sceanrio ```{r} -results_var_nsample <- data.table( - linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), - exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), - emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), - nsample_vector = nsample_vector +# results_var_nsample <- data.table( +# linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), +# exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), +# emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), +# nsample_vector = nsample_vector +# ) +# +# results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") +# +# +# plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") +# plot_var_nsample + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +var_nsample_Bay$kable_result + + +data_plot_nsample_var <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = var_nsample_Bay$result_table$linear, + end_linear = results_var_MCP_nsample$Linear, + start_exp = var_nsample_Bay$result_table$exponential, + end_exp = results_var_MCP_nsample$Exponential, + start_emax = var_nsample_Bay$result_table$emax, + end_emax = results_var_MCP_nsample$Emax ) -results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") +# Create the plot +ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") -plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") -plot_var_nsample ``` ## different n_sim @@ -2426,7 +2527,8 @@ plot_var_nsample ```{r} # Define a vector of different n_sim values -n_sim_values <- c(100, 500, 1000, 5000, 10000) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values <- c(100, 500, 1000, 2500, 5000) # Initialize a list to store the results results_list_nsim_Bay <- list() @@ -2444,23 +2546,27 @@ contM <- getContr(mods = min_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { -# Loop over the n_sim_values -for (i in n_sim_values) { - # Run the simulation with the current n_sim value - success_probabilities <- assessDesign( + + # Simulation step + success_probabilities_min <- assessDesign( n_patients = Nsample, mods = min_models, prior_list = uninf_prior_list, sd = sd.sim, - n_sim = i, + n_sim = n_sim_values_list[[i]], alpha_crit_val = alpha, contr = contM) - # Store the results in the list - results_list_nsim_Bay[[as.character(i)]] <- success_probabilities -} + }) +} results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) @@ -2469,14 +2575,6 @@ results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenar ```{r warning=FALSE} -#Warning: the line search routine failed, possibly due to insufficient numeric precision -#Are 10.000 simulations enough? MCPModPack only up to <=10000? - -# Initialize a list to store the results -results_list_nsim_MCP = list( - power_min_nsim_linear = vector(), - power_min_nsim_exp = vector(), - power_min_nsim_emax = vector()) # assumed dose - response model sim_models_min_linear = list(linear = NA, @@ -2494,29 +2592,34 @@ sim_models_min_emax = list( emax = 0.6666667, sd = rep(sd.sim, length(doses.sim)), placebo_effect = plc.guess) -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Loop over the n_sim_values -for (i in n_sim_values) { - sim_parameters$nsims <- i - # power values for different assumed true models - power_nsim_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) - results_list_nsim_MCP$power_min_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power - power_nsim_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) - results_list_nsim_MCP$power_min_nsim_exp[as.character(i)] <-power_nsim_exp$sim_results$power +list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) - power_nsim_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) - results_list_nsim_MCP$power_min_nsim_emax[as.character(i)] <- power_nsim_exp$sim_results$power +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) +results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + } + + + ``` @@ -2525,9 +2628,9 @@ for (i in n_sim_values) { ```{r} #safe results in data.table for plot results_nsim <- data.table( - MCP_linear = results_list_nsim_MCP$power_min_nsim_linear, - MCP_exp = results_list_nsim_MCP$power_min_nsim_exp, - MCP_emax = results_list_nsim_MCP$power_min_nsim_emax, + MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP[[6]]$sim_results$power, results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power, results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power), Bay_linear = results_nsim_Bay$Bay_linear, Bay_exp = results_nsim_Bay$Bay_exponential, Bay_emax = results_nsim_Bay$Bay_emax) @@ -2566,73 +2669,85 @@ contM <- getContr(mods = monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -# Loop over the n_sim_values -for (i in n_sim_values) { - # Run the simulation with the current n_sim value - success_probabilities <- assessDesign( +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( n_patients = Nsample, mods = monotonic_models, prior_list = uninf_prior_list, sd = sd.sim, - n_sim = i, + n_sim = n_sim_values_list[[i]], alpha_crit_val = alpha, contr = contM) - # Store the results in the list - results_list_nsim_Bay_monotonic[[as.character(i)]] <- success_probabilities + }) + } + results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) ``` ```{r warning=FALSE} -results_list_nsim_MCP_monotonic = list( - power_monotonic_nsim_linear = vector(), - power_monotonic_nsim_exp = vector(), - power_monotonic_nsim_emax = vector(), - power_monotonic_nsim_logistic = vector(), - power_monotonic_nsim_sigemax = vector()) + sim_models_monotonic_linear$max_effect <- expectedEffect_fix sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix sim_models_monotonic_logistic$max_effect <- expectedEffect_fix sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) -# Loop over the n_sim_values -for (i in n_sim_values) { - sim_parameters$nsims <- i - - # power values for different assumed true models - power_nsim_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) - results_list_nsim_MCP_monotonic$power_monotonic_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power - - power_nsim_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) - results_list_nsim_MCP_monotonic$power_monotonic_nsim_exp[as.character(i)] <-power_nsim_exp$sim_results$power - - power_nsim_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) - results_list_nsim_MCP_monotonic$power_monotonic_nsim_emax[as.character(i)] <- power_nsim_exp$sim_results$power - - power_nsim_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) - results_list_nsim_MCP_monotonic$power_monotonic_nsim_logistic[as.character(i)] <- power_nsim_logistic$sim_results$power - - power_nsim_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) - results_list_nsim_MCP_monotonic$power_monotonic_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power +results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} -} ``` ```{r} #safe results in data.table for plot results_nsim_monotonic <- data.table( - MCP_linear = results_list_nsim_MCP_monotonic$power_monotonic_nsim_linear, - MCP_exp = results_list_nsim_MCP_monotonic$power_monotonic_nsim_exp, - MCP_emax = results_list_nsim_MCP_monotonic$power_monotonic_nsim_emax, - MCP_logistic = results_list_nsim_MCP_monotonic$power_monotonic_nsim_logistic, - MCP_sigemax = results_list_nsim_MCP_monotonic$power_monotonic_nsim_sigemax, + MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power), + MCP_logistic = c(results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power, results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power, results_list_nsim_MCP_monotonic[[25]]$sim_results$power), Bay_linear = results_nsim_Bay_monotonic$Bay_linear, Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, Bay_emax = results_nsim_Bay_monotonic$Bay_emax, @@ -2656,6 +2771,7 @@ plot_nsim_monotonic ### non - monotonic scenario ```{r} + # Initialize list to store results results_list_nsim_Bay_non_monotonic <- list() @@ -2676,23 +2792,32 @@ contM <- getContr(mods = non_monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -# Loop over the n_sim_values -for (i in n_sim_values) { - # Run the simulation with the current n_sim value - success_probabilities <- assessDesign( +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( n_patients = Nsample, mods = non_monotonic_models, prior_list = uninf_prior_list, sd = sd.sim, - n_sim = i, + n_sim = n_sim_values_list[[i]], alpha_crit_val = alpha, contr = contM) - # Store the results in the list - results_list_nsim_Bay_non_monotonic[[as.character(i)]] <- success_probabilities + }) + } + results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) ``` @@ -2700,40 +2825,60 @@ results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_B results_list_nsim_MCP_non_monotonic = list( power_non_monotonic_nsim_linear = vector(), power_non_monotonic_nsim_emax = vector(), - power_non_monotonic_nsim_sigemax= vector(), - power_non_monotonic_nsim_quadratic = vector(), - power_non_monotonic_nsim_beta = vector()) - -sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix -sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix + power_non_monotonic_nsim_sigemax= vector() + #power_non_monotonic_nsim_quadratic = vector(), + #power_non_monotonic_nsim_beta = vector() + ) +sim_models_non_monotonic_linear = list(linear = NA, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) -# Loop over the n_sim_values -for (i in n_sim_values) { - sim_parameters$nsims <- i +sim_models_non_monotonic_emax= list(emax = 0.6666667, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) - # power values for different assumed true models - power_nsim_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) - results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power +sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) - power_nsim_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) - results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_emax[as.character(i)] <-power_nsim_emax$sim_results$power - power_nsim_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) - results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax[as.character(i)] <- power_nsim_sigemax$sim_results$power +sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix - #power_nsim_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) - #results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_quadratic[as.character(i)] <- power_nsim_quadratic$sim_results$power +list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, + sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, + sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) - #power_nsim_beta <- func_sim(sim_models_non_monotonic_beta, sim_parameters) - #results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_beta[as.character(i)] <- power_nsim_beta$sim_results$power +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) +results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} -} ``` ```{r} @@ -2744,10 +2889,10 @@ for (i in n_sim_values) { ```{r} #safe results in data.table for plot results_nsim_non_monotonic <- data.table( - MCP_linear = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_linear, - MCP_emax = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_emax, - MCP_sigemax = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, - MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, + MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power), + #MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, Bay_emax = results_nsim_Bay_monotonic$Bay_emax, Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, @@ -2789,23 +2934,48 @@ contM <- getContr(mods = var_models, prior_list = var_uninf_prior_list, dose_weights = c(1,1,1,1)) -# Loop over the n_sim_values -for (i in n_sim_values) { - # Run the simulation with the current n_sim value - success_probabilities <- assessDesign( +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( n_patients = Nsample_var, mods = var_models, prior_list = var_uninf_prior_list, sd = sd.sim_var, - n_sim = i, + n_sim = n_sim_values_list[[i]], alpha_crit_val = alpha, contr = contM) - # Store the results in the list - results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities + }) + } +# # Loop over the n_sim_values +# for (i in n_sim_values) { +# # Run the simulation with the current n_sim value +# success_probabilities <- assessDesign( +# n_patients = Nsample_var, +# mods = var_models, +# prior_list = var_uninf_prior_list, +# sd = sd.sim_var, +# n_sim = i, +# alpha_crit_val = alpha, +# contr = contM) +# +# # Store the results in the list +# results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities +# } + + results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) ``` @@ -2822,29 +2992,41 @@ sim_models_var_emax$max_effect <- expectedEffect_fix sim_parameters_var$n <- Nsample_var -# Loop over the n_sim_values -for (i in n_sim_values) { - sim_parameters_var$nsims <- i - - # power values for different assumed true models - power_nsim_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) - results_list_nsim_MCP_var$power_var_nsim_linear[as.character(i)] <- power_nsim_linear$sim_results$power - - power_nsim_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) - results_list_nsim_MCP_var$power_var_nsim_exp[as.character(i)] <- power_nsim_exp$sim_results$power + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { - power_nsim_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) - results_list_nsim_MCP_var$power_var_nsim_emax[as.character(i)] <- power_nsim_emax$sim_results$power + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) } + + ``` ```{r} #safe results in data.table for plot results_nsim_var <- data.table( - MCP_linear = results_list_nsim_MCP_var$power_var_nsim_linear, - MCP_exp = results_list_nsim_MCP_var$power_var_nsim_exp, - MCP_emax = results_list_nsim_MCP_var$power_var_nsim_emax, + MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_var[[6]]$sim_results$power, results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power, results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power), Bay_linear = results_nsim_Bay_var$Bay_linear, Bay_exp = results_nsim_Bay_var$Bay_exponential, Bay_emax = results_nsim_Bay_var$Bay_emax From 81dcb2a32f496c61a78020bc7a0bb2b8b83b037b Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Thu, 18 Jul 2024 13:55:28 +0100 Subject: [PATCH 21/39] updates --- .../Comparison_BayesianMCPMod.qmd | 506 ++++ .../Comparison_MCPModPack.qmd | 1113 +++++++++ .../Comparison_vignette.qmd | 2089 ++--------------- 3 files changed, 1845 insertions(+), 1863 deletions(-) create mode 100644 vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd create mode 100644 vignettes/Comparison_vignette/Comparison_MCPModPack.qmd diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd new file mode 100644 index 0000000..e32ab96 --- /dev/null +++ b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd @@ -0,0 +1,506 @@ +--- +title: "Vignette BayesianMCPMod - BayesianMCPMod Analysis" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + +Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. + + +# Prior Specification +We use an uninformativ prior. + +```{r} +uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") + +) +``` + +To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. + +## Minimal scnenario +### varying expected effect for maximum dose + + +```{r} + +# list to store results +results_list_Bay_min <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + #optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) + +minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) + +minimal_Bay$kable_result + + + +``` +### varying sample size + + +```{r} +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + +# Initialize list to store results +results_list_nsample_min_Bay <- list() + +#Models with maxEff = 0.2 +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_min <- assessDesign( + n_patients = nsample_list[[i]], + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) + +minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) +minimal_nsample_Bay$kable_result + + + +``` + + + +## Monotonic scenario + +### varying expected effect for maximum dose + +```{r} +results_list_Bay_monotonic <- list() + + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + # optimal contrasts + contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # perform Simulations + success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + + }) + +} + + +##power results in vector for tables +results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) + + +monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) + + +monotonic_Bay$kable_result + + + +``` + +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_monotonic_Bay <- list() + +# dose - response models +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) + + +monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) +monotonic_nsample_Bay$kable_result + + +``` + + +## Non-monotonic scenario +### varying expected effect for maximum dose +```{r} +results_list_Bay_non_monotonic <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + + non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts + contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + }) + +} + +results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) + +non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) + +non_monotonic_Bay$kable_result + + +``` +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_non_monotonic_Bay <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +contM_2 <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) + +contrasts_list = list(contM_2, contM, contM_2, contM) + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_non_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) + + +non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) +non_monotonic_nsample_Bay$kable_result + + +``` + + +## Variability scenario +### varying expected effect for maximum dose +```{r} + +# prior +var_uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) + +results_list_Bay_var <- list() + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + var_models <- Mods(linear = NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + + success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + +results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) + +variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) + +variability_Bay$kable_result + + +``` +### varying sample size +```{r} +results_list_nsample_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +contM_2 <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(2,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) + +results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + success_probabilities_var <- assessDesign( + n_patients = nsample_list_var[[i]], + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) + + +var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) +var_nsample_Bay$kable_result + + +``` \ No newline at end of file diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd new file mode 100644 index 0000000..9143455 --- /dev/null +++ b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd @@ -0,0 +1,1113 @@ +--- +title: "Vignette BayesianMCPMod - MCPModPack Analysis" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + +Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. + +## Minimal scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_min <- list() + +# Run simulation +func_sim <- function(models ,sim_models, sim_parameters){ + +sim_result = MCPModSimulation(endpoint_type = "Normal", + models = models, + alpha = alpha, + direction = "increasing", + model_selection = "aveAIC", + Delta = 0.1, + sim_models = sim_models, + sim_parameters = sim_parameters) +} + + +list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + + +#store results +results_min_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_min[[1]]$sim_results$power), + exponential = c(results_list_min[[2]]$sim_results$power), + emax = c(results_list_min[[3]]$sim_results$power), + Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, + sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, + sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, + sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, + sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) + + +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +### varying sample size +```{r warning=FALSE} +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +# store results +power_min_nsample_linear <- vector() +power_min_nsample_exp <- vector() +power_min_nsample_emax <- vector() + + + + + +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# # Set max_effect to 0.2 +# min_modelsPack$max_effect <- expectedEffect_fix +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) +# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) +# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) +# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power +# +# } +# Set max_effect to 0.2 +min_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) + +#ind_tasks <- 1:12 + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + +# store results +results_min_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), + Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), + Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), + Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, + sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, + sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, + sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) +) + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +## Monotonic scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response models +sim_models_monotonic_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_emax= list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_monotonic <- list() + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_monotonic_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_monotonic[[1]]$sim_results$power), + exp = c(results_list_monotonic[[2]]$sim_results$power), + emax = c(results_list_monotonic[[3]]$sim_results$power), + logistic = c(results_list_monotonic[[4]]$sim_results$power), + sigEmax = c(results_list_monotonic[[5]]$sim_results$power), + Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) +) + +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assumed dose- response model with assumed maximum effect = 0.2 +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +# store results +power_monotonic_nsample_linear <- vector() +power_monotonic_nsample_exp <- vector() +power_monotonic_nsample_emax <- vector() +power_monotonic_nsample_logistic <- vector() +power_monotonic_nsample_sigemax <- vector() + + + +# Set max_effect to 0.2 +monotonic_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +# store results +results_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), + Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), + Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), + Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), + sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), +Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) + + +``` + +## Non-monotonic scenario + +### varying expected effect for maximum dose + +For the simulations of the non-monotonic scenario, the R package 'Dosefinding' was used instead of 'MCPModPack + +```{r} +# linear with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_linear <- result$linear +``` + + +```{r} +# emax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` + + +```{r} +# sigemax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` +``` + + + +```{r} +#quadratic with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` + +``` + +```{r} +# beta with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` +``` + + +```{r} +#linear, emax, sigemax, quadratic +results_non_monotonic_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = power_non_monotonic_linear, + emax = power_non_monotonic_emax, + sigEmax = power_non_monotonic_sigemax, + quadratic = power_non_monotonic_quadratic, + beta = power_non_monotonic_beta, + average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), + (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), + (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), + (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), + (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) + ) + + +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) +``` + +### varying sample size + +```{r warning=FALSE} + + +# store results +power_non_monotonic_nsample_linear <- vector() +power_non_monotonic_nsample_emax <- vector() +power_non_monotonic_nsample_quadratic <- vector() +power_non_monotonic_nsample_sigemax <- vector() +power_non_monotonic_nsample_beta <- vector() + + +``` + +```{r} +# linear with DoseFinding +# allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[2] <- result$linear[1] +power_non_monotonic_nsample_linear[4] <- result$linear[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[1] <- result$linear[1] +power_non_monotonic_nsample_linear[3] <- result$linear[2] +``` + + +```{r} + +# emax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] +``` + + + +```{r} +# sigemax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] +``` + + + + +```{r} +# quadratic with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] +``` + + + +```{r} +# beta with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] +``` + + +```{r} +#store results +results_non_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_non_monotonic_nsample_linear, + Emax = power_non_monotonic_nsample_emax, + sigEmax = power_non_monotonic_nsample_sigemax, + quadratic = power_non_monotonic_nsample_quadratic, + beta = power_non_monotonic_nsample_beta +) + + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) + +``` + +## Variability scenario +### varying expected effect for maximum dose + +```{r warning=FALSE} +# assumed dose - response model +sim_models_var_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_emax = list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + + + +# Simulation parameters +sim_parameters_var = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# perform Simulations + +list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) + + }) + +} + + +# store results +results_var_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = results_list_var[[1]]$sim_results$power, + exponential = results_list_var[[2]]$sim_results$power, + emax = results_list_var[[3]]$sim_results$power, + average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), + (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), + (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), + (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), + (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) +) + +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + + +# store results +power_var_nsample_linear <- vector() +power_var_nsample_exp <- vector() +power_var_nsample_emax <- vector() + +# # Loop over nsample values +# for (i in seq_along(nsample_list_var)) { +# +# # Update nsample in simulation parameters +# sim_parameters_var$n <- nsample_list_var[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) +# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) +# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# +# } + +var_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list_var[[i]], + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_var_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), + Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), + Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), + Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), + (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), + (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), + (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) +) + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +``` \ No newline at end of file diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index d1fde40..32adac4 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -13,9 +13,11 @@ vignette: > %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} %\VignetteEncoding{UTF-8} %\VignetteEngine{quarto::html} +editor: + markdown: + wrap: 72 --- - ```{r} #| code-summary: setup #| code-fold: true @@ -174,16 +176,15 @@ print_result_Bay_nsample <- function(results, scenario, variable) { list(result_table = result_table, kable_result = kable_result) } -plot_power_deviation <- function(data, x, xlab){ +plot_power_deviation <- function(data, x, xlab, xlim){ plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ geom_point()+ geom_line() + - scale_x_continuous(breaks = c(100, 500, 1000, 2500, 5000)) + + scale_x_continuous(breaks = xlim) + geom_hline(aes(yintercept = 0), linetype = 2)+ scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ labs(x = xlab, y = "power deviation")+ ylim(-0.2, 0.2)+ #with higher n_sim!!!!!!!!!!!! - #scale_x_continuous(breaks = c(100, 500, 1000, 2500, 5000))+ theme_classic() return(plot) } @@ -229,7 +230,7 @@ data <- data.table( ylim(0, 1)+ ylab("power")+ xlab("assumed true model")+ - labs(title = "All scenarios with different assumed maximum effects")+ + labs(title = "Power for different models and differen exptected effects for maximum dose")+ theme_bw() plot_max_eff @@ -244,1906 +245,274 @@ chunkVector <- function (x, n_chunks) { chunk_list <- list(x) } else { chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) - } - return(chunk_list) -} - -library(BayesianMCPMod) -library(RBesT) -library(clinDR) -library(dplyr) -library(tibble) -library(reactable) -library(DoseFinding) -library(MCPModPack) -library(kableExtra) -library(data.table) -library(doFuture) -library(doRNG) - -registerDoFuture() -plan(multisession) - - - -set.seed(7015) -``` - - -# Introduction - -This vignette demonstrates the application of the {BayesianMCPMod} package for sample size calculations and the comparison with the {MCPModPack} package. - -```{r} -####### General assumptions ######### -# simulations -n_sim <- 1000 - -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) -nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") - -# define input parameters -doses.sim <- c(0,1,2,4,8) # dose levels -max.dose <- max(doses.sim) # specify max dose possibly available -plc.guess <- 0 # expected placebo effect -Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) -expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) -expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) -sd.sim <- c(0.4) - -#input paramters variability scenario -doses_var <- c(0, 1, 4, 8) -sd.sim_var <- 0.4 -Nsample_var <- c(25, 25, 25, 25) -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - - -# define model functions -emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") -exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) -logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) -sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") -quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") -beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) - -### define models to be tested in MCPMod -models <- Mods(linear=NULL, - emax = emax.g, - exponential = exp.g, - logistic=logit.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) # SB: Please add this to all Mods where we are using the beta model -) - -alpha <- 0.05 - -display_params_table(models) - - -kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) - - -kable(t(data.table(placebo_guess = plc.guess, - sd = sd.sim[1], - alpha = alpha )))%>% - kable_classic(full_width = TRUE) - -``` -## Scenarios - -In order to test and compare BayesianMCPMod and MCPModPack sample size calculations in different scenarios, the data -used for the comparisons will be simulated multiple times using different input values. -Every scenario will be named to make the differentiation between each scenario simpler. -Altogether, four different scenarios were simulated. - -```{r} - -#Specification of considered models for different scenarios for BayesianMCPMod - -min_scenario <- c("linear", "exponential", "emax") -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(min_models, main = "minimal Scenario") - - -monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(monotonic_models, main = "monotonic Scenario") - - -non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) -) -plot(non_monotonic_models,main = "non monotonic Scenario") - - -variability_scenario <- c("linear","exponential", "emax") - -kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c( "Doses variability scenario" = 5), font_size = 15) - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(var_models, main = "variability Scenario") - -``` - - - - -# MCPModPack - - - -```{r} - -#Specification of considered models for different scenarios for MCPModPack - -min_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667) - -monotonic_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -non_monotonic_modelsPack = list(linear = NA, - emax = 0.6666667 , - sigEmax = c(1.528629, 4.087463), - quadratic = -0.09688711) -#beta - -var_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -``` - -## minimal - -######### child = 'Comparison_MCPModPack.qmd' - - - -### maximum effect -```{r warning=FALSE} -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_min <- list() - -# Run simulation -func_sim <- function(models ,sim_models, sim_parameters){ - -sim_result = MCPModSimulation(endpoint_type = "Normal", - models = models, - alpha = alpha, - direction = "increasing", - model_selection = "aveAIC", - Delta = 0.1, - sim_models = sim_models, - sim_parameters = sim_parameters) -} - - -list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - - - -#store results -results_min_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_min[[1]]$sim_results$power), - exponential = c(results_list_min[[2]]$sim_results$power), - emax = c(results_list_min[[3]]$sim_results$power), - Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, - sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, - sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, - sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, - sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) - - -kable(results_min_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -### Nsample -```{r warning=FALSE} -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - -# store results -power_min_nsample_linear <- vector() -power_min_nsample_exp <- vector() -power_min_nsample_emax <- vector() - - - - - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# # Update nsample in simulation parameters -# sim_parameters$n <- nsample_list[[i]] -# -# # Set max_effect to 0.2 -# min_modelsPack$max_effect <- expectedEffect_fix -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) -# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) -# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) -# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power -# -# } -# Set max_effect to 0.2 -min_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) - -#ind_tasks <- 1:12 - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - -# store results -results_min_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), - Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), - Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), - Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, - sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, - sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, - sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) -) - -kable(results_min_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -## monotonic - -### maximum effect -```{r warning=FALSE} -# assumed dose - response models -sim_models_monotonic_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_emax= list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_monotonic <- list() - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_monotonic_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_monotonic[[1]]$sim_results$power), - exp = c(results_list_monotonic[[2]]$sim_results$power), - emax = c(results_list_monotonic[[3]]$sim_results$power), - logistic = c(results_list_monotonic[[4]]$sim_results$power), - sigEmax = c(results_list_monotonic[[5]]$sim_results$power), - Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) -) - -kable(results_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) - - -``` - -### Nsample -```{r warning=FALSE} -# assumed dose- response model with assumed maximum effect = 0.2 -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -# store results -power_monotonic_nsample_linear <- vector() -power_monotonic_nsample_exp <- vector() -power_monotonic_nsample_emax <- vector() -power_monotonic_nsample_logistic <- vector() -power_monotonic_nsample_sigemax <- vector() - - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# # Update nsample in simulation parameters -# sim_parameters$n <- nsample_list[[i]] -# -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(monotonic_modelsPack, sim_models_monotonic_linear, sim_parameters) -# power_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(monotonic_modelsPack, sim_models_monotonic_exp, sim_parameters) -# power_monotonic_nsample_exp[i] <- power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(monotonic_modelsPack, sim_models_monotonic_emax, sim_parameters) -# power_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power -# -# power_nsample_logistic <- func_sim(monotonic_modelsPack, sim_models_monotonic_logistic, sim_parameters) -# power_monotonic_logistic <- power_nsample_logistic$sim_results$power -# -# power_nsample_sigemax <- func_sim(monotonic_modelsPack, sim_models_monotonic_sigemax, sim_parameters) -# power_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power -# -# } - - -# Set max_effect to 0.2 -monotonic_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -# store results -results_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), - Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), - Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), - Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), - sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), -Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) - - -kable(results_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) - - -``` -## non - monotonic - -### maximum effects - -### linear with DoseFinding package -```{r} - -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_linear <- result$linear -``` - - -### emax with DoseFinding package -```{r} - -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` -``` - -### sigemax with DoseFinding package -```{r} - -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` -``` - - -### quadratic with DoseFinding package -```{r} - -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` - -``` -### beta with DoseFinding package -```{r} - -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` -``` - - -```{r} -#linear, emax, sigemax, quadratic -results_non_monotonic_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = power_non_monotonic_linear, - emax = power_non_monotonic_emax, - sigEmax = power_non_monotonic_sigemax, - quadratic = power_non_monotonic_quadratic, - beta = power_non_monotonic_beta, - average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), - (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), - (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), - (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), - (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) - ) - - -kable(results_non_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) -``` - -### Nsample - -```{r warning=FALSE} - -# # assume maximum effect = 0.2 -# sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -# sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -# sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -# sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix -# -# store results -power_non_monotonic_nsample_linear <- vector() -power_non_monotonic_nsample_emax <- vector() -power_non_monotonic_nsample_quadratic <- vector() -power_non_monotonic_nsample_sigemax <- vector() -power_non_monotonic_nsample_beta <- vector() - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# # Update nsample in simulation parameters -# sim_parameters$n <- nsample_list[[i]] -# -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_linear, sim_parameters) -# power_non_monotonic_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_emax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_emax, sim_parameters) -# power_non_monotonic_nsample_emax[i] <-power_nsample_emax$sim_results$power -# -# power_nsample_sigemax <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_sigemax, sim_parameters) -# power_non_monotonic_nsample_sigemax[i] <- power_nsample_sigemax$sim_results$power -# -# #power_nsample_quadratic <- func_sim(non_monotonic_modelsPack, sim_models_non_monotonic_quadratic, sim_parameters) -# #power_non_monotonic_nsample_quadratic[i] <- power_nsample_quadratic$sim_results$power -# -# -# } - - -``` -### linear with DoseFinding -```{r} -# allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[2] <- result$linear[1] -power_non_monotonic_nsample_linear[4] <- result$linear[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[1] <- result$linear[1] -power_non_monotonic_nsample_linear[3] <- result$linear[2] -``` - - -### emax with DoseFinding -```{r} -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] -``` - - -### sigemax with DoseFinding -```{r} -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] -``` - - -### quadratic with DoseFinding - -```{r} -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] -``` - -### beta with DoseFinding - -```{r} -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] -``` - - -```{r} -#store results -results_non_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = power_non_monotonic_nsample_linear, - Emax = power_non_monotonic_nsample_emax, - sigEmax = power_non_monotonic_nsample_sigemax, - quadratic = power_non_monotonic_nsample_quadratic, - beta = power_non_monotonic_nsample_beta -) - - -kable(results_non_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) - -``` - -## variability -### maximum effect - -```{r warning=FALSE} -# assumed dose - response model -sim_models_var_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_emax = list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - - - -# Simulation parameters -sim_parameters_var = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# perform Simulations - -list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) - - }) - -} - - -# store results -results_var_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = results_list_var[[1]]$sim_results$power, - exponential = results_list_var[[2]]$sim_results$power, - emax = results_list_var[[3]]$sim_results$power, - average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), - (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), - (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), - (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), - (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) -) - -kable(results_var_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - - -``` - -### Nsample -```{r warning=FALSE} -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - - -# store results -power_var_nsample_linear <- vector() -power_var_nsample_exp <- vector() -power_var_nsample_emax <- vector() - -# # Loop over nsample values -# for (i in seq_along(nsample_list_var)) { -# -# # Update nsample in simulation parameters -# sim_parameters_var$n <- nsample_list_var[[i]] -# -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) -# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) -# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) -# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power -# -# -# } - -var_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list_var[[i]], - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_var_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), - Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), - Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), - Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), - (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), - (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), - (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) -) - -kable(results_var_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - -``` - - -# BayesianMCPMod - - -# Prior Specification -We use an uninformativ prior. - -```{r} -uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") - -) -``` - -To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. - -## minimal -### Maximum effect - -First we assume a fix sample size of 40 patients per group and different maximum effects. - -```{r} - -# list to store results -results_list_Bay_min <- list() - -# # Simulation with different maximum effects -# results_list_Bay_min <- purrr::map( c(0.05,0.1,0.2,0.3,0.5), function(i) { -# min_models <- Mods(linear=NULL, -# exponential = exp.g, -# emax = emax.g, -# doses = doses.sim, -# placEff = plc.guess, -# maxEff = i, -# direction = "increasing") -# #optimal contrasts -# contM <- getContr(mods = min_models, -# dose_levels = doses.sim, -# prior_list = uninf_prior_list, -# dose_weights = c(1,1,1,1,1)) -# -# # Simulation step -# success_probabilities_min <- assessDesign( -# n_patients = Nsample, -# mods = min_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contM) -# -# # Store result in list -# results_list_Bay_min[[paste0("max_effect_", expectedEffect[i])]] <- success_probabilities_min -# }) -# -# -# results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) - - - -# parallel ------------------------------------------------------------------------------------- - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - #optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) - -minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) - -minimal_Bay$kable_result - - - -``` -### Nsample - -Now we assume an fix maximum effect of 0.2 and different sample sizes. - -```{r} -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - -# Initialize list to store results -results_list_nsample_min_Bay <- list() - -#Models with maxEff = 0.2 -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# -# # Simulations -# success_probabilities_min <- assessDesign( -# n_patients = nsample_list[[i]], -# mods = min_models, -# prior_list = uninf_prior_list, -# sd = sd.sim, -# n_sim = n_sim, -# alpha_crit_val = alpha, -# contr = contrasts_list[[i]]) -# -# -# # Store result in list -# results_list_nsample_min_Bay[[paste0("nsample_", nsample_list[i])]] <- success_probabilities_min -# -# } -# parallel ------------------------------------------------------- - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_min <- assessDesign( - n_patients = nsample_list[[i]], - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - - -results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) - -minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) -minimal_nsample_Bay$kable_result - - - -``` - - - -## monotonic scenario - -### Maximum effect - -```{r} -results_list_Bay_monotonic <- list() - - - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - - # optimal contrasts - contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # perform Simulations - success_probabilities_monotonic <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - - - }) - -} - - -##power results in vector for tables -results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) - - -monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) - - -monotonic_Bay$kable_result - - - -``` - -### Nsample -```{r} -# Initialize list to store results -results_list_nsample_monotonic_Bay <- list() - -# dose - response models -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) + } + return(chunk_list) } - -results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) +devtools::load_all() +#library(BayesianMCPMod) +library(RBesT) +library(clinDR) +library(dplyr) +library(tibble) +library(reactable) +library(DoseFinding) +library(MCPModPack) +library(kableExtra) +library(data.table) +library(doFuture) +library(doRNG) +registerDoFuture() +plan(multisession) -monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) -monotonic_nsample_Bay$kable_result +set.seed(7015) ``` +# Introduction -## non-monotonic scenario -### Maximum effect -```{r} -results_list_Bay_non_monotonic <- list() +This vignette demonstrates the application of the {BayesianMCPMod} +package for sample size calculations and the comparison with the +{MCPModPack} package. As for other bayesian approaches BMCPMod is able +to mimic the results of the frequentist MCPMod for non-informative +priors and this is shown here for the sample size planning of different +scenarios. +In order to test and compare BayesianMCPMod and MCPModPack sample size +calculations in different scenarios, the data used for the comparisons +will be simulated multiple times using different input values. Every +scenario will be named to make the differentiation between each scenario +simpler. Altogether, four different scenarios were simulated. The first +three scenarios are pretty similiar, they only differ in the pre-defined +set of candidate models M. The other design choices, like the number of +dose levels or sample size allocation stay the same between the +scenarios. For the first three scenarios, these design choices are: -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) +- four dose levels plus placebo (0 mg, 1 mg, 2 mg, 4 mg, 8 mg) +- total sample size of N = 200 - -results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - - non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing", - addArgs = list(scal=9.6)) +- equal allocation ratio for each dose group - #optimal contrasts - contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) +- expected effect for maximum dose of 0.2 mg - success_probabilities_non_monotonic <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) +- standard deviation of 0.4 for every dose group +The fourth scenario, the variability scenario, has some different design +choices: - three dose levels plus placebo (0 mg, 1 mg, 4 mg, 8 mg) - +total sample size of N = 100 - equal allocation ratio for each dose +group - expected effect for maximum dose of 0.2 mg - standard deviation +of 0.4 for every dose group - }) - -} - -results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) +Building on the initial scenarios, we further delve into the exploration +of varying input parameters. The varying parameters are: -non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) - -non_monotonic_Bay$kable_result +- expected effect for maximum dose of (0.05 mg, 0.1 mg, 0.2 mg, 0.3 + mg, 0.5 mg) +- different total sample size with different allocation: + +- (40,20,20,20,40), (30,30,30,30,30), (48,24,24,24,48), + (36,36,36,36,36) (for the first three scenarios) + +- (40,20,20,40), (30,30,30,30), (48,24,24,48), (36,36,36,36) (for the + variability scenario) + +In a subsequent step, we extend our analysis to test the convergence of +power values as the number of simulations increases. For this part of +the study, we assume an expected effect for the maximum dose of 0.2 mg. +The sample size is set to 200 for the linear, monotonic and +non-monotonic scenario and 100 for the variability scenario. This +further exploration allows us to deepen our understanding of the +BayesianMCPMod and MCPModPack packages and their performance under +varying conditions. -``` -### Nsample ```{r} -# Initialize list to store results -results_list_nsample_non_monotonic_Bay <- list() +####### General assumptions ######### +# simulations +n_sim <- 1000 -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) +nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") + +# define input parameters +doses.sim <- c(0,1,2,4,8) # dose levels +max.dose <- max(doses.sim) # specify max dose possibly available +plc.guess <- 0 # expected placebo effect +Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) +expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) +expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) +sd.sim <- c(0.4) -contM_2 <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) +#input paramters variability scenario +doses_var <- c(0, 1, 4, 8) +sd.sim_var <- 0.4 +Nsample_var <- c(25, 25, 25, 25) +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) -contrasts_list = list(contM_2, contM, contM_2, contM) - +# define model functions +emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") +exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) +logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) +sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") +quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") +beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_non_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) -} - +### define models to be tested in MCPMod +models <- Mods(linear=NULL, + emax = emax.g, + exponential = exp.g, + logistic=logit.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) -results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) +alpha <- 0.05 +# display_params_table(models) -non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) -non_monotonic_nsample_Bay$kable_result +# kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% +# kable_classic(full_width = TRUE)%>% +# add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) +# +# +# kable(t(data.table(placebo_guess = plc.guess, +# sd = sd.sim[1], +# alpha = alpha )))%>% +# kable_classic(full_width = TRUE) ``` +## Scenarios + +In the following the candidate models for the different scenarios are +plotted. -## variability scenario -### Maximum effect ```{r} -# prior -var_uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) - -results_list_Bay_var <- list() +#Specification of considered models for different scenarios for BayesianMCPMod +min_scenario <- c("linear", "exponential", "emax") +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(min_models, main = "minimal Scenario") -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) +monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(monotonic_models, main = "monotonic Scenario") - -results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - var_models <- Mods(linear = NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) +non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") - success_probabilities_var <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) +plot(non_monotonic_models,main = "non monotonic Scenario") - }) - -} +variability_scenario <- c("linear","exponential", "emax") -results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) +kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c( "Doses variability scenario" = 5), font_size = 15) -variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(var_models, main = "variability Scenario") -variability_Bay$kable_result +``` +# MCPModPack -``` -###Nsample ```{r} -results_list_nsample_Bay_var <- list() -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") +#Specification of considered models for different scenarios for MCPModPack -#optimal contrasts -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) +min_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667) -contM_2 <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(2,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) +monotonic_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) +non_monotonic_modelsPack = list(linear = NA, + emax = 0.6666667 , + sigEmax = c(1.528629, 4.087463), + quadratic = -0.09688711) +#beta -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) +var_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) -chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) - -results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - success_probabilities_var <- assessDesign( - n_patients = nsample_list_var[[i]], - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - +``` -results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) +```{r child = 'Comparison_MCPModPack.qmd'} +``` -var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) -var_nsample_Bay$kable_result +# BayesianMCPMod +```{r child = 'Comparison_BayesianMCPMod.qmd'} ``` - # Comparison -## maximum effect +In the following, we will draw comparisons between the power values of +various scenarios and differnt parameters. + +## varying expected effect for maximum dose + ### minimal scenario + ```{r} plot_minimal_max_eff <- plot_max_eff(results_min_MCP, results_min_Bay, min_scenario) @@ -2169,15 +538,16 @@ results_min_max_eff <- data.table( results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") -plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect") +plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) plot_minimal ``` + ```{r} ``` - ### monotonic scenario + ```{r} plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) plot_monotonic_max_eff @@ -2202,12 +572,10 @@ results_monotonic_max_eff <- data.table( results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") -plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect") +plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) plot_monotonic ``` - - ### non - monotonic scenario ```{r} @@ -2233,13 +601,12 @@ results_non_monotonic_max_eff <- data.table( results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") -plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect") +plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) plot_non_monotonic ``` ### variability scenario - ```{r} plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) plot_var_max_eff @@ -2261,16 +628,18 @@ results_var_max_eff <- data.table( results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") -plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect") +plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) plot_var ``` -## Nsample + +## varying sample size ```{r} nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) ``` ### minimal scenario + ```{r} # results_min_nsample <- data.table( @@ -2330,9 +699,6 @@ ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + ``` - - - ### monotonic scenario ```{r} @@ -2398,6 +764,7 @@ ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + ``` + ### non-monotonic scenario ```{r} @@ -2520,7 +887,7 @@ ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + ``` -## different n_sim +## convergence of power values ### minimal scenario @@ -2573,7 +940,6 @@ results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenar ``` - ```{r warning=FALSE} # assumed dose - response model @@ -2622,9 +988,6 @@ results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.charac ``` - - - ```{r} #safe results in data.table for plot results_nsim <- data.table( @@ -2644,9 +1007,10 @@ results_nsim_diff <- data.table( results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") -plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim") +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) plot_nsim ``` + ### monotonic scenario ```{r} @@ -2698,6 +1062,7 @@ results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) ``` + ```{r warning=FALSE} @@ -2765,9 +1130,10 @@ results_nsim_diff_monotonic <- data.table( results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") -plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim") +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) plot_nsim_monotonic ``` + ### non - monotonic scenario ```{r} @@ -2885,7 +1251,6 @@ results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export ``` - ```{r} #safe results in data.table for plot results_nsim_non_monotonic <- data.table( @@ -2909,12 +1274,12 @@ results_nsim_diff_non_monotonic <- data.table( results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") -plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim") +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) plot_nsim_non_monotonic ``` -### variability scenario +### variability scenario ```{r} @@ -3041,12 +1406,10 @@ results_nsim_diff_var <- data.table( results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") -plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim") +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) plot_nsim_var ``` - - ```{r} # save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, # file = "simulation_data.RData") From adc71232aac7958fb81aa3a8518aa6f1163b76b6 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 19 Jul 2024 09:51:58 +0100 Subject: [PATCH 22/39] code in extra document --- .../Comparison_BayesianMCPMod.qmd | 2 +- .../Comparison_convergence.qmd | 419 ++++++++++++++++++ .../Comparison_vignette.qmd | 402 +---------------- 3 files changed, 423 insertions(+), 400 deletions(-) create mode 100644 vignettes/Comparison_vignette/Comparison_convergence.qmd diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd index e32ab96..a18a3d3 100644 --- a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd +++ b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd @@ -19,7 +19,7 @@ Following simulations will be conducted utilizing the BayesianMCPMod' package, w # Prior Specification -We use an uninformativ prior. +In a first step an uninformativ prior is calculated. ```{r} uninf_prior_list <- list( diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd new file mode 100644 index 0000000..2b6e163 --- /dev/null +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -0,0 +1,419 @@ +--- +title: "Vignette BayesianMCPMod - convergence of power values" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + + +```{r} +# minimal BayesianMCPMod + +# Define a vector of different n_sim values +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values <- c(100, 500, 1000, 2500, 5000) + +# Initialize a list to store the results +results_list_nsim_Bay <- list() + +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") +#optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) + + +``` + +```{r warning=FALSE} +# minimal MCPModPack + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + + + +list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + +``` + + + + +```{r} +# monotonic BayesianMCPMod + +# Initialize a list to store the results + results_list_nsim_Bay_monotonic <- list() + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) + +``` + +```{r warning=FALSE} +# monotonic MCPModPack + +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + +```{r} +# non-monotonic BayesianMCPMod + +# Initialize list to store results +results_list_nsim_Bay_non_monotonic <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +# non-monotonic MCPModPack + +results_list_nsim_MCP_non_monotonic = list( + power_non_monotonic_nsim_linear = vector(), + power_non_monotonic_nsim_emax = vector(), + power_non_monotonic_nsim_sigemax= vector() + #power_non_monotonic_nsim_quadratic = vector(), + #power_non_monotonic_nsim_beta = vector() + ) + +sim_models_non_monotonic_linear = list(linear = NA, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_emax= list(emax = 0.6666667, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + +sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix + +list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, + sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, + sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + +```{r} +# variability BayesianMCPMod + +# Initialize list to store results +results_list_nsim_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +# variability MCPModPack + +results_list_nsim_MCP_var = list( + power_var_nsim_linear = vector(), + power_var_nsim_exp = vector(), + power_var_nsim_emax= vector()) + +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + +sim_parameters_var$n <- Nsample_var + + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` \ No newline at end of file diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 32adac4..89b9525 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -889,104 +889,14 @@ ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + ## convergence of power values -### minimal scenario - -```{r} - -# Define a vector of different n_sim values -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) -n_sim_values <- c(100, 500, 1000, 2500, 5000) - -# Initialize a list to store the results -results_list_nsim_Bay <- list() - -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") -#optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) +In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000. +```{r child = 'Comparison_convergence.qmd'} ``` -```{r warning=FALSE} - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - - - - -list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - +### minimal scenario -``` ```{r} #safe results in data.table for plot @@ -1013,98 +923,8 @@ plot_nsim ### monotonic scenario -```{r} -# Initialize a list to store the results - results_list_nsim_Bay_monotonic <- list() - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) - -``` - -```{r warning=FALSE} -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` - ```{r} #safe results in data.table for plot results_nsim_monotonic <- data.table( @@ -1136,120 +956,7 @@ plot_nsim_monotonic ### non - monotonic scenario -```{r} - -# Initialize list to store results -results_list_nsim_Bay_non_monotonic <- list() - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) -``` - -```{r, warning=FALSE} -results_list_nsim_MCP_non_monotonic = list( - power_non_monotonic_nsim_linear = vector(), - power_non_monotonic_nsim_emax = vector(), - power_non_monotonic_nsim_sigemax= vector() - #power_non_monotonic_nsim_quadratic = vector(), - #power_non_monotonic_nsim_beta = vector() - ) - -sim_models_non_monotonic_linear = list(linear = NA, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_non_monotonic_emax= list(emax = 0.6666667, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - - -sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix - -list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, - sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, - sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` - -```{r} - -``` ```{r} #safe results in data.table for plot @@ -1281,110 +988,7 @@ plot_nsim_non_monotonic ### variability scenario -```{r} -# Initialize list to store results -results_list_nsim_Bay_var <- list() - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - -# # Loop over the n_sim_values -# for (i in n_sim_values) { -# # Run the simulation with the current n_sim value -# success_probabilities <- assessDesign( -# n_patients = Nsample_var, -# mods = var_models, -# prior_list = var_uninf_prior_list, -# sd = sd.sim_var, -# n_sim = i, -# alpha_crit_val = alpha, -# contr = contM) -# -# # Store the results in the list -# results_list_nsim_Bay_var[[as.character(i)]] <- success_probabilities -# } - - -results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) -``` - -```{r, warning=FALSE} -results_list_nsim_MCP_var = list( - power_var_nsim_linear = vector(), - power_var_nsim_exp = vector(), - power_var_nsim_emax= vector()) - -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - -sim_parameters_var$n <- Nsample_var - - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` ```{r} #safe results in data.table for plot From 39afa727bc91b08101d804703d18b3457559b250 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Fri, 19 Jul 2024 18:57:55 +0100 Subject: [PATCH 23/39] new plots --- .../Comparison_convergence.qmd | 64 +- .../Comparison_vignette.qmd | 480 +++---- .../Comparison_BayesianMCPMod.qmd | 506 ++++++++ .../Comparison_MCPModPack.qmd | 1113 +++++++++++++++++ .../Comparison_convergence.qmd | 419 +++++++ .../Comparison_vignette.qmd | 1020 +++++++++++++++ 6 files changed, 3333 insertions(+), 269 deletions(-) create mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd create mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd create mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd create mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 2b6e163..6d2db48 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -20,8 +20,8 @@ vignette: > # minimal BayesianMCPMod # Define a vector of different n_sim values -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) -n_sim_values <- c(100, 500, 1000, 2500, 5000) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values <- c(100, 500, 1000, 2500, 5000, 10000) # Initialize a list to store the results results_list_nsim_Bay <- list() @@ -88,10 +88,12 @@ sim_models_min_emax = list( emax = 0.6666667, -list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) +list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) @@ -140,7 +142,7 @@ contM <- getContr(mods = monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -179,17 +181,17 @@ sim_models_monotonic_emax$max_effect <- expectedEffect_fix sim_models_monotonic_logistic$max_effect <- expectedEffect_fix sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) @@ -235,7 +237,7 @@ contM <- getContr(mods = non_monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -297,13 +299,13 @@ sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix #sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix #sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix -list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, - sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, - sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax +list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, + sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, + sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) @@ -345,7 +347,7 @@ contM <- getContr(mods = var_models, prior_list = var_uninf_prior_list, dose_weights = c(1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -390,12 +392,12 @@ sim_models_var_emax$max_effect <- expectedEffect_fix sim_parameters_var$n <- Nsample_var -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000, + 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 89b9525..89607cf 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -182,60 +182,17 @@ plot_power_deviation <- function(data, x, xlab, xlim){ geom_line() + scale_x_continuous(breaks = xlim) + geom_hline(aes(yintercept = 0), linetype = 2)+ + geom_hline(aes(yintercept = -0.05), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = 0.05), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = -0.1), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = 0.1), linetype = 2, color = "darkgrey")+ scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ labs(x = xlab, y = "power deviation")+ - ylim(-0.2, 0.2)+ #with higher n_sim!!!!!!!!!!!! + ylim(-0.15, 0.15)+ theme_classic() return(plot) } -#plot all max effects in one plot - -plot_max_eff <- function(results_MCP, results_Bay, scenario){ - -transformed_MCP <- t(results_MCP) -transformed_MCP <- as.data.table(transformed_MCP) -transformed_MCP <- transformed_MCP[-c(1),] - -data <- data.table( - Bay_0.05 = results_Bay$Bay_0.05, - Bay_0.1 = results_Bay$Bay_0.1, - Bay_0.2 = results_Bay$Bay_0.2, - Bay_0.3 = results_Bay$Bay_0.3, - Bay_0.5 = results_Bay$Bay_0.5, - MCP_0.05 = transformed_MCP$V1, - MCP_0.1 = transformed_MCP$V2, - MCP_0.2 = transformed_MCP$V3, - MCP_0.3 = transformed_MCP$V4, - MCP_0.5 = transformed_MCP$V5, - scenario = c(scenario, "average") -) - - - - - plot_max_eff <- ggplot(data = data)+ - geom_point(mapping = aes(x= data$scenario, y = data$Bay_0.05, colour = "MCPMod", shape = "0.05"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.05, colour = "BayesianMCPMod", shape = "0.05"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.1, colour = "MCPMod", shape = "0.1"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.1, colour = "BayesianMCPMod", shape = "0.1"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.2, colour = "MCPMod", shape = "0.2"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.2, colour = "BayesianMCPMod", shape = "0.2"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.3, colour = "MCPMod", shape = "0.3"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.3, colour = "BayesianMCPMod", shape = "0.3"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.5, colour = "MCPMod", shape = "0.5"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.5, colour = "BayesianMCPMod", shape = "0.5"), data = data, position = position_nudge(x = 0.15))+ - scale_color_manual(name = "Legend", values = c("MCPMod" = 'blue', "BayesianMCPMod" = "red"))+ - scale_shape_manual(name = "Expected effects", values = c("0.05" = 0, "0.1" = 1, "0.2" = 2, "0.3" = 3, "0.5" = 5))+ - ylim(0, 1)+ - ylab("power")+ - xlab("assumed true model")+ - labs(title = "Power for different models and differen exptected effects for maximum dose")+ - theme_bw() - - plot_max_eff - -} @@ -515,9 +472,6 @@ various scenarios and differnt parameters. ```{r} -plot_minimal_max_eff <- plot_max_eff(results_min_MCP, results_min_Bay, min_scenario) -plot_minimal_max_eff - #table with results kable(results_min_MCP)%>% kable_classic(full_width = TRUE)%>% @@ -526,31 +480,47 @@ kable(results_min_MCP)%>% minimal_Bay$kable_result -#difference of power values -results_min_max_eff <- data.table( - linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$linear), - exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$exponential), - emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$emax), - expectedEffect = expectedEffect -) +data_plot_eff_min <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_min_MCP$linear, + end_linear = minimal_Bay$result_table$linear, + start_exp = results_min_MCP$exponential, + end_exp = minimal_Bay$result_table$exponential, + start_emax = results_min_MCP$emax, + end_emax = minimal_Bay$result_table$emax +) -results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") -plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_minimal -``` -```{r} +# Create the plot +ggplot(data = data_plot_eff_min, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_min$max_eff_num, labels = data_plot_eff_min$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values different expected effect for maximum dose") + + geom_vline(xintercept = data_plot_eff_min$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") ``` + ### monotonic scenario ```{r} -plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) -plot_monotonic_max_eff #table with results kable(results_monotonic_MCP)%>% @@ -561,26 +531,49 @@ kable(results_monotonic_MCP)%>% monotonic_Bay$kable_result -results_monotonic_max_eff <- data.table( - linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$linear), - exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$exp), - emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$emax), - logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$logistic), - sigemax = as.vector(monotonic_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP$sigEmax), - expectedEffect = expectedEffect +data_plot_eff_monotonic <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_monotonic_MCP$linear, + end_linear = monotonic_Bay$result_table$linear, + start_exp = results_monotonic_MCP$exp, + end_exp = monotonic_Bay$result_table$exponential, + start_emax = results_monotonic_MCP$emax, + end_emax = monotonic_Bay$result_table$emax, + start_logistic = results_monotonic_MCP$logistic, + end_logistic = monotonic_Bay$result_table$logistic, + start_sigemax = results_monotonic_MCP$sigEmax, + end_sigemax = monotonic_Bay$result_table$sigEmax ) -results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") -plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_monotonic +# Create the plot +ggplot(data = data_plot_eff_monotonic, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num- 0.25, xend = max_eff_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_monotonic$max_eff_num, labels = data_plot_eff_monotonic$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + ``` ### non - monotonic scenario ```{r} -plot_non_monotonic_max_eff <- plot_max_eff(results_non_monotonic_MCP, results_non_monotonic_Bay, non_monotonic_scenario) -plot_non_monotonic_max_eff # table results kable(results_non_monotonic_MCP)%>% @@ -590,26 +583,62 @@ kable(results_non_monotonic_MCP)%>% non_monotonic_Bay$kable_result -results_non_monotonic_max_eff <- data.table( - linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), - emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), - sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), - quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), - beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), - expectedEffect = expectedEffect - ) +# results_non_monotonic_max_eff <- data.table( +# linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), +# emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), +# sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), +# quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), +# beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), +# expectedEffect = expectedEffect +# ) +# +# results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") +# +# plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) +# plot_non_monotonic + +data_plot_eff_non_monotonic <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_non_monotonic_MCP$linear, + end_linear = non_monotonic_Bay$result_table$linear, + start_emax = results_non_monotonic_MCP$emax, + end_emax = non_monotonic_Bay$result_table$emax, + start_sigemax = results_non_monotonic_MCP$sigEmax, + end_sigemax =non_monotonic_Bay$result_table$sigEmax, + start_quadratic = results_non_monotonic_MCP$quadratic, + end_quadratic = non_monotonic_Bay$result_table$quadratic, + start_beta = results_non_monotonic_MCP$beta, + end_beta = non_monotonic_Bay$result_table$betaMod +) -results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") -plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_non_monotonic +# Create the plot +ggplot(data = data_plot_eff_non_monotonic, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.05, xend = max_eff_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.3, xend = max_eff_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.25, xend = max_eff_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_non_monotonic$max_eff_num, labels = data_plot_eff_non_monotonic$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values for different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_non_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") ``` ### variability scenario ```{r} -plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) -plot_var_max_eff #table with results kable(results_var_MCP)%>% @@ -619,17 +648,35 @@ kable(results_var_MCP)%>% variability_Bay$kable_result -results_var_max_eff <- data.table( - linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$linear), - exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$exponential), - emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$emax), - expectedEffect = expectedEffect +data_plot_eff_var <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_var_MCP$linear, + end_linear = variability_Bay$result_table$linear, + start_exp = results_var_MCP$exponential, + end_exp = variability_Bay$result_table$exponential, + start_emax = results_var_MCP$emax, + end_emax = variability_Bay$result_table$emax ) -results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") -plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_var +# Create the plot +ggplot(data = data_plot_eff_var, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_var$max_eff_num, labels = data_plot_eff_var$max_eff) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values for different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_var$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") ``` ## varying sample size @@ -642,18 +689,6 @@ nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "( ```{r} -# results_min_nsample <- data.table( -# linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), -# exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), -# emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), -# nsample_vector = nsample_vector -# ) -# -# results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") -# -# plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") -# plot_minimal_nsample - kable(results_min_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% @@ -667,25 +702,30 @@ minimal_nsample_Bay$kable_result data_plot_nsample_min <- data.frame( sample_sizes = nsample_vector, sample_sizes_num = c(1, 2, 3, 4), - start_linear = minimal_nsample_Bay$result_table$linear, - end_linear = results_min_MCP_nsample$Linear, - start_exp = minimal_nsample_Bay$result_table$exponential, - end_exp = results_min_MCP_nsample$Exponential, - start_emax = minimal_nsample_Bay$result_table$emax, - end_emax = results_min_MCP_nsample$Emax + start_linear = results_min_MCP_nsample$Linear, + end_linear = minimal_nsample_Bay$result_table$linear, + start_exp = results_min_MCP_nsample$Exponential, + end_exp = minimal_nsample_Bay$result_table$exponential, + start_emax = results_min_MCP_nsample$Emax, + end_emax = minimal_nsample_Bay$result_table$emax ) + + # Create the plot ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ @@ -702,20 +742,6 @@ ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + ### monotonic scenario ```{r} -# results_monotonic_nsample <- data.table( -# linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), -# exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), -# emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), -# logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), -# sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), -# nsample_vector = nsample_vector -# ) -# -# results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") -# -# plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") -# plot_monotonic_nsample - kable(results_monotonic_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% @@ -727,39 +753,40 @@ monotonic_nsample_Bay$kable_result data_plot_nsample_monotonic <- data.frame( sample_sizes = nsample_vector, sample_sizes_num = c(1, 2, 3, 4), - start_linear = monotonic_nsample_Bay$result_table$linear, - end_linear = results_monotonic_MCP_nsample$Linear, - start_exp = monotonic_nsample_Bay$result_table$exponential, - end_exp = results_monotonic_MCP_nsample$Exponential, - start_emax = monotonic_nsample_Bay$result_table$emax, - end_emax = results_monotonic_MCP_nsample$Emax, - start_logistic = monotonic_nsample_Bay$result_table$logistic, - end_logistic = results_monotonic_MCP_nsample$Logistic, - start_sigemax = monotonic_nsample_Bay$result_table$sigEmax, - end_sigemax = results_monotonic_MCP_nsample$sigEmax + start_linear = results_monotonic_MCP_nsample$Linear, + end_linear = monotonic_nsample_Bay$result_table$linear, + start_exp = results_monotonic_MCP_nsample$Exponential, + end_exp = monotonic_nsample_Bay$result_table$exponential, + start_emax = results_monotonic_MCP_nsample$Emax, + end_emax = monotonic_nsample_Bay$result_table$emax, + start_logistic = results_monotonic_MCP_nsample$Logistic, + end_logistic = monotonic_nsample_Bay$result_table$logistic, + start_sigemax = results_monotonic_MCP_nsample$sigEmax, + end_sigemax = monotonic_nsample_Bay$result_table$sigEmax ) # Create the plot ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + geom_vline(xintercept = data_plot_nsample_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + theme(legend.position = "bottom") @@ -768,19 +795,6 @@ ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + ### non-monotonic scenario ```{r} -# results_non_monotonic_nsample <- data.table( -# linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), -# emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), -# sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), -# quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), -# beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), -# nsample_vector = nsample_vector -# ) -# -# results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") -# -# plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") -# plot_non_monotonic_nsample kable(results_non_monotonic_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% @@ -792,39 +806,40 @@ non_monotonic_nsample_Bay$kable_result data_plot_nsample_non_monotonic <- data.frame( sample_sizes = nsample_vector, sample_sizes_num = c(1, 2, 3, 4), - start_linear = non_monotonic_nsample_Bay$result_table$linear, - end_linear = results_non_monotonic_MCP_nsample$Linear, - start_emax = non_monotonic_nsample_Bay$result_table$emax, - end_emax = results_non_monotonic_MCP_nsample$Emax, - start_sigemax = non_monotonic_nsample_Bay$result_table$sigEmax, - end_sigemax = results_non_monotonic_MCP_nsample$sigEmax, - start_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, - end_quadratic = results_non_monotonic_MCP_nsample$quadratic, - start_beta = non_monotonic_nsample_Bay$result_table$betaMod, - end_beta = results_non_monotonic_MCP_nsample$beta + start_linear = results_non_monotonic_MCP_nsample$Linear, + end_linear = non_monotonic_nsample_Bay$result_table$linear, + start_emax = results_non_monotonic_MCP_nsample$Emax, + end_emax = non_monotonic_nsample_Bay$result_table$emax, + start_sigemax = results_non_monotonic_MCP_nsample$sigEmax, + end_sigemax =non_monotonic_nsample_Bay$result_table$sigEmax, + start_quadratic = results_non_monotonic_MCP_nsample$quadratic, + end_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, + start_beta = results_non_monotonic_MCP_nsample$beta, + end_beta = non_monotonic_nsample_Bay$result_table$betaMod ) # Create the plot ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + geom_vline(xintercept = data_plot_nsample_non_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + theme(legend.position = "bottom") @@ -834,18 +849,6 @@ ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + ### variability sceanrio ```{r} -# results_var_nsample <- data.table( -# linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), -# exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), -# emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), -# nsample_vector = nsample_vector -# ) -# -# results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") -# -# -# plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") -# plot_var_nsample kable(results_var_MCP_nsample)%>% kable_classic(full_width = TRUE)%>% @@ -858,31 +861,32 @@ var_nsample_Bay$kable_result data_plot_nsample_var <- data.frame( sample_sizes = nsample_vector, sample_sizes_num = c(1, 2, 3, 4), - start_linear = var_nsample_Bay$result_table$linear, - end_linear = results_var_MCP_nsample$Linear, - start_exp = var_nsample_Bay$result_table$exponential, - end_exp = results_var_MCP_nsample$Exponential, - start_emax = var_nsample_Bay$result_table$emax, - end_emax = results_var_MCP_nsample$Emax + start_linear = results_var_MCP_nsample$Linear, + end_linear = var_nsample_Bay$result_table$linear, + start_exp = results_var_MCP_nsample$Exponential, + end_exp = var_nsample_Bay$result_table$exponential, + start_emax = results_var_MCP_nsample$Emax, + end_emax = var_nsample_Bay$result_table$emax ) # Create the plot ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + geom_vline(xintercept = data_plot_nsample_var$sample_sizes_num + 0.5, linetype="dashed", color = "black") + theme(legend.position = "bottom") ``` @@ -901,9 +905,9 @@ In the following simulations, we examine the convergence of power values for an ```{r} #safe results in data.table for plot results_nsim <- data.table( - MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP[[6]]$sim_results$power, results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power, results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power), + MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power, results_list_nsim_MCP[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power, results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power, results_list_nsim_MCP[[16]]$sim_results$power, results_list_nsim_MCP[[17]]$sim_results$power, results_list_nsim_MCP[[18]]$sim_results$power), Bay_linear = results_nsim_Bay$Bay_linear, Bay_exp = results_nsim_Bay$Bay_exponential, Bay_emax = results_nsim_Bay$Bay_emax) @@ -917,7 +921,7 @@ results_nsim_diff <- data.table( results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") -plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) plot_nsim ``` @@ -928,11 +932,11 @@ plot_nsim ```{r} #safe results in data.table for plot results_nsim_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power), - MCP_logistic = c(results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power, results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power, results_list_nsim_MCP_monotonic[[25]]$sim_results$power), + MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power, results_list_nsim_MCP_monotonic[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power, results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power, results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power), + MCP_logistic = c(results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power, results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_monotonic[[25]]$sim_results$power, results_list_nsim_MCP_monotonic[[26]]$sim_results$power, results_list_nsim_MCP_monotonic[[27]]$sim_results$power, results_list_nsim_MCP_monotonic[[28]]$sim_results$power, results_list_nsim_MCP_monotonic[[29]]$sim_results$power, results_list_nsim_MCP_monotonic[[30]]$sim_results$power), Bay_linear = results_nsim_Bay_monotonic$Bay_linear, Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, Bay_emax = results_nsim_Bay_monotonic$Bay_emax, @@ -950,7 +954,7 @@ results_nsim_diff_monotonic <- data.table( results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") -plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) plot_nsim_monotonic ``` @@ -961,9 +965,9 @@ plot_nsim_monotonic ```{r} #safe results in data.table for plot results_nsim_non_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power), + MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power,results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[18]]$sim_results$power), #MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, Bay_emax = results_nsim_Bay_monotonic$Bay_emax, @@ -981,7 +985,7 @@ results_nsim_diff_non_monotonic <- data.table( results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") -plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) plot_nsim_non_monotonic ``` @@ -993,9 +997,9 @@ plot_nsim_non_monotonic ```{r} #safe results in data.table for plot results_nsim_var <- data.table( - MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_var[[6]]$sim_results$power, results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power, results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power), + MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power, results_list_nsim_MCP_var[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power, results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power, results_list_nsim_MCP_var[[16]]$sim_results$power, results_list_nsim_MCP_var[[17]]$sim_results$power, results_list_nsim_MCP_var[[18]]$sim_results$power), Bay_linear = results_nsim_Bay_var$Bay_linear, Bay_exp = results_nsim_Bay_var$Bay_exponential, Bay_emax = results_nsim_Bay_var$Bay_emax @@ -1010,7 +1014,7 @@ results_nsim_diff_var <- data.table( results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") -plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) plot_nsim_var ``` diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd new file mode 100644 index 0000000..a18a3d3 --- /dev/null +++ b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd @@ -0,0 +1,506 @@ +--- +title: "Vignette BayesianMCPMod - BayesianMCPMod Analysis" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + +Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. + + +# Prior Specification +In a first step an uninformativ prior is calculated. + +```{r} +uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") + +) +``` + +To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. + +## Minimal scnenario +### varying expected effect for maximum dose + + +```{r} + +# list to store results +results_list_Bay_min <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + #optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) + +minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) + +minimal_Bay$kable_result + + + +``` +### varying sample size + + +```{r} +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + +# Initialize list to store results +results_list_nsample_min_Bay <- list() + +#Models with maxEff = 0.2 +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_min <- assessDesign( + n_patients = nsample_list[[i]], + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) + +minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) +minimal_nsample_Bay$kable_result + + + +``` + + + +## Monotonic scenario + +### varying expected effect for maximum dose + +```{r} +results_list_Bay_monotonic <- list() + + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + # optimal contrasts + contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # perform Simulations + success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + + }) + +} + + +##power results in vector for tables +results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) + + +monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) + + +monotonic_Bay$kable_result + + + +``` + +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_monotonic_Bay <- list() + +# dose - response models +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) + + +monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) +monotonic_nsample_Bay$kable_result + + +``` + + +## Non-monotonic scenario +### varying expected effect for maximum dose +```{r} +results_list_Bay_non_monotonic <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + + non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts + contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + }) + +} + +results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) + +non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) + +non_monotonic_Bay$kable_result + + +``` +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_non_monotonic_Bay <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +contM_2 <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) + +contrasts_list = list(contM_2, contM, contM_2, contM) + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_non_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) + + +non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) +non_monotonic_nsample_Bay$kable_result + + +``` + + +## Variability scenario +### varying expected effect for maximum dose +```{r} + +# prior +var_uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) + +results_list_Bay_var <- list() + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + var_models <- Mods(linear = NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + + success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + +results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) + +variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) + +variability_Bay$kable_result + + +``` +### varying sample size +```{r} +results_list_nsample_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +contM_2 <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(2,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) + +results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + success_probabilities_var <- assessDesign( + n_patients = nsample_list_var[[i]], + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) + + +var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) +var_nsample_Bay$kable_result + + +``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd new file mode 100644 index 0000000..9143455 --- /dev/null +++ b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd @@ -0,0 +1,1113 @@ +--- +title: "Vignette BayesianMCPMod - MCPModPack Analysis" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + +Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. + +## Minimal scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_min <- list() + +# Run simulation +func_sim <- function(models ,sim_models, sim_parameters){ + +sim_result = MCPModSimulation(endpoint_type = "Normal", + models = models, + alpha = alpha, + direction = "increasing", + model_selection = "aveAIC", + Delta = 0.1, + sim_models = sim_models, + sim_parameters = sim_parameters) +} + + +list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + + +#store results +results_min_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_min[[1]]$sim_results$power), + exponential = c(results_list_min[[2]]$sim_results$power), + emax = c(results_list_min[[3]]$sim_results$power), + Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, + sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, + sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, + sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, + sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) + + +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +### varying sample size +```{r warning=FALSE} +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +# store results +power_min_nsample_linear <- vector() +power_min_nsample_exp <- vector() +power_min_nsample_emax <- vector() + + + + + +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# # Set max_effect to 0.2 +# min_modelsPack$max_effect <- expectedEffect_fix +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) +# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) +# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) +# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power +# +# } +# Set max_effect to 0.2 +min_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) + +#ind_tasks <- 1:12 + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + +# store results +results_min_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), + Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), + Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), + Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, + sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, + sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, + sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) +) + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +## Monotonic scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response models +sim_models_monotonic_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_emax= list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_monotonic <- list() + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_monotonic_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_monotonic[[1]]$sim_results$power), + exp = c(results_list_monotonic[[2]]$sim_results$power), + emax = c(results_list_monotonic[[3]]$sim_results$power), + logistic = c(results_list_monotonic[[4]]$sim_results$power), + sigEmax = c(results_list_monotonic[[5]]$sim_results$power), + Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) +) + +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assumed dose- response model with assumed maximum effect = 0.2 +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +# store results +power_monotonic_nsample_linear <- vector() +power_monotonic_nsample_exp <- vector() +power_monotonic_nsample_emax <- vector() +power_monotonic_nsample_logistic <- vector() +power_monotonic_nsample_sigemax <- vector() + + + +# Set max_effect to 0.2 +monotonic_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +# store results +results_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), + Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), + Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), + Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), + sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), +Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) + + +``` + +## Non-monotonic scenario + +### varying expected effect for maximum dose + +For the simulations of the non-monotonic scenario, the R package 'Dosefinding' was used instead of 'MCPModPack + +```{r} +# linear with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_linear <- result$linear +``` + + +```{r} +# emax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` + + +```{r} +# sigemax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` +``` + + + +```{r} +#quadratic with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` + +``` + +```{r} +# beta with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` +``` + + +```{r} +#linear, emax, sigemax, quadratic +results_non_monotonic_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = power_non_monotonic_linear, + emax = power_non_monotonic_emax, + sigEmax = power_non_monotonic_sigemax, + quadratic = power_non_monotonic_quadratic, + beta = power_non_monotonic_beta, + average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), + (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), + (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), + (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), + (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) + ) + + +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) +``` + +### varying sample size + +```{r warning=FALSE} + + +# store results +power_non_monotonic_nsample_linear <- vector() +power_non_monotonic_nsample_emax <- vector() +power_non_monotonic_nsample_quadratic <- vector() +power_non_monotonic_nsample_sigemax <- vector() +power_non_monotonic_nsample_beta <- vector() + + +``` + +```{r} +# linear with DoseFinding +# allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[2] <- result$linear[1] +power_non_monotonic_nsample_linear[4] <- result$linear[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[1] <- result$linear[1] +power_non_monotonic_nsample_linear[3] <- result$linear[2] +``` + + +```{r} + +# emax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] +``` + + + +```{r} +# sigemax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] +``` + + + + +```{r} +# quadratic with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] +``` + + + +```{r} +# beta with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] +``` + + +```{r} +#store results +results_non_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_non_monotonic_nsample_linear, + Emax = power_non_monotonic_nsample_emax, + sigEmax = power_non_monotonic_nsample_sigemax, + quadratic = power_non_monotonic_nsample_quadratic, + beta = power_non_monotonic_nsample_beta +) + + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) + +``` + +## Variability scenario +### varying expected effect for maximum dose + +```{r warning=FALSE} +# assumed dose - response model +sim_models_var_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_emax = list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + + + +# Simulation parameters +sim_parameters_var = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# perform Simulations + +list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) + + }) + +} + + +# store results +results_var_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = results_list_var[[1]]$sim_results$power, + exponential = results_list_var[[2]]$sim_results$power, + emax = results_list_var[[3]]$sim_results$power, + average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), + (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), + (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), + (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), + (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) +) + +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + + +# store results +power_var_nsample_linear <- vector() +power_var_nsample_exp <- vector() +power_var_nsample_emax <- vector() + +# # Loop over nsample values +# for (i in seq_along(nsample_list_var)) { +# +# # Update nsample in simulation parameters +# sim_parameters_var$n <- nsample_list_var[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) +# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) +# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# +# } + +var_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list_var[[i]], + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_var_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), + Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), + Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), + Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), + (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), + (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), + (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) +) + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd new file mode 100644 index 0000000..2b6e163 --- /dev/null +++ b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd @@ -0,0 +1,419 @@ +--- +title: "Vignette BayesianMCPMod - convergence of power values" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +--- + + +```{r} +# minimal BayesianMCPMod + +# Define a vector of different n_sim values +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) +n_sim_values <- c(100, 500, 1000, 2500, 5000) + +# Initialize a list to store the results +results_list_nsim_Bay <- list() + +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") +#optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) + + +``` + +```{r warning=FALSE} +# minimal MCPModPack + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + + + +list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + +``` + + + + +```{r} +# monotonic BayesianMCPMod + +# Initialize a list to store the results + results_list_nsim_Bay_monotonic <- list() + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) + +``` + +```{r warning=FALSE} +# monotonic MCPModPack + +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + +```{r} +# non-monotonic BayesianMCPMod + +# Initialize list to store results +results_list_nsim_Bay_non_monotonic <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +# non-monotonic MCPModPack + +results_list_nsim_MCP_non_monotonic = list( + power_non_monotonic_nsim_linear = vector(), + power_non_monotonic_nsim_emax = vector(), + power_non_monotonic_nsim_sigemax= vector() + #power_non_monotonic_nsim_quadratic = vector(), + #power_non_monotonic_nsim_beta = vector() + ) + +sim_models_non_monotonic_linear = list(linear = NA, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_emax= list(emax = 0.6666667, + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = 0.2, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + +sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix +#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix + +list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, + sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, + sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + +```{r} +# variability BayesianMCPMod + +# Initialize list to store results +results_list_nsim_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) +``` + +```{r, warning=FALSE} +# variability MCPModPack + +results_list_nsim_MCP_var = list( + power_var_nsim_linear = vector(), + power_var_nsim_exp = vector(), + power_var_nsim_emax= vector()) + +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + +sim_parameters_var$n <- Nsample_var + + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) +n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000, + 100, 500, 1000, 2500, 5000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd new file mode 100644 index 0000000..89b9525 --- /dev/null +++ b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd @@ -0,0 +1,1020 @@ +--- +title: "Vignette BayesianMCPMod" +subtitle: "WORK IN PROGRESS" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +editor: + markdown: + wrap: 72 +--- + +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false + +#' Display Parameters Table +#' +#' This function generates a markdown table displaying the names and values of parameters +#' from a named list. +#' +#' @param named_list A named list where each name represents a parameter name and the list +#' element represents the parameter value. Date values in the list are automatically +#' converted to character strings for display purposes. +#' +#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". +#' The function does not return a value but displays the table directly to the output. +#' +#' @importFrom knitr kable +#' @examples +#' params <- list("Start Date" = as.Date("2020-01-01"), +#' "End Date" = as.Date("2020-12-31"), +#' "Threshold" = 10) +#' display_params_table(params) +#' +#' @export +display_params_table <- function(named_list) { + display_table <- data.frame() + value_names <- data.frame() + for (i in 1:length(named_list)) { + # dates will display as numeric by default, so convert to char first + if (class(named_list[[i]]) == "Date") { + named_list[[i]] = as.character(named_list[[i]]) + } + if (!is.null(names(named_list[[i]]))) { + value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) + } + values <- data.frame(I(list(named_list[[i]]))) + display_table <- rbind(display_table, values) + } + + round_numeric <- function(x, digits = 3) { + if (is.numeric(x)) { + return(round(x, digits)) + } else { + return(x) + } + } + + display_table[1] <- lapply(display_table[1], function(sublist) { + lapply(sublist, round_numeric) + }) + + class(display_table[[1]]) <- "list" + + if (nrow(value_names) == 0) { + knitr::kable( + cbind(names(named_list), display_table), + col.names = c("Name", "Value") + ) + } else { + knitr::kable( + cbind(names(named_list), value_names, display_table), + col.names = c("Name", "Value Labels", "Value") + ) + } +} +# function to solve power results for tables (different max eff) BayesianMCPMod +# return(successrates models, average) +extract_success_rates <- function(results_list, models) { + success_rates <- list() + + for (i in seq_along(results_list)) { + success_rate <- c() + for (model in models) { + success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) + } + success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate")) + } + + return(success_rates) + } + +# function to solve power results for tables (different nsample) BayesianMCPMod +#models % + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + + + +print_result_Bay_nsample <- function(results, scenario, variable) { + + result_table <- t(data.table( + Bay_1 = results$Bay_1, + Bay_2 = results$Bay_2, + Bay_3 = results$Bay_3, + Bay_4 = results$Bay_4)) + + result_table <- as.data.table(result_table) + names(result_table) <- scenario + #return(result_table) + + kable_result <- kable(cbind(variable, result_table))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + +plot_power_deviation <- function(data, x, xlab, xlim){ + plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + scale_x_continuous(breaks = xlim) + + geom_hline(aes(yintercept = 0), linetype = 2)+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + labs(x = xlab, y = "power deviation")+ + ylim(-0.2, 0.2)+ #with higher n_sim!!!!!!!!!!!! + theme_classic() + return(plot) +} + +#plot all max effects in one plot + +plot_max_eff <- function(results_MCP, results_Bay, scenario){ + +transformed_MCP <- t(results_MCP) +transformed_MCP <- as.data.table(transformed_MCP) +transformed_MCP <- transformed_MCP[-c(1),] + +data <- data.table( + Bay_0.05 = results_Bay$Bay_0.05, + Bay_0.1 = results_Bay$Bay_0.1, + Bay_0.2 = results_Bay$Bay_0.2, + Bay_0.3 = results_Bay$Bay_0.3, + Bay_0.5 = results_Bay$Bay_0.5, + MCP_0.05 = transformed_MCP$V1, + MCP_0.1 = transformed_MCP$V2, + MCP_0.2 = transformed_MCP$V3, + MCP_0.3 = transformed_MCP$V4, + MCP_0.5 = transformed_MCP$V5, + scenario = c(scenario, "average") +) + + + + + plot_max_eff <- ggplot(data = data)+ + geom_point(mapping = aes(x= data$scenario, y = data$Bay_0.05, colour = "MCPMod", shape = "0.05"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.05, colour = "BayesianMCPMod", shape = "0.05"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.1, colour = "MCPMod", shape = "0.1"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.1, colour = "BayesianMCPMod", shape = "0.1"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.2, colour = "MCPMod", shape = "0.2"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.2, colour = "BayesianMCPMod", shape = "0.2"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.3, colour = "MCPMod", shape = "0.3"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.3, colour = "BayesianMCPMod", shape = "0.3"), data = data, position = position_nudge(x = 0.15))+ + geom_point(mapping = aes(x= scenario, y = data$MCP_0.5, colour = "MCPMod", shape = "0.5"), data = data, position = position_nudge(x = -0.15))+ + geom_point(mapping = aes(x= scenario, y = data$Bay_0.5, colour = "BayesianMCPMod", shape = "0.5"), data = data, position = position_nudge(x = 0.15))+ + scale_color_manual(name = "Legend", values = c("MCPMod" = 'blue', "BayesianMCPMod" = "red"))+ + scale_shape_manual(name = "Expected effects", values = c("0.05" = 0, "0.1" = 1, "0.2" = 2, "0.3" = 3, "0.5" = 5))+ + ylim(0, 1)+ + ylab("power")+ + xlab("assumed true model")+ + labs(title = "Power for different models and differen exptected effects for maximum dose")+ + theme_bw() + + plot_max_eff + +} + + + +# parallel---------------------------------------------- +chunkVector <- function (x, n_chunks) { + if (n_chunks <= 1) { + chunk_list <- list(x) + } else { + chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) + } + return(chunk_list) +} + +devtools::load_all() +#library(BayesianMCPMod) +library(RBesT) +library(clinDR) +library(dplyr) +library(tibble) +library(reactable) +library(DoseFinding) +library(MCPModPack) +library(kableExtra) +library(data.table) +library(doFuture) +library(doRNG) + +registerDoFuture() +plan(multisession) + + + +set.seed(7015) +``` + +# Introduction + +This vignette demonstrates the application of the {BayesianMCPMod} +package for sample size calculations and the comparison with the +{MCPModPack} package. As for other bayesian approaches BMCPMod is able +to mimic the results of the frequentist MCPMod for non-informative +priors and this is shown here for the sample size planning of different +scenarios. + +In order to test and compare BayesianMCPMod and MCPModPack sample size +calculations in different scenarios, the data used for the comparisons +will be simulated multiple times using different input values. Every +scenario will be named to make the differentiation between each scenario +simpler. Altogether, four different scenarios were simulated. The first +three scenarios are pretty similiar, they only differ in the pre-defined +set of candidate models M. The other design choices, like the number of +dose levels or sample size allocation stay the same between the +scenarios. For the first three scenarios, these design choices are: + +- four dose levels plus placebo (0 mg, 1 mg, 2 mg, 4 mg, 8 mg) + +- total sample size of N = 200 + +- equal allocation ratio for each dose group + +- expected effect for maximum dose of 0.2 mg + +- standard deviation of 0.4 for every dose group + +The fourth scenario, the variability scenario, has some different design +choices: - three dose levels plus placebo (0 mg, 1 mg, 4 mg, 8 mg) - +total sample size of N = 100 - equal allocation ratio for each dose +group - expected effect for maximum dose of 0.2 mg - standard deviation +of 0.4 for every dose group + +Building on the initial scenarios, we further delve into the exploration +of varying input parameters. The varying parameters are: + +- expected effect for maximum dose of (0.05 mg, 0.1 mg, 0.2 mg, 0.3 + mg, 0.5 mg) + +- different total sample size with different allocation: + +- (40,20,20,20,40), (30,30,30,30,30), (48,24,24,24,48), + (36,36,36,36,36) (for the first three scenarios) + +- (40,20,20,40), (30,30,30,30), (48,24,24,48), (36,36,36,36) (for the + variability scenario) + +In a subsequent step, we extend our analysis to test the convergence of +power values as the number of simulations increases. For this part of +the study, we assume an expected effect for the maximum dose of 0.2 mg. +The sample size is set to 200 for the linear, monotonic and +non-monotonic scenario and 100 for the variability scenario. This +further exploration allows us to deepen our understanding of the +BayesianMCPMod and MCPModPack packages and their performance under +varying conditions. + +```{r} +####### General assumptions ######### +# simulations +n_sim <- 1000 + +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) +nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") + +# define input parameters +doses.sim <- c(0,1,2,4,8) # dose levels +max.dose <- max(doses.sim) # specify max dose possibly available +plc.guess <- 0 # expected placebo effect +Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) +expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) +expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) +sd.sim <- c(0.4) + +#input paramters variability scenario +doses_var <- c(0, 1, 4, 8) +sd.sim_var <- 0.4 +Nsample_var <- c(25, 25, 25, 25) +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + + +# define model functions +emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") +exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) +logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) +sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") +quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") +beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) + +### define models to be tested in MCPMod +models <- Mods(linear=NULL, + emax = emax.g, + exponential = exp.g, + logistic=logit.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) + +alpha <- 0.05 + +# display_params_table(models) + + +# kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% +# kable_classic(full_width = TRUE)%>% +# add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) +# +# +# kable(t(data.table(placebo_guess = plc.guess, +# sd = sd.sim[1], +# alpha = alpha )))%>% +# kable_classic(full_width = TRUE) + +``` + +## Scenarios + +In the following the candidate models for the different scenarios are +plotted. + +```{r} + +#Specification of considered models for different scenarios for BayesianMCPMod + +min_scenario <- c("linear", "exponential", "emax") +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(min_models, main = "minimal Scenario") + + +monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(monotonic_models, main = "monotonic Scenario") + + +non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) +plot(non_monotonic_models,main = "non monotonic Scenario") + + +variability_scenario <- c("linear","exponential", "emax") + +kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c( "Doses variability scenario" = 5), font_size = 15) + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(var_models, main = "variability Scenario") + +``` + +# MCPModPack + +```{r} + +#Specification of considered models for different scenarios for MCPModPack + +min_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667) + +monotonic_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +non_monotonic_modelsPack = list(linear = NA, + emax = 0.6666667 , + sigEmax = c(1.528629, 4.087463), + quadratic = -0.09688711) +#beta + +var_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +``` + +```{r child = 'Comparison_MCPModPack.qmd'} + +``` + +# BayesianMCPMod + +```{r child = 'Comparison_BayesianMCPMod.qmd'} + +``` + +# Comparison + +In the following, we will draw comparisons between the power values of +various scenarios and differnt parameters. + +## varying expected effect for maximum dose + +### minimal scenario + +```{r} + +plot_minimal_max_eff <- plot_max_eff(results_min_MCP, results_min_Bay, min_scenario) +plot_minimal_max_eff + +#table with results +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 5), font_size = 15, bold = TRUE) + +minimal_Bay$kable_result + +#difference of power values +results_min_max_eff <- data.table( + linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$linear), + exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$exponential), + emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$emax), + expectedEffect = expectedEffect +) + + + +results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") + +plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) +plot_minimal +``` + +```{r} + +``` + +### monotonic scenario + +```{r} +plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) +plot_monotonic_max_eff + +#table with results +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 7), font_size = 15, bold = TRUE) + +monotonic_Bay$kable_result + + +results_monotonic_max_eff <- data.table( + linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$linear), + exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$exp), + emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$emax), + logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$logistic), + sigemax = as.vector(monotonic_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP$sigEmax), + expectedEffect = expectedEffect +) + +results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") + +plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) +plot_monotonic +``` + +### non - monotonic scenario + +```{r} +plot_non_monotonic_max_eff <- plot_max_eff(results_non_monotonic_MCP, results_non_monotonic_Bay, non_monotonic_scenario) +plot_non_monotonic_max_eff + +# table results +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +non_monotonic_Bay$kable_result + +results_non_monotonic_max_eff <- data.table( + linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), + emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), + sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), + quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), + beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), + expectedEffect = expectedEffect + ) + +results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") + +plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) +plot_non_monotonic +``` + +### variability scenario + +```{r} +plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) +plot_var_max_eff + +#table with results +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +variability_Bay$kable_result + +results_var_max_eff <- data.table( + linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$linear), + exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$exponential), + emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$emax), + expectedEffect = expectedEffect +) + +results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") + +plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) +plot_var +``` + +## varying sample size + +```{r} +nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) +``` + +### minimal scenario + +```{r} + +# results_min_nsample <- data.table( +# linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), +# exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), +# emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), +# nsample_vector = nsample_vector +# ) +# +# results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") +# +# plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") +# plot_minimal_nsample + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +minimal_nsample_Bay$kable_result + + + + +data_plot_nsample_min <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = minimal_nsample_Bay$result_table$linear, + end_linear = results_min_MCP_nsample$Linear, + start_exp = minimal_nsample_Bay$result_table$exponential, + end_exp = results_min_MCP_nsample$Exponential, + start_emax = minimal_nsample_Bay$result_table$emax, + end_emax = results_min_MCP_nsample$Emax +) + + +# Create the plot +ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes") + + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + + + +``` + +### monotonic scenario + +```{r} +# results_monotonic_nsample <- data.table( +# linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), +# exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), +# emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), +# logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), +# sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), +# nsample_vector = nsample_vector +# ) +# +# results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") +# +# plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") +# plot_monotonic_nsample + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +monotonic_nsample_Bay$kable_result + +data_plot_nsample_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = monotonic_nsample_Bay$result_table$linear, + end_linear = results_monotonic_MCP_nsample$Linear, + start_exp = monotonic_nsample_Bay$result_table$exponential, + end_exp = results_monotonic_MCP_nsample$Exponential, + start_emax = monotonic_nsample_Bay$result_table$emax, + end_emax = results_monotonic_MCP_nsample$Emax, + start_logistic = monotonic_nsample_Bay$result_table$logistic, + end_logistic = results_monotonic_MCP_nsample$Logistic, + start_sigemax = monotonic_nsample_Bay$result_table$sigEmax, + end_sigemax = results_monotonic_MCP_nsample$sigEmax +) + + +# Create the plot +ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + +``` + +### non-monotonic scenario + +```{r} +# results_non_monotonic_nsample <- data.table( +# linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), +# emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), +# sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), +# quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), +# beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), +# nsample_vector = nsample_vector +# ) +# +# results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") +# +# plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") +# plot_non_monotonic_nsample + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 6), font_size = 15, bold = TRUE) + +non_monotonic_nsample_Bay$kable_result + +data_plot_nsample_non_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = non_monotonic_nsample_Bay$result_table$linear, + end_linear = results_non_monotonic_MCP_nsample$Linear, + start_emax = non_monotonic_nsample_Bay$result_table$emax, + end_emax = results_non_monotonic_MCP_nsample$Emax, + start_sigemax = non_monotonic_nsample_Bay$result_table$sigEmax, + end_sigemax = results_non_monotonic_MCP_nsample$sigEmax, + start_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, + end_quadratic = results_non_monotonic_MCP_nsample$quadratic, + start_beta = non_monotonic_nsample_Bay$result_table$betaMod, + end_beta = results_non_monotonic_MCP_nsample$beta +) + + +# Create the plot +ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + + +``` + +### variability sceanrio + +```{r} +# results_var_nsample <- data.table( +# linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), +# exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), +# emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), +# nsample_vector = nsample_vector +# ) +# +# results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") +# +# +# plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") +# plot_var_nsample + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +var_nsample_Bay$kable_result + + +data_plot_nsample_var <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = var_nsample_Bay$result_table$linear, + end_linear = results_var_MCP_nsample$Linear, + start_exp = var_nsample_Bay$result_table$exponential, + end_exp = results_var_MCP_nsample$Exponential, + start_emax = var_nsample_Bay$result_table$emax, + end_emax = results_var_MCP_nsample$Emax +) + + +# Create the plot +ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + + scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + + scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + +``` + +## convergence of power values + +In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000. + +```{r child = 'Comparison_convergence.qmd'} + +``` + +### minimal scenario + + +```{r} +#safe results in data.table for plot +results_nsim <- data.table( + MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP[[6]]$sim_results$power, results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power, results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power), + Bay_linear = results_nsim_Bay$Bay_linear, + Bay_exp = results_nsim_Bay$Bay_exponential, + Bay_emax = results_nsim_Bay$Bay_emax) + +results_nsim_diff <- data.table( + linear = results_nsim$Bay_linear - results_nsim$MCP_linear, + exponential = results_nsim$Bay_exp - results_nsim$MCP_exp, + emax = results_nsim$Bay_emax - results_nsim$MCP_emax, + n_sim = n_sim_values +) + +results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") + +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim +``` + +### monotonic scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_monotonic <- data.table( + MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power), + MCP_logistic = c(results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power, results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power, results_list_nsim_MCP_monotonic[[25]]$sim_results$power), + Bay_linear = results_nsim_Bay_monotonic$Bay_linear, + Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_logistic = results_nsim_Bay_monotonic$Bay_logistic, + Bay_sigemax = results_nsim_Bay_monotonic$Bay_sigEmax) + +results_nsim_diff_monotonic <- data.table( + linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, + exponential = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, + emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, + logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, + sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, + n_sim = n_sim_values +) + +results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") + +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_monotonic +``` + +### non - monotonic scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_non_monotonic <- data.table( + MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power), + #MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, + Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, + Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic) + +results_nsim_diff_non_monotonic <- data.table( + linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, + emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, + sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, + #quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + n_sim = n_sim_values +) + + +results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") + +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_non_monotonic + +``` + +### variability scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_var <- data.table( + MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_var[[6]]$sim_results$power, results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power, results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power), + Bay_linear = results_nsim_Bay_var$Bay_linear, + Bay_exp = results_nsim_Bay_var$Bay_exponential, + Bay_emax = results_nsim_Bay_var$Bay_emax +) + +results_nsim_diff_var <- data.table( + linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, + exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, + emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, + n_sim = n_sim_values + ) + +results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") + +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) +plot_nsim_var +``` + +```{r} +# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, +# file = "simulation_data.RData") +``` From 976a528254076dc2267fd5e920786b3c67ea2d67 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 23 Jul 2024 09:12:07 +0100 Subject: [PATCH 24/39] plot legend update --- .../Comparison_MCPModPack.qmd | 2 + .../Comparison_convergence.qmd | 35 +++++--- .../Comparison_vignette.qmd | 84 ++++++++++--------- 3 files changed, 67 insertions(+), 54 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd index 9143455..ae4e815 100644 --- a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd +++ b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd @@ -967,6 +967,8 @@ kable(results_non_monotonic_MCP_nsample)%>% ``` ## Variability scenario + + ### varying expected effect for maximum dose ```{r warning=FALSE} diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 6d2db48..7d8a56d 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -15,9 +15,9 @@ vignette: > %\VignetteEngine{quarto::html} --- - +### minimal BayesianMCPMod ```{r} -# minimal BayesianMCPMod + # Define a vector of different n_sim values n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) @@ -66,8 +66,9 @@ results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenar ``` +### minimal MCPModPack ```{r warning=FALSE} -# minimal MCPModPack + # assumed dose - response model sim_models_min_linear = list(linear = NA, @@ -119,9 +120,9 @@ results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.charac - +### monotonic BayesianMCPMod ```{r} -# monotonic BayesianMCPMod + # Initialize a list to store the results results_list_nsim_Bay_monotonic <- list() @@ -153,7 +154,7 @@ results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c # Simulation step - success_probabilities_min <- assessDesign( + success_probabilities_monotonic <- assessDesign( n_patients = Nsample, mods = monotonic_models, prior_list = uninf_prior_list, @@ -172,8 +173,10 @@ results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_m ``` +### monotonic MCPModPack + ```{r warning=FALSE} -# monotonic MCPModPack + sim_models_monotonic_linear$max_effect <- expectedEffect_fix sim_models_monotonic_exp$max_effect <- expectedEffect_fix @@ -214,8 +217,10 @@ results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c ``` +### non-monotonic BayesianMCPMod + ```{r} -# non-monotonic BayesianMCPMod + # Initialize list to store results results_list_nsim_Bay_non_monotonic <- list() @@ -248,7 +253,7 @@ results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export # Simulation step - success_probabilities_min <- assessDesign( + success_probabilities_non_monotonic <- assessDesign( n_patients = Nsample, mods = non_monotonic_models, prior_list = uninf_prior_list, @@ -266,8 +271,9 @@ results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) ``` +### non-monotonic MCPModPack ```{r, warning=FALSE} -# non-monotonic MCPModPack + results_list_nsim_MCP_non_monotonic = list( power_non_monotonic_nsim_linear = vector(), @@ -328,8 +334,9 @@ results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export ``` +### variability BayesianMCPMod ```{r} -# variability BayesianMCPMod + # Initialize list to store results results_list_nsim_Bay_var <- list() @@ -358,7 +365,7 @@ results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.ch # Simulation step - success_probabilities_min <- assessDesign( + success_probabilities_var <- assessDesign( n_patients = Nsample_var, mods = var_models, prior_list = var_uninf_prior_list, @@ -376,8 +383,10 @@ results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.ch results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) ``` + +### variability MCPModPack ```{r, warning=FALSE} -# variability MCPModPack + results_list_nsim_MCP_var = list( power_var_nsim_linear = vector(), diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 89607cf..6ce5867 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -9,6 +9,7 @@ format: toc: true number-sections: true #bibliography: references.bib + code-fold: true vignette: > %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} %\VignetteEncoding{UTF-8} @@ -176,11 +177,12 @@ print_result_Bay_nsample <- function(results, scenario, variable) { list(result_table = result_table, kable_result = kable_result) } -plot_power_deviation <- function(data, x, xlab, xlim){ +plot_power_deviation <- function(data, x, xlab){ plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ geom_point()+ geom_line() + - scale_x_continuous(breaks = xlim) + + scale_x_continuous(breaks = c(0, 100, 500, 1000, 2500, 5000, 10000), + labels = c("", "100", "", "1000", "2500", "5000", "10000")) + geom_hline(aes(yintercept = 0), linetype = 2)+ geom_hline(aes(yintercept = -0.05), linetype = 2, color = "darkgrey")+ geom_hline(aes(yintercept = 0.05), linetype = 2, color = "darkgrey")+ @@ -513,7 +515,9 @@ ggplot(data = data_plot_eff_min, aes(x = max_eff_num)) + xlab("expected effect for maximum dose")+ ggtitle("Power values different expected effect for maximum dose") + geom_vline(xintercept = data_plot_eff_min$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + ``` @@ -561,13 +565,14 @@ ggplot(data = data_plot_eff_monotonic, aes(x = max_eff_num)) + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_eff_monotonic$max_eff_num, labels = data_plot_eff_monotonic$max_eff) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ theme_minimal() + ylab("Power") + xlab("expected effect for maximum dose")+ ggtitle("Power values different expected effect for maximum dose")+ geom_vline(xintercept = data_plot_eff_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) ``` @@ -583,19 +588,6 @@ kable(results_non_monotonic_MCP)%>% non_monotonic_Bay$kable_result -# results_non_monotonic_max_eff <- data.table( -# linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), -# emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), -# sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), -# quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), -# beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), -# expectedEffect = expectedEffect -# ) -# -# results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") -# -# plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -# plot_non_monotonic data_plot_eff_non_monotonic <- data.frame( max_eff = expectedEffect, @@ -621,19 +613,20 @@ ggplot(data = data_plot_eff_non_monotonic, aes(x = max_eff_num)) + geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.05, xend = max_eff_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.3, xend = max_eff_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.25, xend = max_eff_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_eff_non_monotonic$max_eff_num, labels = data_plot_eff_non_monotonic$max_eff) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ theme_minimal() + ylab("Power") + xlab("expected effect for maximum dose")+ ggtitle("Power values for different expected effect for maximum dose")+ geom_vline(xintercept = data_plot_eff_non_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) ``` ### variability scenario @@ -669,14 +662,15 @@ ggplot(data = data_plot_eff_var, aes(x = max_eff_num)) + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_eff_var$max_eff_num, labels = data_plot_eff_var$max_eff) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + xlab("expected effect for maximum dose")+ ggtitle("Power values for different expected effect for maximum dose")+ geom_vline(xintercept = data_plot_eff_var$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) ``` ## varying sample size @@ -723,7 +717,7 @@ ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + theme_minimal() + @@ -732,7 +726,8 @@ ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + xlab("sample sizes")+ ggtitle("Power values different sample sizes") + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) @@ -780,14 +775,15 @@ ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ geom_vline(xintercept = data_plot_nsample_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) ``` @@ -833,14 +829,15 @@ ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ geom_vline(xintercept = data_plot_nsample_non_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) @@ -879,15 +876,17 @@ ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Model", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ xlab("sample sizes")+ ggtitle("Power values different sample sizes")+ geom_vline(xintercept = data_plot_nsample_var$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + ``` @@ -898,6 +897,7 @@ In the following simulations, we examine the convergence of power values for an ```{r child = 'Comparison_convergence.qmd'} ``` +## Results ### minimal scenario @@ -921,7 +921,7 @@ results_nsim_diff <- data.table( results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") -plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim") plot_nsim ``` @@ -954,7 +954,7 @@ results_nsim_diff_monotonic <- data.table( results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") -plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim") plot_nsim_monotonic ``` @@ -985,7 +985,7 @@ results_nsim_diff_non_monotonic <- data.table( results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") -plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim") plot_nsim_non_monotonic ``` @@ -1014,11 +1014,13 @@ results_nsim_diff_var <- data.table( results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") -plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000, 10000)) +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim") plot_nsim_var ``` ```{r} -# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, +# save( results_min_MCP, minimal_Bay, results_monotonic_MCP, monotonic_Bay, results_non_monotonic_MCP, non_monotonic_Bay, results_var_MCP, variability_Bay, +# results_min_MCP_nsample, minimal_nsample_Bay, results_monotonic_MCP_nsample, monotonic_nsample_Bay, results_non_monotonic_MCP_nsample, non_monotonic_nsample_Bay, results_var_MCP_nsample, +# var_nsample_Bay, results_list_nsim_MCP, results_nsim_Bay, results_list_nsim_MCP_monotonic, results_nsim_Bay_monotonic, results_list_nsim_MCP_non_monotonic, results_nsim_Bay_non_monotonic, results_list_nsim_MCP_var, results_nsim_Bay_var # file = "simulation_data.RData") ``` From 316be6bee5432b4b4511cc442db09e71a123df51 Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 23 Jul 2024 12:07:41 +0100 Subject: [PATCH 25/39] non-monotonic convergence dosefinding --- .../Comparison_convergence.qmd | 229 ++++++++++++++---- .../Comparison_vignette.qmd | 43 ++-- 2 files changed, 204 insertions(+), 68 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 7d8a56d..39af59e 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -272,67 +272,200 @@ results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_B ``` ### non-monotonic MCPModPack -```{r, warning=FALSE} -results_list_nsim_MCP_non_monotonic = list( - power_non_monotonic_nsim_linear = vector(), - power_non_monotonic_nsim_emax = vector(), - power_non_monotonic_nsim_sigemax= vector() - #power_non_monotonic_nsim_quadratic = vector(), - #power_non_monotonic_nsim_beta = vector() - ) +```{r} +# linear with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_linear <- result$linear -sim_models_non_monotonic_linear = list(linear = NA, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) -sim_models_non_monotonic_emax= list(emax = 0.6666667, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) +``` -sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) +```{r} +# emax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` -sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix +```{r} +# sigemax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` -list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, - sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, - sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000)) +``` +```{r} +#quadratic with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) +results_nsim_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` -results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} +``` +```{r} +# beta with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` ``` +```{r} +results_nsim_MCP_non_monotonic <- data.table( + linear = results_nsim_non_monotonic_linear, + emax = results_nsim_non_monotonic_emax, + sigemax = results_nsim_non_monotonic_sigemax, + quadratic = results_nsim_non_monotonic_quadratic, + beta = results_nsim_non_monotonic_beta +) +``` + + + ### variability BayesianMCPMod ```{r} diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 6ce5867..782b66e 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -608,18 +608,18 @@ data_plot_eff_non_monotonic <- data.frame( # Create the plot ggplot(data = data_plot_eff_non_monotonic, aes(x = max_eff_num)) + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + scale_x_continuous(breaks = data_plot_eff_non_monotonic$max_eff_num, labels = data_plot_eff_non_monotonic$max_eff) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 2))+ theme_minimal() + ylab("Power") + xlab("expected effect for maximum dose")+ @@ -818,18 +818,18 @@ data_plot_nsample_non_monotonic <- data.frame( # Create the plot ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 3))+ theme_minimal() + ylab("Power") + ylim(c(0.25,1))+ @@ -892,7 +892,7 @@ ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + ## convergence of power values -In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000. +In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000, 10000. ```{r child = 'Comparison_convergence.qmd'} @@ -965,20 +965,23 @@ plot_nsim_monotonic ```{r} #safe results in data.table for plot results_nsim_non_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power,results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[18]]$sim_results$power), - #MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, + MCP_linear = replicate(6,results_nsim_MCP_non_monotonic$linear), + MCP_emax = replicate(6,results_nsim_MCP_non_monotonic$emax), + MCP_sigemax = replicate(6,results_nsim_MCP_non_monotonic$sigemax), + MCP_quadratic = replicate(6,results_nsim_MCP_non_monotonic$quadratic), + MCP_beta = replicate(6,results_nsim_MCP_non_monotonic$beta), Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, Bay_emax = results_nsim_Bay_monotonic$Bay_emax, Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, - Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic) + Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic, + Bay_beta = results_nsim_Bay_non_monotonic$Bay_betaMod) results_nsim_diff_non_monotonic <- data.table( linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, - #quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + beta = results_nsim_non_monotonic$Bay_beta - results_nsim_non_monotonic$MCP_beta, n_sim = n_sim_values ) @@ -1021,6 +1024,6 @@ plot_nsim_var ```{r} # save( results_min_MCP, minimal_Bay, results_monotonic_MCP, monotonic_Bay, results_non_monotonic_MCP, non_monotonic_Bay, results_var_MCP, variability_Bay, # results_min_MCP_nsample, minimal_nsample_Bay, results_monotonic_MCP_nsample, monotonic_nsample_Bay, results_non_monotonic_MCP_nsample, non_monotonic_nsample_Bay, results_var_MCP_nsample, -# var_nsample_Bay, results_list_nsim_MCP, results_nsim_Bay, results_list_nsim_MCP_monotonic, results_nsim_Bay_monotonic, results_list_nsim_MCP_non_monotonic, results_nsim_Bay_non_monotonic, results_list_nsim_MCP_var, results_nsim_Bay_var +# var_nsample_Bay, results_list_nsim_MCP, results_nsim_Bay, results_list_nsim_MCP_monotonic, results_nsim_Bay_monotonic, results_nsim_MCP_non_monotonic, results_nsim_Bay_non_monotonic, results_list_nsim_MCP_var, results_nsim_Bay_var # file = "simulation_data.RData") ``` From b306709116a0f01bfa425cca26ef6a291814ecce Mon Sep 17 00:00:00 2001 From: "Kleibrink,Gina_Marie (MED BDS) BIP-DE-B" Date: Tue, 23 Jul 2024 14:25:48 +0100 Subject: [PATCH 26/39] add some explanation --- vignettes/Comparison_vignette/Comparison_vignette.qmd | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 782b66e..895b78a 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -288,6 +288,8 @@ further exploration allows us to deepen our understanding of the BayesianMCPMod and MCPModPack packages and their performance under varying conditions. +For each of these simulation cases, 10000 simulation runs are performed. Given the number of simulations, the difference should be in the range of 1-3% (based on the law of large numbers). + ```{r} ####### General assumptions ######### # simulations @@ -465,8 +467,9 @@ var_modelsPack = list(linear = NA, # Comparison -In the following, we will draw comparisons between the power values of -various scenarios and differnt parameters. +In the following, we will draw comparisons between the power values of various scenarios and differnt parameters. + +The following plots show the difference between the results with MCPModPack and BayesianMCPMod. The results with MCPModPack are shown as a line and the difference to the result with BayesianMCPMod is shown as a bar. The dose-response model assumed to be true during the analysis is shown as a different colour. ## varying expected effect for maximum dose @@ -899,6 +902,9 @@ In the following simulations, we examine the convergence of power values for an ``` ## Results +The following plots show the result of the convergence test of the power values for an increasing number of simulations. The difference between the power values of the frequency and Bayesian simulations is shown. +In the non-monotonous scenario, the DoseFinding package was used instead of the MCPModPack. This package does not simulate but accurately calculates the values. The difference between the Bayesian results and the true value of the DoseFinding calculation is also shown. + ### minimal scenario From ccaeb7a21d83c3f5bf32c0c5485792727b497480 Mon Sep 17 00:00:00 2001 From: Bossert Date: Fri, 26 Jul 2024 08:08:46 +0100 Subject: [PATCH 27/39] Reduction of simulation number for merge --- .../Comparison_convergence.qmd | 45 ++++++++++++------- .../Comparison_vignette.qmd | 2 +- 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 39af59e..1651901 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -20,8 +20,8 @@ vignette: > # Define a vector of different n_sim values -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) -n_sim_values <- c(100, 500, 1000, 2500, 5000, 10000) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values <- c(10, 50, 100, 250, 500, 1000) #c(100, 500, 1000, 2500, 5000, 10000) # Initialize a list to store the results results_list_nsim_Bay <- list() @@ -92,9 +92,12 @@ sim_models_min_emax = list( emax = 0.6666667, list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) +#as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) @@ -143,7 +146,7 @@ contM <- getContr(mods = monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -190,11 +193,17 @@ list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, si sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) + + #as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) @@ -242,7 +251,7 @@ contM <- getContr(mods = non_monotonic_models, prior_list = uninf_prior_list, dose_weights = c(1,1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -487,7 +496,7 @@ contM <- getContr(mods = var_models, prior_list = var_uninf_prior_list, dose_weights = c(1,1,1,1)) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) @@ -537,9 +546,13 @@ sim_parameters_var$n <- Nsample_var list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000, - 100, 500, 1000, 2500, 5000, 10000)) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) + +# as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 895b78a..d4cbacd 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -293,7 +293,7 @@ For each of these simulation cases, 10000 simulation runs are performed. Given t ```{r} ####### General assumptions ######### # simulations -n_sim <- 1000 +n_sim <- 100 #to be upscaled to 10000 # Define the list of sample sizes nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) From 1563d23cccfccda54468157aaba11af5dafc7f42 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 11:26:30 +0200 Subject: [PATCH 28/39] merge with main and adjusted pkgdown yml --- DESCRIPTION | 3 ++- _pkgdown.yml | 2 +- vignettes/Comparison_vignette/Comparison_vignette.qmd | 1 - ...ulation_Example_Quarto.qmd => Simulation_Example.qmd} | 9 ++++----- .../{analysis_normal_update.qmd => analysis_normal.qmd} | 0 5 files changed, 7 insertions(+), 8 deletions(-) rename vignettes/{Simulation_Example_Quarto.qmd => Simulation_Example.qmd} (96%) rename vignettes/{analysis_normal_update.qmd => analysis_normal.qmd} (100%) diff --git a/DESCRIPTION b/DESCRIPTION index cfbd7d0..d4971e9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,8 @@ Authors@R: c( person("Lars", "Andersen", , "lars.andersen@boehringer-ingelheim.com", role = "aut"), person("Sebastian", "Bossert", , "sebastian.bossert@boehringer-ingelheim.com", role = "aut"), person("Steven", "Brooks", , "steven.brooks@boehringer-ingelheim.com", role = "ctb"), - person("Jonas", "Schick", , "jonas.schick@boehringer-ingelheim.com", role = "ctb") + person("Jonas", "Schick", , "jonas.schick@boehringer-ingelheim.com", role = "ctb"), + person("Gina", "Kleibrink", , "gina_marie.kleibrink@boehringer-ingelheim.com", role = "ctb") ) Description: Bayesian MCPMod (Fleischer et al. (2022) ) is an innovative method that improves the diff --git a/_pkgdown.yml b/_pkgdown.yml index 934cedf..eb73929 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -12,5 +12,5 @@ articles: navbar: ~ contents: - analysis_normal - - analysis_normal_noninformative - Simulation_Example + - Comparison_vignette/Comparison_vignette diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index d4cbacd..147555f 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -1,6 +1,5 @@ --- title: "Vignette BayesianMCPMod" -subtitle: "WORK IN PROGRESS" date: today format: html: diff --git a/vignettes/Simulation_Example_Quarto.qmd b/vignettes/Simulation_Example.qmd similarity index 96% rename from vignettes/Simulation_Example_Quarto.qmd rename to vignettes/Simulation_Example.qmd index 38b64ab..86f9921 100644 --- a/vignettes/Simulation_Example_Quarto.qmd +++ b/vignettes/Simulation_Example.qmd @@ -1,6 +1,5 @@ --- title: "Simulation Example of Bayesian MCPMod for Continuous Data" -output: rmarkdown::html_vignette number_sections: true format: html: @@ -14,9 +13,9 @@ format: message: false warning: false vignette: > - %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod for Continuous Data} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} --- ```{r, include = FALSE} @@ -178,4 +177,4 @@ success_probabilities <- assessDesign( dr_means = c(-12, -14, -15, -16, -17), n_sim = 100) # speed up example run-time success_probabilities -``` \ No newline at end of file +``` diff --git a/vignettes/analysis_normal_update.qmd b/vignettes/analysis_normal.qmd similarity index 100% rename from vignettes/analysis_normal_update.qmd rename to vignettes/analysis_normal.qmd From 26b02655ef2b7fac8fd73a394a35364f470e3986 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 11:33:50 +0200 Subject: [PATCH 29/39] adjusted lib calls --- vignettes/Comparison_vignette/Comparison_vignette.qmd | 3 +-- vignettes/Simulation_Example.qmd | 4 ++-- vignettes/analysis_normal.qmd | 3 +-- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd index 147555f..6cc0ab3 100644 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette/Comparison_vignette.qmd @@ -207,8 +207,7 @@ chunkVector <- function (x, n_chunks) { return(chunk_list) } -devtools::load_all() -#library(BayesianMCPMod) +library(BayesianMCPMod) library(RBesT) library(clinDR) library(dplyr) diff --git a/vignettes/Simulation_Example.qmd b/vignettes/Simulation_Example.qmd index 86f9921..432cf28 100644 --- a/vignettes/Simulation_Example.qmd +++ b/vignettes/Simulation_Example.qmd @@ -31,8 +31,8 @@ knitr::opts_chunk$set( #| message: false #| warning: false -devtools::load_all() -#library(BayesianMCPMod) + +library(BayesianMCPMod) library(clinDR) library(dplyr) diff --git a/vignettes/analysis_normal.qmd b/vignettes/analysis_normal.qmd index 99bba12..cac8715 100644 --- a/vignettes/analysis_normal.qmd +++ b/vignettes/analysis_normal.qmd @@ -25,8 +25,7 @@ vignette: > #| message: false #| warning: false -devtools::load_all() -#library(BayesianMCPMod) +library(BayesianMCPMod) library(RBesT) library(clinDR) library(dplyr) From ab2826dad7a919803a749bda345cc84cce79e732 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 11:37:55 +0200 Subject: [PATCH 30/39] removed outdated folder --- .../Comparison_BayesianMCPMod.qmd | 506 -------- .../Comparison_MCPModPack.qmd | 1113 ----------------- .../Comparison_convergence.qmd | 419 ------- .../Comparison_vignette.qmd | 1020 --------------- vignettes/outdatet/Simulation_Example.Rmd | 163 --- vignettes/outdatet/analysis_normal.Rmd | 286 ----- .../analysis_normal_noninformative.qmd | 414 ------ 7 files changed, 3921 deletions(-) delete mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd delete mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd delete mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd delete mode 100644 vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd delete mode 100644 vignettes/outdatet/Simulation_Example.Rmd delete mode 100644 vignettes/outdatet/analysis_normal.Rmd delete mode 100644 vignettes/outdatet/analysis_normal_noninformative.qmd diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd deleted file mode 100644 index a18a3d3..0000000 --- a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_BayesianMCPMod.qmd +++ /dev/null @@ -1,506 +0,0 @@ ---- -title: "Vignette BayesianMCPMod - BayesianMCPMod Analysis" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} ---- - -Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. - - -# Prior Specification -In a first step an uninformativ prior is calculated. - -```{r} -uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") - -) -``` - -To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. - -## Minimal scnenario -### varying expected effect for maximum dose - - -```{r} - -# list to store results -results_list_Bay_min <- list() - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - #optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) - -minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) - -minimal_Bay$kable_result - - - -``` -### varying sample size - - -```{r} -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - -# Initialize list to store results -results_list_nsample_min_Bay <- list() - -#Models with maxEff = 0.2 -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_min <- assessDesign( - n_patients = nsample_list[[i]], - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - - -results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) - -minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) -minimal_nsample_Bay$kable_result - - - -``` - - - -## Monotonic scenario - -### varying expected effect for maximum dose - -```{r} -results_list_Bay_monotonic <- list() - - - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - - # optimal contrasts - contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # perform Simulations - success_probabilities_monotonic <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - - - }) - -} - - -##power results in vector for tables -results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) - - -monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) - - -monotonic_Bay$kable_result - - - -``` - -### varying sample size -```{r} -# Initialize list to store results -results_list_nsample_monotonic_Bay <- list() - -# dose - response models -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) -} - - -results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) - - -monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) -monotonic_nsample_Bay$kable_result - - -``` - - -## Non-monotonic scenario -### varying expected effect for maximum dose -```{r} -results_list_Bay_non_monotonic <- list() - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - - non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts - contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - success_probabilities_non_monotonic <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - - }) - -} - -results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) - -non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) - -non_monotonic_Bay$kable_result - - -``` -### varying sample size -```{r} -# Initialize list to store results -results_list_nsample_non_monotonic_Bay <- list() - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -contM_2 <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) - -contrasts_list = list(contM_2, contM, contM_2, contM) - - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_non_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) -} - - -results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) - - -non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) -non_monotonic_nsample_Bay$kable_result - - -``` - - -## Variability scenario -### varying expected effect for maximum dose -```{r} - -# prior -var_uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) - -results_list_Bay_var <- list() - - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - var_models <- Mods(linear = NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - - contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - - success_probabilities_var <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - -results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) - -variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) - -variability_Bay$kable_result - - -``` -### varying sample size -```{r} -results_list_nsample_Bay_var <- list() - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -contM_2 <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(2,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - - -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - -chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) - -results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - success_probabilities_var <- assessDesign( - n_patients = nsample_list_var[[i]], - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - - -results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) - - -var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) -var_nsample_Bay$kable_result - - -``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd deleted file mode 100644 index 9143455..0000000 --- a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_MCPModPack.qmd +++ /dev/null @@ -1,1113 +0,0 @@ ---- -title: "Vignette BayesianMCPMod - MCPModPack Analysis" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} ---- - -Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. - -## Minimal scenario - -### varying expected effect for maximum dose -```{r warning=FALSE} -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_min <- list() - -# Run simulation -func_sim <- function(models ,sim_models, sim_parameters){ - -sim_result = MCPModSimulation(endpoint_type = "Normal", - models = models, - alpha = alpha, - direction = "increasing", - model_selection = "aveAIC", - Delta = 0.1, - sim_models = sim_models, - sim_parameters = sim_parameters) -} - - -list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - - - -#store results -results_min_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_min[[1]]$sim_results$power), - exponential = c(results_list_min[[2]]$sim_results$power), - emax = c(results_list_min[[3]]$sim_results$power), - Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, - sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, - sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, - sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, - sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) - - -kable(results_min_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -### varying sample size -```{r warning=FALSE} -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - -# store results -power_min_nsample_linear <- vector() -power_min_nsample_exp <- vector() -power_min_nsample_emax <- vector() - - - - - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# # Update nsample in simulation parameters -# sim_parameters$n <- nsample_list[[i]] -# -# # Set max_effect to 0.2 -# min_modelsPack$max_effect <- expectedEffect_fix -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) -# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) -# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) -# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power -# -# } -# Set max_effect to 0.2 -min_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) - -#ind_tasks <- 1:12 - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - -# store results -results_min_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), - Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), - Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), - Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, - sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, - sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, - sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) -) - -kable(results_min_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -## Monotonic scenario - -### varying expected effect for maximum dose -```{r warning=FALSE} -# assumed dose - response models -sim_models_monotonic_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_emax= list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_monotonic <- list() - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_monotonic_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_monotonic[[1]]$sim_results$power), - exp = c(results_list_monotonic[[2]]$sim_results$power), - emax = c(results_list_monotonic[[3]]$sim_results$power), - logistic = c(results_list_monotonic[[4]]$sim_results$power), - sigEmax = c(results_list_monotonic[[5]]$sim_results$power), - Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) -) - -kable(results_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) - - -``` - -### varying sample size -```{r warning=FALSE} -# assumed dose- response model with assumed maximum effect = 0.2 -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -# store results -power_monotonic_nsample_linear <- vector() -power_monotonic_nsample_exp <- vector() -power_monotonic_nsample_emax <- vector() -power_monotonic_nsample_logistic <- vector() -power_monotonic_nsample_sigemax <- vector() - - - -# Set max_effect to 0.2 -monotonic_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -# store results -results_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), - Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), - Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), - Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), - sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), -Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) - - -kable(results_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) - - -``` - -## Non-monotonic scenario - -### varying expected effect for maximum dose - -For the simulations of the non-monotonic scenario, the R package 'Dosefinding' was used instead of 'MCPModPack - -```{r} -# linear with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_linear <- result$linear -``` - - -```{r} -# emax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` -``` - - -```{r} -# sigemax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` -``` - - - -```{r} -#quadratic with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` - -``` - -```{r} -# beta with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` -``` - - -```{r} -#linear, emax, sigemax, quadratic -results_non_monotonic_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = power_non_monotonic_linear, - emax = power_non_monotonic_emax, - sigEmax = power_non_monotonic_sigemax, - quadratic = power_non_monotonic_quadratic, - beta = power_non_monotonic_beta, - average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), - (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), - (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), - (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), - (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) - ) - - -kable(results_non_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) -``` - -### varying sample size - -```{r warning=FALSE} - - -# store results -power_non_monotonic_nsample_linear <- vector() -power_non_monotonic_nsample_emax <- vector() -power_non_monotonic_nsample_quadratic <- vector() -power_non_monotonic_nsample_sigemax <- vector() -power_non_monotonic_nsample_beta <- vector() - - -``` - -```{r} -# linear with DoseFinding -# allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[2] <- result$linear[1] -power_non_monotonic_nsample_linear[4] <- result$linear[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[1] <- result$linear[1] -power_non_monotonic_nsample_linear[3] <- result$linear[2] -``` - - -```{r} - -# emax with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] -``` - - - -```{r} -# sigemax with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] -``` - - - - -```{r} -# quadratic with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] -``` - - - -```{r} -# beta with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] -``` - - -```{r} -#store results -results_non_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = power_non_monotonic_nsample_linear, - Emax = power_non_monotonic_nsample_emax, - sigEmax = power_non_monotonic_nsample_sigemax, - quadratic = power_non_monotonic_nsample_quadratic, - beta = power_non_monotonic_nsample_beta -) - - -kable(results_non_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) - -``` - -## Variability scenario -### varying expected effect for maximum dose - -```{r warning=FALSE} -# assumed dose - response model -sim_models_var_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_emax = list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - - - -# Simulation parameters -sim_parameters_var = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# perform Simulations - -list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) - - }) - -} - - -# store results -results_var_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = results_list_var[[1]]$sim_results$power, - exponential = results_list_var[[2]]$sim_results$power, - emax = results_list_var[[3]]$sim_results$power, - average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), - (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), - (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), - (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), - (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) -) - -kable(results_var_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - - -``` - -### varying sample size -```{r warning=FALSE} -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - - -# store results -power_var_nsample_linear <- vector() -power_var_nsample_exp <- vector() -power_var_nsample_emax <- vector() - -# # Loop over nsample values -# for (i in seq_along(nsample_list_var)) { -# -# # Update nsample in simulation parameters -# sim_parameters_var$n <- nsample_list_var[[i]] -# -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) -# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) -# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) -# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power -# -# -# } - -var_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list_var[[i]], - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_var_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), - Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), - Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), - Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), - (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), - (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), - (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) -) - -kable(results_var_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - -``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd deleted file mode 100644 index 2b6e163..0000000 --- a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_convergence.qmd +++ /dev/null @@ -1,419 +0,0 @@ ---- -title: "Vignette BayesianMCPMod - convergence of power values" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} ---- - - -```{r} -# minimal BayesianMCPMod - -# Define a vector of different n_sim values -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) -n_sim_values <- c(100, 500, 1000, 2500, 5000) - -# Initialize a list to store the results -results_list_nsim_Bay <- list() - -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") -#optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) - - -``` - -```{r warning=FALSE} -# minimal MCPModPack - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - - - - -list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000, 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - - -``` - - - - -```{r} -# monotonic BayesianMCPMod - -# Initialize a list to store the results - results_list_nsim_Bay_monotonic <- list() - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) - -``` - -```{r warning=FALSE} -# monotonic MCPModPack - -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax,sim_models_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` - -```{r} -# non-monotonic BayesianMCPMod - -# Initialize list to store results -results_list_nsim_Bay_non_monotonic <- list() - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) -``` - -```{r, warning=FALSE} -# non-monotonic MCPModPack - -results_list_nsim_MCP_non_monotonic = list( - power_non_monotonic_nsim_linear = vector(), - power_non_monotonic_nsim_emax = vector(), - power_non_monotonic_nsim_sigemax= vector() - #power_non_monotonic_nsim_quadratic = vector(), - #power_non_monotonic_nsim_beta = vector() - ) - -sim_models_non_monotonic_linear = list(linear = NA, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_non_monotonic_emax= list(emax = 0.6666667, - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_non_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = 0.2, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - - -sim_models_non_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_non_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_non_monotonic_sigemax$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_quadratic$max_effect <- expectedEffect_fix -#sim_models_non_monotonic_beta$max_effect <- expectedEffect_fix - -list_models <- list(sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, sim_models_non_monotonic_linear, - sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, sim_models_non_monotonic_emax, - sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax, sim_models_non_monotonic_sigemax,sim_models_non_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(non_monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` - -```{r} -# variability BayesianMCPMod - -# Initialize list to store results -results_list_nsim_Bay_var <- list() - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) -``` - -```{r, warning=FALSE} -# variability MCPModPack - -results_list_nsim_MCP_var = list( - power_var_nsim_linear = vector(), - power_var_nsim_exp = vector(), - power_var_nsim_emax= vector()) - -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - -sim_parameters_var$n <- Nsample_var - - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) -n_sim_values_list <- as.list(c(100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000, - 100, 500, 1000, 2500, 5000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` \ No newline at end of file diff --git a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd b/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd deleted file mode 100644 index 89b9525..0000000 --- a/vignettes/outdatet/Comparison_vignette_outdatet/Comparison_vignette.qmd +++ /dev/null @@ -1,1020 +0,0 @@ ---- -title: "Vignette BayesianMCPMod" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} -editor: - markdown: - wrap: 72 ---- - -```{r} -#| code-summary: setup -#| code-fold: true -#| message: false -#| warning: false - -#' Display Parameters Table -#' -#' This function generates a markdown table displaying the names and values of parameters -#' from a named list. -#' -#' @param named_list A named list where each name represents a parameter name and the list -#' element represents the parameter value. Date values in the list are automatically -#' converted to character strings for display purposes. -#' -#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". -#' The function does not return a value but displays the table directly to the output. -#' -#' @importFrom knitr kable -#' @examples -#' params <- list("Start Date" = as.Date("2020-01-01"), -#' "End Date" = as.Date("2020-12-31"), -#' "Threshold" = 10) -#' display_params_table(params) -#' -#' @export -display_params_table <- function(named_list) { - display_table <- data.frame() - value_names <- data.frame() - for (i in 1:length(named_list)) { - # dates will display as numeric by default, so convert to char first - if (class(named_list[[i]]) == "Date") { - named_list[[i]] = as.character(named_list[[i]]) - } - if (!is.null(names(named_list[[i]]))) { - value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) - } - values <- data.frame(I(list(named_list[[i]]))) - display_table <- rbind(display_table, values) - } - - round_numeric <- function(x, digits = 3) { - if (is.numeric(x)) { - return(round(x, digits)) - } else { - return(x) - } - } - - display_table[1] <- lapply(display_table[1], function(sublist) { - lapply(sublist, round_numeric) - }) - - class(display_table[[1]]) <- "list" - - if (nrow(value_names) == 0) { - knitr::kable( - cbind(names(named_list), display_table), - col.names = c("Name", "Value") - ) - } else { - knitr::kable( - cbind(names(named_list), value_names, display_table), - col.names = c("Name", "Value Labels", "Value") - ) - } -} -# function to solve power results for tables (different max eff) BayesianMCPMod -# return(successrates models, average) -extract_success_rates <- function(results_list, models) { - success_rates <- list() - - for (i in seq_along(results_list)) { - success_rate <- c() - for (model in models) { - success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) - } - success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate")) - } - - return(success_rates) - } - -# function to solve power results for tables (different nsample) BayesianMCPMod -#models % - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>% - add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) - - list(result_table = result_table, kable_result = kable_result) -} - - - -print_result_Bay_nsample <- function(results, scenario, variable) { - - result_table <- t(data.table( - Bay_1 = results$Bay_1, - Bay_2 = results$Bay_2, - Bay_3 = results$Bay_3, - Bay_4 = results$Bay_4)) - - result_table <- as.data.table(result_table) - names(result_table) <- scenario - #return(result_table) - - kable_result <- kable(cbind(variable, result_table))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>% - add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) - - list(result_table = result_table, kable_result = kable_result) -} - -plot_power_deviation <- function(data, x, xlab, xlim){ - plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - scale_x_continuous(breaks = xlim) + - geom_hline(aes(yintercept = 0), linetype = 2)+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - labs(x = xlab, y = "power deviation")+ - ylim(-0.2, 0.2)+ #with higher n_sim!!!!!!!!!!!! - theme_classic() - return(plot) -} - -#plot all max effects in one plot - -plot_max_eff <- function(results_MCP, results_Bay, scenario){ - -transformed_MCP <- t(results_MCP) -transformed_MCP <- as.data.table(transformed_MCP) -transformed_MCP <- transformed_MCP[-c(1),] - -data <- data.table( - Bay_0.05 = results_Bay$Bay_0.05, - Bay_0.1 = results_Bay$Bay_0.1, - Bay_0.2 = results_Bay$Bay_0.2, - Bay_0.3 = results_Bay$Bay_0.3, - Bay_0.5 = results_Bay$Bay_0.5, - MCP_0.05 = transformed_MCP$V1, - MCP_0.1 = transformed_MCP$V2, - MCP_0.2 = transformed_MCP$V3, - MCP_0.3 = transformed_MCP$V4, - MCP_0.5 = transformed_MCP$V5, - scenario = c(scenario, "average") -) - - - - - plot_max_eff <- ggplot(data = data)+ - geom_point(mapping = aes(x= data$scenario, y = data$Bay_0.05, colour = "MCPMod", shape = "0.05"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.05, colour = "BayesianMCPMod", shape = "0.05"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= data$scenario, y = data$MCP_0.1, colour = "MCPMod", shape = "0.1"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.1, colour = "BayesianMCPMod", shape = "0.1"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.2, colour = "MCPMod", shape = "0.2"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.2, colour = "BayesianMCPMod", shape = "0.2"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.3, colour = "MCPMod", shape = "0.3"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.3, colour = "BayesianMCPMod", shape = "0.3"), data = data, position = position_nudge(x = 0.15))+ - geom_point(mapping = aes(x= scenario, y = data$MCP_0.5, colour = "MCPMod", shape = "0.5"), data = data, position = position_nudge(x = -0.15))+ - geom_point(mapping = aes(x= scenario, y = data$Bay_0.5, colour = "BayesianMCPMod", shape = "0.5"), data = data, position = position_nudge(x = 0.15))+ - scale_color_manual(name = "Legend", values = c("MCPMod" = 'blue', "BayesianMCPMod" = "red"))+ - scale_shape_manual(name = "Expected effects", values = c("0.05" = 0, "0.1" = 1, "0.2" = 2, "0.3" = 3, "0.5" = 5))+ - ylim(0, 1)+ - ylab("power")+ - xlab("assumed true model")+ - labs(title = "Power for different models and differen exptected effects for maximum dose")+ - theme_bw() - - plot_max_eff - -} - - - -# parallel---------------------------------------------- -chunkVector <- function (x, n_chunks) { - if (n_chunks <= 1) { - chunk_list <- list(x) - } else { - chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) - } - return(chunk_list) -} - -devtools::load_all() -#library(BayesianMCPMod) -library(RBesT) -library(clinDR) -library(dplyr) -library(tibble) -library(reactable) -library(DoseFinding) -library(MCPModPack) -library(kableExtra) -library(data.table) -library(doFuture) -library(doRNG) - -registerDoFuture() -plan(multisession) - - - -set.seed(7015) -``` - -# Introduction - -This vignette demonstrates the application of the {BayesianMCPMod} -package for sample size calculations and the comparison with the -{MCPModPack} package. As for other bayesian approaches BMCPMod is able -to mimic the results of the frequentist MCPMod for non-informative -priors and this is shown here for the sample size planning of different -scenarios. - -In order to test and compare BayesianMCPMod and MCPModPack sample size -calculations in different scenarios, the data used for the comparisons -will be simulated multiple times using different input values. Every -scenario will be named to make the differentiation between each scenario -simpler. Altogether, four different scenarios were simulated. The first -three scenarios are pretty similiar, they only differ in the pre-defined -set of candidate models M. The other design choices, like the number of -dose levels or sample size allocation stay the same between the -scenarios. For the first three scenarios, these design choices are: - -- four dose levels plus placebo (0 mg, 1 mg, 2 mg, 4 mg, 8 mg) - -- total sample size of N = 200 - -- equal allocation ratio for each dose group - -- expected effect for maximum dose of 0.2 mg - -- standard deviation of 0.4 for every dose group - -The fourth scenario, the variability scenario, has some different design -choices: - three dose levels plus placebo (0 mg, 1 mg, 4 mg, 8 mg) - -total sample size of N = 100 - equal allocation ratio for each dose -group - expected effect for maximum dose of 0.2 mg - standard deviation -of 0.4 for every dose group - -Building on the initial scenarios, we further delve into the exploration -of varying input parameters. The varying parameters are: - -- expected effect for maximum dose of (0.05 mg, 0.1 mg, 0.2 mg, 0.3 - mg, 0.5 mg) - -- different total sample size with different allocation: - -- (40,20,20,20,40), (30,30,30,30,30), (48,24,24,24,48), - (36,36,36,36,36) (for the first three scenarios) - -- (40,20,20,40), (30,30,30,30), (48,24,24,48), (36,36,36,36) (for the - variability scenario) - -In a subsequent step, we extend our analysis to test the convergence of -power values as the number of simulations increases. For this part of -the study, we assume an expected effect for the maximum dose of 0.2 mg. -The sample size is set to 200 for the linear, monotonic and -non-monotonic scenario and 100 for the variability scenario. This -further exploration allows us to deepen our understanding of the -BayesianMCPMod and MCPModPack packages and their performance under -varying conditions. - -```{r} -####### General assumptions ######### -# simulations -n_sim <- 1000 - -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) -nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") - -# define input parameters -doses.sim <- c(0,1,2,4,8) # dose levels -max.dose <- max(doses.sim) # specify max dose possibly available -plc.guess <- 0 # expected placebo effect -Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) -expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) -expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) -sd.sim <- c(0.4) - -#input paramters variability scenario -doses_var <- c(0, 1, 4, 8) -sd.sim_var <- 0.4 -Nsample_var <- c(25, 25, 25, 25) -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - - -# define model functions -emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") -exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) -logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) -sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") -quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") -beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) - -### define models to be tested in MCPMod -models <- Mods(linear=NULL, - emax = emax.g, - exponential = exp.g, - logistic=logit.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) -) - -alpha <- 0.05 - -# display_params_table(models) - - -# kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% -# kable_classic(full_width = TRUE)%>% -# add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) -# -# -# kable(t(data.table(placebo_guess = plc.guess, -# sd = sd.sim[1], -# alpha = alpha )))%>% -# kable_classic(full_width = TRUE) - -``` - -## Scenarios - -In the following the candidate models for the different scenarios are -plotted. - -```{r} - -#Specification of considered models for different scenarios for BayesianMCPMod - -min_scenario <- c("linear", "exponential", "emax") -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(min_models, main = "minimal Scenario") - - -monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(monotonic_models, main = "monotonic Scenario") - - -non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) -) -plot(non_monotonic_models,main = "non monotonic Scenario") - - -variability_scenario <- c("linear","exponential", "emax") - -kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c( "Doses variability scenario" = 5), font_size = 15) - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(var_models, main = "variability Scenario") - -``` - -# MCPModPack - -```{r} - -#Specification of considered models for different scenarios for MCPModPack - -min_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667) - -monotonic_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -non_monotonic_modelsPack = list(linear = NA, - emax = 0.6666667 , - sigEmax = c(1.528629, 4.087463), - quadratic = -0.09688711) -#beta - -var_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -``` - -```{r child = 'Comparison_MCPModPack.qmd'} - -``` - -# BayesianMCPMod - -```{r child = 'Comparison_BayesianMCPMod.qmd'} - -``` - -# Comparison - -In the following, we will draw comparisons between the power values of -various scenarios and differnt parameters. - -## varying expected effect for maximum dose - -### minimal scenario - -```{r} - -plot_minimal_max_eff <- plot_max_eff(results_min_MCP, results_min_Bay, min_scenario) -plot_minimal_max_eff - -#table with results -kable(results_min_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack " = 5), font_size = 15, bold = TRUE) - -minimal_Bay$kable_result - -#difference of power values -results_min_max_eff <- data.table( - linear = as.vector(minimal_Bay$result_table$linear)-as.vector(results_min_MCP$linear), - exponential = as.vector(minimal_Bay$result_table$exponential)-as.vector(results_min_MCP$exponential), - emax = as.vector(minimal_Bay$result_table$emax)-as.vector(results_min_MCP$emax), - expectedEffect = expectedEffect -) - - - -results_min_max_eff <- melt(results_min_max_eff, id.vars = "expectedEffect") - -plot_minimal <- plot_power_deviation(results_min_max_eff, results_min_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_minimal -``` - -```{r} - -``` - -### monotonic scenario - -```{r} -plot_monotonic_max_eff <- plot_max_eff(results_monotonic_MCP, results_monotonic_Bay, monotonic_scenario) -plot_monotonic_max_eff - -#table with results -kable(results_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack " = 7), font_size = 15, bold = TRUE) - -monotonic_Bay$kable_result - - -results_monotonic_max_eff <- data.table( - linear = as.vector(monotonic_Bay$result_table$linear)-as.vector(results_monotonic_MCP$linear), - exponential = as.vector(monotonic_Bay$result_table$exponential)-as.vector(results_monotonic_MCP$exp), - emax = as.vector(monotonic_Bay$result_table$emax)-as.vector(results_monotonic_MCP$emax), - logistic = as.vector(monotonic_Bay$result_table$logistic)-as.vector(results_monotonic_MCP$logistic), - sigemax = as.vector(monotonic_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP$sigEmax), - expectedEffect = expectedEffect -) - -results_monotonic_max_eff <- melt(results_monotonic_max_eff, id.vars = "expectedEffect") - -plot_monotonic <- plot_power_deviation(results_monotonic_max_eff, results_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_monotonic -``` - -### non - monotonic scenario - -```{r} -plot_non_monotonic_max_eff <- plot_max_eff(results_non_monotonic_MCP, results_non_monotonic_Bay, non_monotonic_scenario) -plot_non_monotonic_max_eff - -# table results -kable(results_non_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) - -non_monotonic_Bay$kable_result - -results_non_monotonic_max_eff <- data.table( - linear = as.vector(non_monotonic_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP$linear), - emax = as.vector(non_monotonic_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP$emax), - sigemax = as.vector(non_monotonic_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP$sigEmax), - quadratic = as.vector(non_monotonic_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP$quadratic), - beta = as.vector(non_monotonic_Bay$result_table$beta)-as.vector(results_non_monotonic_MCP$beta), - expectedEffect = expectedEffect - ) - -results_non_monotonic_max_eff <- melt(results_non_monotonic_max_eff, id.vars = "expectedEffect") - -plot_non_monotonic <- plot_power_deviation(results_non_monotonic_max_eff, results_non_monotonic_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_non_monotonic -``` - -### variability scenario - -```{r} -plot_var_max_eff <- plot_max_eff(results_var_MCP, results_variability_Bay, variability_scenario) -plot_var_max_eff - -#table with results -kable(results_var_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) - -variability_Bay$kable_result - -results_var_max_eff <- data.table( - linear = as.vector(variability_Bay$result_table$linear)-as.vector(results_var_MCP$linear), - exponential = as.vector(variability_Bay$result_table$exponential)-as.vector(results_var_MCP$exponential), - emax = as.vector(variability_Bay$result_table$emax)-as.vector(results_var_MCP$emax), - expectedEffect = expectedEffect -) - -results_var_max_eff <- melt(results_var_max_eff, id.vars = "expectedEffect") - -plot_var <- plot_power_deviation(results_var_max_eff, results_var_max_eff$expectedEffect, "assumed maximum effect", c(0.05,0.1,0.2,0.3,0.5)) -plot_var -``` - -## varying sample size - -```{r} -nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) -``` - -### minimal scenario - -```{r} - -# results_min_nsample <- data.table( -# linear = as.vector(minimal_nsample_Bay$result_table$linear)-as.vector(results_min_MCP_nsample$Linear), -# exponential = as.vector(minimal_nsample_Bay$result_table$exponential)-as.vector(results_min_MCP_nsample$Exponential), -# emax = as.vector(minimal_nsample_Bay$result_table$emax)-as.vector(results_min_MCP_nsample$Emax), -# nsample_vector = nsample_vector -# ) -# -# results_min_nsample <- melt(results_min_nsample, id.vars = "nsample_vector") -# -# plot_minimal_nsample <- plot_power_deviation(results_min_nsample, results_min_nsample$nsample_vector, "sample sizes") -# plot_minimal_nsample - -kable(results_min_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) - -minimal_nsample_Bay$kable_result - - - - -data_plot_nsample_min <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = minimal_nsample_Bay$result_table$linear, - end_linear = results_min_MCP_nsample$Linear, - start_exp = minimal_nsample_Bay$result_table$exponential, - end_exp = results_min_MCP_nsample$Exponential, - start_emax = minimal_nsample_Bay$result_table$emax, - end_emax = results_min_MCP_nsample$Emax -) - - -# Create the plot -ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes") + - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") - - - - -``` - -### monotonic scenario - -```{r} -# results_monotonic_nsample <- data.table( -# linear = as.vector(monotonic_nsample_Bay$result_table$linear)-as.vector(results_monotonic_MCP_nsample$Linear), -# exponential = as.vector(monotonic_nsample_Bay$result_table$exponential)-as.vector(results_monotonic_MCP_nsample$Exponential), -# emax = as.vector(monotonic_nsample_Bay$result_table$emax)-as.vector(results_monotonic_MCP_nsample$Emax), -# logistic = as.vector(monotonic_nsample_Bay$result_table$logistic)-as.vector(results_monotonic_MCP_nsample$Logistic), -# sigemax = as.vector(monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_monotonic_MCP_nsample$sigEmax), -# nsample_vector = nsample_vector -# ) -# -# results_monotonic_nsample <- melt(results_monotonic_nsample, id.vars = "nsample_vector") -# -# plot_monotonic_nsample <- plot_power_deviation(results_monotonic_nsample, results_monotonic_nsample$nsample_vector, "sample sizes") -# plot_monotonic_nsample - - -kable(results_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) - -monotonic_nsample_Bay$kable_result - -data_plot_nsample_monotonic <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = monotonic_nsample_Bay$result_table$linear, - end_linear = results_monotonic_MCP_nsample$Linear, - start_exp = monotonic_nsample_Bay$result_table$exponential, - end_exp = results_monotonic_MCP_nsample$Exponential, - start_emax = monotonic_nsample_Bay$result_table$emax, - end_emax = results_monotonic_MCP_nsample$Emax, - start_logistic = monotonic_nsample_Bay$result_table$logistic, - end_logistic = results_monotonic_MCP_nsample$Logistic, - start_sigemax = monotonic_nsample_Bay$result_table$sigEmax, - end_sigemax = results_monotonic_MCP_nsample$sigEmax -) - - -# Create the plot -ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + - scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") - - -``` - -### non-monotonic scenario - -```{r} -# results_non_monotonic_nsample <- data.table( -# linear = as.vector(non_monotonic_nsample_Bay$result_table$linear)-as.vector(results_non_monotonic_MCP_nsample$Linear), -# emax = as.vector(non_monotonic_nsample_Bay$result_table$emax)-as.vector(results_non_monotonic_MCP_nsample$Emax), -# sigemax = as.vector(non_monotonic_nsample_Bay$result_table$sigEmax)-as.vector(results_non_monotonic_MCP_nsample$sigEmax), -# quadratic = as.vector(non_monotonic_nsample_Bay$result_table$quadratic)-as.vector(results_non_monotonic_MCP_nsample$quadratic), -# beta = as.vector(non_monotonic_nsample_Bay$result_table$betaMod) - as.vector(results_non_monotonic_MCP_nsample$beta), -# nsample_vector = nsample_vector -# ) -# -# results_non_monotonic_nsample <- melt(results_non_monotonic_nsample, id.vars = "nsample_vector") -# -# plot_non_monotonic_nsample <- plot_power_deviation(results_non_monotonic_nsample, results_non_monotonic_nsample$nsample_vector, "sample sizes") -# plot_non_monotonic_nsample - -kable(results_non_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 6), font_size = 15, bold = TRUE) - -non_monotonic_nsample_Bay$kable_result - -data_plot_nsample_non_monotonic <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = non_monotonic_nsample_Bay$result_table$linear, - end_linear = results_non_monotonic_MCP_nsample$Linear, - start_emax = non_monotonic_nsample_Bay$result_table$emax, - end_emax = results_non_monotonic_MCP_nsample$Emax, - start_sigemax = non_monotonic_nsample_Bay$result_table$sigEmax, - end_sigemax = results_non_monotonic_MCP_nsample$sigEmax, - start_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, - end_quadratic = results_non_monotonic_MCP_nsample$quadratic, - start_beta = non_monotonic_nsample_Bay$result_table$betaMod, - end_beta = results_non_monotonic_MCP_nsample$beta -) - - -# Create the plot -ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta"), size = 0.5) + - scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") - - - -``` - -### variability sceanrio - -```{r} -# results_var_nsample <- data.table( -# linear = as.vector(var_nsample_Bay$result_table$linear)-as.vector(results_var_MCP_nsample$Linear), -# exponential = as.vector(var_nsample_Bay$result_table$exponential)-as.vector(results_var_MCP_nsample$Exponential), -# emax = as.vector(var_nsample_Bay$result_table$emax)-as.vector(results_var_MCP_nsample$Emax), -# nsample_vector = nsample_vector -# ) -# -# results_var_nsample <- melt(results_var_nsample, id.vars = "nsample_vector") -# -# -# plot_var_nsample <- plot_power_deviation(results_var_nsample, results_var_nsample$nsample_vector, "sample sizes") -# plot_var_nsample - -kable(results_var_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - -var_nsample_Bay$kable_result - - -data_plot_nsample_var <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = var_nsample_Bay$result_table$linear, - end_linear = results_var_MCP_nsample$Linear, - start_exp = var_nsample_Bay$result_table$exponential, - end_exp = results_var_MCP_nsample$Exponential, - start_emax = var_nsample_Bay$result_table$emax, - end_emax = results_var_MCP_nsample$Emax -) - - -# Create the plot -ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential"), size = 0.5) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "MCPMod power deviation"), size = 3) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax"), size = 0.5) + - scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + - scale_color_manual(name = "Assumed true model (BayesianMCPMod)", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink", "MCPMod power deviation" = "grey"))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") - -``` - -## convergence of power values - -In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000. - -```{r child = 'Comparison_convergence.qmd'} - -``` - -### minimal scenario - - -```{r} -#safe results in data.table for plot -results_nsim <- data.table( - MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP[[6]]$sim_results$power, results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power, results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power), - Bay_linear = results_nsim_Bay$Bay_linear, - Bay_exp = results_nsim_Bay$Bay_exponential, - Bay_emax = results_nsim_Bay$Bay_emax) - -results_nsim_diff <- data.table( - linear = results_nsim$Bay_linear - results_nsim$MCP_linear, - exponential = results_nsim$Bay_exp - results_nsim$MCP_exp, - emax = results_nsim$Bay_emax - results_nsim$MCP_emax, - n_sim = n_sim_values -) - -results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") - -plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) -plot_nsim -``` - -### monotonic scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power), - MCP_logistic = c(results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power, results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power, results_list_nsim_MCP_monotonic[[25]]$sim_results$power), - Bay_linear = results_nsim_Bay_monotonic$Bay_linear, - Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, - Bay_emax = results_nsim_Bay_monotonic$Bay_emax, - Bay_logistic = results_nsim_Bay_monotonic$Bay_logistic, - Bay_sigemax = results_nsim_Bay_monotonic$Bay_sigEmax) - -results_nsim_diff_monotonic <- data.table( - linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, - exponential = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, - emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, - logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, - sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, - n_sim = n_sim_values -) - -results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") - -plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) -plot_nsim_monotonic -``` - -### non - monotonic scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_non_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_non_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[5]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_non_monotonic[[6]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[10]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_non_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[12]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_non_monotonic[[15]]$sim_results$power), - #MCP_quadratic = results_list_nsim_MCP_non_monotonic$power_non_monotonic_nsim_sigemax, - Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, - Bay_emax = results_nsim_Bay_monotonic$Bay_emax, - Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, - Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic) - -results_nsim_diff_non_monotonic <- data.table( - linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, - emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, - sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, - #quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, - n_sim = n_sim_values -) - - -results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") - -plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) -plot_nsim_non_monotonic - -``` - -### variability scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_var <- data.table( - MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_var[[6]]$sim_results$power, results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power, results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power), - Bay_linear = results_nsim_Bay_var$Bay_linear, - Bay_exp = results_nsim_Bay_var$Bay_exponential, - Bay_emax = results_nsim_Bay_var$Bay_emax -) - -results_nsim_diff_var <- data.table( - linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, - exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, - emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, - n_sim = n_sim_values - ) - -results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") - -plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim", c(100, 500, 1000, 2500, 5000)) -plot_nsim_var -``` - -```{r} -# save(results_nsim_Bay, results_list_nsim_MCP, results_nsim_monotonic, results_nsim_non_monotonic, results_nsim_var, results_min_MCP, results_monotonic_MCP, results_non_monotonic_MCP, results_var_MCP, results_min_MCP_nsample, results_monotonic_MCP_nsample, results_non_monotonic_MCP_nsample, results_var_MCP_nsample, results_min_Bay, results_min_Bay_nsample, results_monotonic_Bay, results_monotonic_Bay_nsample, results_non_monotonic_Bay, results_non_monotonic_Bay_nsample, results_variability_Bay, results_variability_Bay_nsample, -# file = "simulation_data.RData") -``` diff --git a/vignettes/outdatet/Simulation_Example.Rmd b/vignettes/outdatet/Simulation_Example.Rmd deleted file mode 100644 index 4b36538..0000000 --- a/vignettes/outdatet/Simulation_Example.Rmd +++ /dev/null @@ -1,163 +0,0 @@ ---- -title: "Simulation Example of Bayesian MCPMod for Continuous Data" -output: rmarkdown::html_vignette -number_sections: true -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod for Continuous Data} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -```{r setup} -library(BayesianMCPMod) -library(clinDR) -library(dplyr) - -set.seed(7015) -``` - -# Background and data - -In this vignette, we will show the use of the Bayesian MCPMod package for trial planning for continuous distributed data. -As in [the analysis example vignette](analysis_normal.html), we focus on the indication MDD and make use of historical data that is included in the clinDR package. -More specifically, trial results for BRINTELLIX will be utilized to establish an informative prior for the control group. - -# Calculation of a MAP prior -In a first step, a meta analytic predictive prior will be calculated using historical data from 5 trials with main endpoint Change from baseline in MADRS score after 8 weeks. -Please note that only information from the control group will be integrated leading to an informative mixture prior for the control group, while for the active groups a non-informative prior will be specified. - -```{r Historical Data} -data("metaData") -testdata <- as.data.frame(metaData) -dataset <- filter(testdata, bname == "BRINTELLIX") -histcontrol <- filter(dataset, dose == 0, primtime == 8, indication == "MAJOR DEPRESSIVE DISORDER") - -hist_data <- data.frame( - trial = histcontrol$nctno, - est = histcontrol$rslt, - se = histcontrol$se, - sd = histcontrol$sd, - n = histcontrol$sampsize) - -sd_tot <- with(hist_data, sum(sd * n) / sum(n)) -``` -We will make use of the same getPriorList() function as in the [analysis example vignette](analysis_normal.html) to create a MAP prior. -```{r Setting Prior without execution, eval = FALSE} -dose_levels <- c(0, 2.5, 5, 10, 20) - -prior_list <- getPriorList( - hist_data = hist_data, - dose_levels = dose_levels, - robust_weight = 0.3) -``` -```{r Setting Prior, echo = FALSE} -dose_levels <- c(0, 2.5, 5, 10, 20) - -prior_list <- list( - Ctr = RBesT::mixnorm( - comp1 = c(w = 0.446213, m = -12.774661, s = 1.393130), - comp1 = c(w = 0.253787, m = 3.148116, s = 3.148116), - robust = c(w = 0.3, m = 9.425139, s = 9.425139), - sigma = sd_tot), - DG_1 = RBesT::mixnorm( - comp1 = c(w = 1, m = -12.816875, n = 1), - sigma = sd_tot, - param = "mn"), - DG_2 = RBesT::mixnorm( - comp1 = c(w = 1, m = -12.816875, n = 1), - sigma = sd_tot, - param = "mn"), - DG_3 = RBesT::mixnorm( - comp1 = c(w = 1, m = -12.816875, n = 1), - sigma = sd_tot, - param = "mn"), - DG_4 = RBesT::mixnorm( - comp1 = c(w = 1, m = -12.816875, n = 1), - sigma = sd_tot, - param = "mn") -) -``` - -# Specification of new trial design - -For the hypothetical new trial, we plan with 4 active dose levels \eqn{2.5, 5, 10, 20} and we specify a broad set of potential dose-response relationships, including a linear, an exponential, an emax and 2 sigEMax models. -Furthermore, we assume a maximum effect of -3 on top of control (i.e. assuming that active treatment can reduce the MADRS score after 8 weeks by up to 15.8) and plan a trial with 80 patients for all active groups and 60 patients for control. -```{r} -exp <- DoseFinding::guesst( - d = 5, - p = c(0.2), - model = "exponential", - Maxd = max(dose_levels)) - -emax <- DoseFinding::guesst( - d = 2.5, - p = c(0.9), - model = "emax") - -sigemax <- DoseFinding::guesst( - d = c(2.5, 5), - p = c(0.1, 0.6), - model = "sigEmax") - -sigemax2 <- DoseFinding::guesst( - d = c(2, 4), - p = c(0.3, 0.8), - model = "sigEmax") - -mods <- DoseFinding::Mods( - linear = NULL, - emax = emax, - exponential = exp, - sigEmax = rbind(sigemax, sigemax2), - doses = dose_levels, - maxEff = -3, - placEff = -12.8) - -n_patients <- c(60, 80, 80, 80, 80) -``` - -# Calculation of success probabilities - -To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. -For illustration purposes, the number of simulated trial results is reduced to 100 in this example. -```{r} -success_probabilities <- assessDesign( - n_patients = n_patients, - mods = mods, - prior_list = prior_list, - sd = sd_tot, - n_sim = 100) # speed up example run-time - -success_probabilities -``` -As an alternative, we will evaluate a design with the same overall sample size but allocating more patients on the highest dose group and control. -```{r} -success_probabilities_uneq <- assessDesign( - n_patients = c(80, 60, 60, 60, 120), - mods = mods, - prior_list = prior_list, - sd = sd_tot, - n_sim = 100) # speed up example run-time -success_probabilities_uneq -``` -For this specific trial setting the adapted allocation ratio leads to increased success probabilities under all assumed dose response relationships. - -Instead of specifying the assumed effects via the models it is also possible to directly specify the effects for the individual dose levels via the dr_means input. -This allows e.g. also the simulation of scenarios with a prior-data conflict. -```{r} -success_probabilities <- assessDesign( - n_patients = c(60, 80, 80, 80, 80), - mods = mods, - prior_list = prior_list, - sd = sd_tot, - dr_means = c(-12, -14, -15, -16, -17), - n_sim = 100) # speed up example run-time -success_probabilities -``` \ No newline at end of file diff --git a/vignettes/outdatet/analysis_normal.Rmd b/vignettes/outdatet/analysis_normal.Rmd deleted file mode 100644 index 9edb6a2..0000000 --- a/vignettes/outdatet/analysis_normal.Rmd +++ /dev/null @@ -1,286 +0,0 @@ ---- -title: "Analysis Example of Bayesian MCPMod for Continuous Data" -output: rmarkdown::html_vignette -number_sections: true -vignette: > - %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -```{r setup} -library(BayesianMCPMod) -library(clinDR) -library(dplyr) - -set.seed(7015) -``` - -# Background and data - -In this vignette we will show the use of the Bayesian MCPMod package for continuous distributed data. -The focus lies on the utilization of an informative prior and the Bayesian MCPMod evaluation of a single trial. -We will use data that is included in the clinDR package. -More specifically, trial results of BRINTELLIX will be used to illustrate the specification of an informative prior and the usage of such a prior for the Bayesian evaluation of a (hypothetical) new trial. -BRINTELLIX is a medication used to treat major depressive disorder. -Various clinical trials with different dose groups, including control groups, were conducted. - -# Calculation of a MAP prior - -In a first step, a meta analytic prior will be calculated using historical data from 4 trials with main endpoint Change from baseline in MADRS score after 8 weeks. -Please note that only information from the control group will be integrated leading to an informative mixture prior for the control group, while for the active groups a non-informative prior will be specified. -```{r Historical Data for Control Arm} -data("metaData") -dataset <- filter(as.data.frame(metaData), bname == "BRINTELLIX") -histcontrol <- filter( - dataset, - dose == 0, - primtime == 8, - indication == "MAJOR DEPRESSIVE DISORDER", - protid != 5) - -hist_data <- data.frame( - trial = histcontrol$nctno, - est = histcontrol$rslt, - se = histcontrol$se, - sd = histcontrol$sd, - n = histcontrol$sampsize) -``` -Here, we suggest a function to construct a list of prior distributions for the different dose groups. -This function is adapted to the needs of this example. -Other applications may need a different way to construct prior distributions. -```{r Defining MAP prior function} -getPriorList <- function ( - - hist_data, - dose_levels, - dose_names = NULL, - robust_weight = 0.5 - -) { - - sd_tot <- with(hist_data, sum(sd * n) / sum(n)) - - gmap <- RBesT::gMAP( - formula = cbind(est, se) ~ 1 | trial, - weights = hist_data$n, - data = hist_data, - family = gaussian, - beta.prior = cbind(0, 100 * sd_tot), - tau.dist = "HalfNormal", - tau.prior = cbind(0, sd_tot / 4)) - - prior_ctr <- RBesT::automixfit(gmap) - - if (!is.null(robust_weight)) { - - prior_ctr <- suppressMessages(RBesT::robustify( - priormix = prior_ctr, - weight = robust_weight, - sigma = sd_tot)) - - } - - prior_trt <- RBesT::mixnorm( - comp1 = c(w = 1, m = summary(prior_ctr)[1], n = 1), - sigma = sd_tot, - param = "mn") - - prior_list <- c(list(prior_ctr), - rep(x = list(prior_trt), - times = length(dose_levels[-1]))) - - if (is.null(dose_names)) { - - dose_names <- c("Ctr", paste0("DG_", seq_along(dose_levels[-1]))) - - } - - names(prior_list) <- dose_names - - return (prior_list) - -} -``` -With the dose levels to be investigated, the prior distribution can be constructed. -```{r Getting the MAP prior} -dose_levels <- c(0, 2.5, 5, 10) - -prior_list <- getPriorList( - hist_data = hist_data, - dose_levels = dose_levels, - robust_weight = 0.3) - -getESS(prior_list) -``` - -# Specifications for the new trial - -To be able to apply the Bayesian MCPMod approach, candidate models need to be specified using functions from the R package DoseFinding. -Since there are only 3 active dose levels we will limit the set of candidate models to a linear, an exponential, and an emax model. -Note that the linear candidate model does not require a guesstimate. -```{r Pre-Specification of candidate models} -exp_guesst <- DoseFinding::guesst( - d = 5, - p = c(0.2), - model = "exponential", - Maxd = max(dose_levels)) - -emax_guesst <- DoseFinding::guesst( - d = 2.5, - p = c(0.9), - model = "emax") - -mods <- DoseFinding::Mods( - linear = NULL, - emax = emax_guesst, - exponential = exp_guesst, - doses = dose_levels, - maxEff = -1, - placEff = -12.8) -``` -We will use the trial with ct.gov number NCT00735709 as exemplary new trial. -```{r new trial} -new_trial <- filter( - dataset, - primtime == 8, - indication == "MAJOR DEPRESSIVE DISORDER", - protid == 5) - -n_patients <- c(128, 124, 129, 122) -``` -# Combination of prior information and trial results -As outlined in Fleischer et al. [Bayesian MCPMod. Pharmaceutical Statistics. 2022; 21(3): 654-670.], in a first step the posterior is calculated combining the prior information with the estimated results of the new trial. Via the summary function it is possible to print out the summary information of the posterior distributions. -```{r Trial results} -posterior <- getPosterior( - prior = prior_list, - mu_hat = new_trial$rslt, - S_hat = new_trial$se, - calc_ess = TRUE) - -summary(posterior) -``` -# Execution of Bayesian MCPMod Test step - -For the execution of the testing step of Bayesian MCPMod a critical value on the probability scale will be determined for a given alpha level. -This critical value is calculated using the re-estimated contrasts for the frequentist MCPMod to ensure that, when using non-informative priors, the actual error level for falsely declaring a significant trial in the Bayesian MCPMod is controlled by the specified alpha level. - -A pseudo-optimal contrast matrix is generated based on the variability of the posterior distribution (see Fleischer et al. 2022 for more details). -```{r Preparation of input for Bayesian MCPMod Test step} -crit_pval <- getCritProb( - mods = mods, - dose_levels = dose_levels, - se_new_trial = new_trial$se, - alpha_crit_val = 0.05) - -contr_mat <- getContr( - mods = mods, - dose_levels = dose_levels, - sd_posterior = summary(posterior)[, 2]) -``` -Please note that there are different ways to derive the contrasts. -The following code shows the implementation of some of these ways but it is not executed and the contrast specification above is used. -```{r , eval = FALSE} -# i) the frequentist contrast -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - dose_weights = n_patients, - prior_list = prior_list) -# ii) re-estimated frequentist contrasts -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - se_new_trial = new_trial$se) -# iii) Bayesian approach using number of patients for new trial and prior distribution -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - dose_weights = n_patients, - prior_list = prior_list) -``` -The Bayesian MCP testing step is then executed based on the posterior information, the provided contrasts and the multiplicity adjusted critical value. -```{r Execution of Bayesian MCPMod Test step} -BMCP_result <- performBayesianMCP( - posterior_list = posterior, - contr = contr_mat, - crit_prob_adj = crit_pval) - -BMCP_result -``` -The testing step is significant indicating a non-flat dose-response shape. -In detail, all 3 models are significant and the p-value for the emax model indicates deviation from the null hypothesis the most. - -# Model fitting and visualization of results - -In the model fitting step the posterior distribution is used as basis. -Both simplified and full fitting are performed. -For the simplified fit, the multivariate normal distribution of the control group is approximated and reduced by a one-dimensional normal distribution. -The actual fit (on this approximated posterior distribution) is then performed using generalized least squares criterion. -In contrast, for the full fit, the non-linear optimization problem is addressed via the Nelder Mead algorithm. - -The output of the fit includes information about the predicted effects for the included dose levels, the generalized AIC, and the corresponding weights. -For the considered case, the simplified and the full fit are very similar. -```{r Model fitting} -# Option a) Simplified approach by using approximated posterior distribution -fit_simple <- getModelFits( - models = names(mods), - dose_levels = dose_levels, - posterior = posterior, - simple = TRUE) - -# Option b) Making use of the complete posterior distribution -fit <- getModelFits( - models = names(mods), - dose_levels = dose_levels, - posterior = posterior, - simple = FALSE) -``` -Via the predict() function, one can also receive estimates for dose levels that were not included in the trial. -```{r Predict} -predict(fit, doses = c(0, 2.5, 4, 5, 7, 10)) -``` -It is possible to plot the fitted dose response models and an AIC based average model (black lines). -```{r Plot simple vs fit} -plot(fit_simple) -plot(fit) -``` - -To assess the uncertainty, one can additionally visualize credible bands (orange shaded areas, default levels are 50% and 95%). -These credible bands are calculated with a bootstrap method as follows: -Samples from the posterior distribution are drawn and for every sample the simplified fitting step and a prediction is performed. -These predictions are then used to identify and visualize the specified quantiles. -```{r Plot with bootstrap} -plot(fit, cr_bands = TRUE) -``` - -The bootstrap based quantiles can also be directly calculated via the getBootstrapQuantiles() function. -For this example, only 6 quantiles are bootstrapped for each model fit. -```{r Bootstrap} -getBootstrapQuantiles( - model_fits = fit, - quantiles = c(0.025, 0.5, 0.975), - doses = c(0, 2.5, 4, 5, 7, 10), - n_samples = 6 -) -``` -Technical note: The median quantile of the bootstrap based procedure is not necessary similar to the main model fit, as they are derived via different procedures. -The main fit, i.e. the black lines in the plot, show the best fit of a certain model based on minimizing the residuals for the posterior distribution, while the bootstrap based 50% quantile shows the median fit of the random sampling and fitting procedure. - -# Additional note -It is also possible to perform the testing and modeling step in a combined fashion via the performBayesianMCPMod() function. -This code serves merely as an example and is not run in this vignette. -```{r, eval = FALSE} -performBayesianMCPMod( - posterior_list = posterior, - contr = contr_mat, - crit_prob_adj = crit_pval, - simple = FALSE) -``` diff --git a/vignettes/outdatet/analysis_normal_noninformative.qmd b/vignettes/outdatet/analysis_normal_noninformative.qmd deleted file mode 100644 index 06e8ecc..0000000 --- a/vignettes/outdatet/analysis_normal_noninformative.qmd +++ /dev/null @@ -1,414 +0,0 @@ ---- -title: "Analysis Example of Bayesian MCPMod for Continuous Data with non-informative prior" -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Analysis Example of Bayesian MCPMod for Continuous Data with non-informative prior} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} ---- - -```{r setup} -devtools::load_all() -#library(BayesianMCPMod) -library(RBesT) -library(clinDR) -library(dplyr) -library(tibble) -library(reactable) - -set.seed(7015) -``` - -```{r} -#| code-summary: setup -#| code-fold: true -#| message: false -#| warning: false - -#' Display Parameters Table -#' -#' This function generates a markdown table displaying the names and values of parameters -#' from a named list. -#' -#' @param named_list A named list where each name represents a parameter name and the list -#' element represents the parameter value. Date values in the list are automatically -#' converted to character strings for display purposes. -#' -#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". -#' The function does not return a value but displays the table directly to the output. -#' -#' @importFrom knitr kable -#' @examples -#' params <- list("Start Date" = as.Date("2020-01-01"), -#' "End Date" = as.Date("2020-12-31"), -#' "Threshold" = 10) -#' display_params_table(params) -#' -#' @export -display_params_table <- function(named_list) { - display_table <- data.frame() - value_names <- data.frame() - for (i in 1:length(named_list)) { - # dates will display as numeric by default, so convert to char first - if (class(named_list[[i]]) == "Date") { - named_list[[i]] = as.character(named_list[[i]]) - } - if (!is.null(names(named_list[[i]]))) { - value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) - } - values <- data.frame(I(list(named_list[[i]]))) - display_table <- rbind(display_table, values) - } - - round_numeric <- function(x, digits = 3) { - if (is.numeric(x)) { - return(round(x, digits)) - } else { - return(x) - } - } - - display_table[1] <- lapply(display_table[1], function(sublist) { - lapply(sublist, round_numeric) - }) - - class(display_table[[1]]) <- "list" - - if (nrow(value_names) == 0) { - knitr::kable( - cbind(names(named_list), display_table), - col.names = c("Name", "Value") - ) - } else { - knitr::kable( - cbind(names(named_list), value_names, display_table), - col.names = c("Name", "Value Labels", "Value") - ) - } -} -``` - -# Introduction - -This vignette demonstrates the application of the {BayesianMCPMod} package for -analyzing a phase 2 dose-finding trial using the Bayesian MCPMod approach. - -# Prior Specification - -Ideally, priors are grounded in historical data. This approach allows for the synthesis of -prior knowledge with current data, enhancing the accuracy of trial evaluations. - -The focus of this vignette is more generic, however. We specify weakly-informative -priors across all dose groups to allow the trial data to have a stronger influence on the analysis. - -```{r} -dose_levels <- c(0, 2.5, 5, 10) - -prior_list <- lapply(dose_levels, function(dose_group) { - RBesT::mixnorm(weak = c(w = 1, m = 0, s = 200), sigma = 10) -}) - -names(prior_list) <- c("Ctr", paste0("DG_", dose_levels[-1])) -``` - -# Dose-Response Model Shapes - -Candidate models are specified using the {DoseFinding} package. Models can be -parameterized using guesstimates or by directly providing distribution parameters. -Note that the linear candidate model does not require parameterization. - -[**Note:** The LinLog model is rarely used and not currently supported by `{BayesianMCPMod}`.]{.aside} - -In the code below, the models are "guesstimated" using the `DoseFinding::guesst` function. -The `d` option usually takes a single value (a dose level), and the corresponding `p` -for the maximum effect achieved at `d`. - - -```{r} -# Guesstimate estimation -exp_guesst <- DoseFinding::guesst( - model = "exponential", - d = 5, p = 0.2, Maxd = max(dose_levels) -) -emax_guesst <- DoseFinding::guesst( - model = "emax", - d = 2.5, p = 0.9 -) -sigEmax_guesst <- DoseFinding::guesst( - model = "sigEmax", - d = c(2.5, 5), p = c(0.5, 0.95) -) -logistic_guesst <- DoseFinding::guesst( - model = "logistic", - d = c(5, 10), p = c(0.1, 0.85) -) -``` - -In some cases, you need to provide more information. For instance, `sigEmax` -requires a pair of `d` and `p` values, and `exponential` requires the specification of -the maximum dose for the trial (`Maxd`). - -[See the help files for model specifications by typing `?DoseFinding::guesst` in your console]{.aside} - - - -Of course, you can also specify the models directly on the parameter scale (without using `DoseFinding::guesst`). - -For example, you can get a betaMod model by specifying `delta1` and `delta2` -parameters (`scale` is assumed to be `1.2` of the maximum dose), or a quadratic model with the `delta2` parameter. - -```{r} -betaMod_params <- c(delta1 = 1, delta2 = 1) -quadratic_params <- c(delta2 = -0.1) -``` - -Now, we can go ahead and create a `Mods` object, which will be used in the remainder -of the vignette. - -```{r} -mods <- DoseFinding::Mods( - linear = NULL, - # guesstimate scale - exponential = exp_guesst, - emax = emax_guesst, - sigEmax = sigEmax_guesst, - logistic = logistic_guesst, - # parameter scale - betaMod = betaMod_params, - quadratic = quadratic_params, - # Options for all models - doses = dose_levels, - maxEff = -1, - placEff = -12.8 -) - -plot(mods) -``` - -The `mods` object we just created above contains the full model parameters, which can be helpful for -understanding how the guesstimates are translated onto the parameter scale. - -```{r} -display_params_table(mods) -``` - -And we can see the assumed treatment effects for the specified dose groups below: - -```{r} -knitr::kable(DoseFinding::getResp(mods, doses = dose_levels)) -``` - -## Trial Data - -We will use the trial with ct.gov number NCT00735709 as our phase 2 trial data, -available in the `{clinDR}` package [@nct00735709_2024a]. - -```{r} -data("metaData") - -trial_data <- dplyr::filter( - dplyr::filter(tibble::tibble(metaData), bname == "BRINTELLIX"), - primtime == 8, - indication == "MAJOR DEPRESSIVE DISORDER", - protid == 5 -) - -n_patients <- c(128, 124, 129, 122) -``` - -# Posterior Calculation - -In the first step of Bayesian MCPMod, the posterior is calculated by combining -the prior information with the estimated results of the trial [@fleischer_2022]. - -```{r} -posterior <- getPosterior( - prior_list = prior_list, - mu_hat = trial_data$rslt, - S_hat = trial_data$se, - calc_ess = TRUE -) - -knitr::kable(summary(posterior)) -``` - -# Bayesian MCPMod Test Step - -The testing step of Bayesian MCPMod is executed using a critical value on the -probability scale and a pseudo-optimal contrast matrix. - -The critical value is calculated using (re-estimated) contrasts for frequentist -MCPMod to ensure error control when using weakly-informative priors. - -A pseudo-optimal contrast matrix is generated based on the variability of the -posterior distribution (see [@fleischer_2022] for more details). - -```{r} -crit_pval <- getCritProb( - mods = mods, - dose_levels = dose_levels, - se_new_trial = trial_data$se, - alpha_crit_val = 0.05 -) - -contr_mat <- getContr( - mods = mods, - dose_levels = dose_levels, - sd_posterior = summary(posterior)[, 2] -) -``` - -Please note that there are different ways to derive the contrasts. -The following code shows the implementation of some of these ways but it is not -executed and the contrast specification above is used. - -```{r} -#| eval: false - -# i) the frequentist contrast -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - dose_weights = n_patients, - prior_list = prior_list) -# ii) re-estimated frequentist contrasts -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - se_new_trial = trial_data$se) -# iii) Bayesian approach using number of patients for new trial and prior distribution -contr_mat_prior <- getContr( - mods = mods, - dose_levels = dose_levels, - dose_weights = n_patients, - prior_list = prior_list) -``` - -The Bayesian MCP testing step is then executed: - -```{r} -BMCP_result <- performBayesianMCP( - posterior_list = posterior, - contr = contr_mat, - crit_prob_adj = crit_pval) -``` - -Summary information: - -```{r} -BMCP_result -``` - -The testing step is significant, indicating a non-flat dose-response shape. -All models are significant, with the `emax` model indicating the greatest deviation -from the null hypothesis. - -# Model Fitting and Visualization - -In the model fitting step the posterior distribution is used as basis. - -Both simplified and full fitting are performed. - -For the simplified fit, the multivariate normal distribution of the control group -is approximated and reduced by a one-dimensional normal distribution. - -The actual fit (on this approximated posterior distribution) is then performed -using generalized least squares criterion. In contrast, for the full fit, the -non-linear optimization problem is addressed via the Nelder-Mead algorithm -[@neldermead_2024a] implemented by the `{nloptr}` package. - -The output of the fit includes information about the predicted effects for the -included dose levels, the generalized AIC, and the corresponding weights. - -For the considered case, the simplified and the full fit are very similar, so we -present the full fit. - -```{r} -# If simple = TRUE, uses approx posterior -# Here we use complete posterior distribution -fit <- getModelFits( - models = mods, - dose_levels = dose_levels, - posterior = posterior, - simple = FALSE) -``` - -Estimates for dose levels not included in the trial: - -```{r} -display_params_table(stats::predict(fit, doses = c(0, 2.5, 4, 5, 7, 10))) -``` - -Plots of fitted dose-response models and an AIC-based average model: - -```{r} -plot(fit) -``` - -To assess the uncertainty, one can additionally visualize credible bands -(orange shaded areas, default levels are 50% and 95%). - -These credible bands are calculated with a bootstrap method as follows: - -- Samples from the posterior distribution are drawn and for every sample the -simplified fitting step and a prediction is performed. - -- These predictions are then used to identify and visualize the specified quantiles. - -```{r} -plot(fit, cr_bands = TRUE) -``` - -The bootstrap based quantiles can also be directly calculated via the -`getBootstrapQuantiles()` function. - -For this example, only 6 quantiles are bootstrapped for each model fit. - -```{r} -bootstrap_quantiles <- getBootstrapQuantiles( - model_fits = fit, - quantiles = c(0.025, 0.5, 0.975), - doses = c(0, 2.5, 4, 5, 7, 10), - n_samples = 6 -) -``` - -```{r} -#| code-fold: true -reactable::reactable( - data = bootstrap_quantiles, - groupBy = "models", - columns = list( - doses = colDef(aggregate = "count", format = list(aggregated = colFormat(suffix = " doses"))), - "2.5%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))), - "50%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))), - "97.5%" = colDef(aggregate = "mean", format = list(aggregated = colFormat(prefix = "mean = ", digits = 2), cell = colFormat(digits = 4))) - ) -) -``` - -**Technical note:** The median quantile of the bootstrap based procedure is not -necessary similar to the main model fit, as they are derived via different procedures. - -The main fit (black line) minimizes residuals for the posterior distribution, -while the bootstrap median is the median fit of random sampling. - -# Additional note - -Testing and modeling can also be combined via `performBayesianMCPMod()`, -but this is not run here. - -```{r} -#| eval: false -performBayesianMCPMod( - posterior_list = posterior, - contr = contr_mat, - crit_prob_adj = crit_pval, - simple = FALSE) -``` From 72afbec95d960d4e5c363631aad88571b99d5457 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 14:30:12 +0200 Subject: [PATCH 31/39] adjusted var name S_hat --- vignettes/analysis_normal.qmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/analysis_normal.qmd b/vignettes/analysis_normal.qmd index cac8715..1ece10d 100644 --- a/vignettes/analysis_normal.qmd +++ b/vignettes/analysis_normal.qmd @@ -305,7 +305,7 @@ the prior information with the estimated results of the trial [@fleischer_2022]. posterior <- getPosterior( prior_list = prior_list, mu_hat = trial_data$rslt, - se_hat = trial_data$se, # se_hat to be updatet to s_hat in final!? + S_hat = trial_data$se, calc_ess = TRUE ) From 0551b490ba686e6c86852a3362526c5ad14cec3d Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 15:29:00 +0200 Subject: [PATCH 32/39] removed vignette calls in yml headers --- .../Comparison_vignette/Comparison_BayesianMCPMod.qmd | 7 +------ vignettes/Comparison_vignette/Comparison_MCPModPack.qmd | 7 +------ vignettes/Comparison_vignette/Comparison_convergence.qmd | 7 +------ 3 files changed, 3 insertions(+), 18 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd index a18a3d3..83f0562 100644 --- a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd +++ b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd @@ -8,11 +8,6 @@ format: self-contained: true toc: true number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} --- Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. @@ -503,4 +498,4 @@ var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c( var_nsample_Bay$kable_result -``` \ No newline at end of file +``` diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd index ae4e815..c09c418 100644 --- a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd +++ b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd @@ -8,11 +8,6 @@ format: self-contained: true toc: true number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} --- Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. @@ -1112,4 +1107,4 @@ kable(results_var_MCP_nsample)%>% add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) -``` \ No newline at end of file +``` diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 1651901..6b2a917 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -8,11 +8,6 @@ format: self-contained: true toc: true number-sections: true - #bibliography: references.bib -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} --- ### minimal BayesianMCPMod @@ -573,4 +568,4 @@ results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.ch } -``` \ No newline at end of file +``` From 4ef8066cae1192e3ef98dc48d8f9c3463b8a1253 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 15:41:57 +0200 Subject: [PATCH 33/39] minor --- vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd | 5 +++++ vignettes/Comparison_vignette/Comparison_MCPModPack.qmd | 4 ++++ vignettes/Comparison_vignette/Comparison_convergence.qmd | 5 +++++ 3 files changed, 14 insertions(+) diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd index 83f0562..c54e8eb 100644 --- a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd +++ b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd @@ -10,6 +10,11 @@ format: number-sections: true --- +```{r} +knitr::opts_chunk$set(eval = FALSE) +``` + + Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd index c09c418..1f054cd 100644 --- a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd +++ b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd @@ -10,6 +10,10 @@ format: number-sections: true --- +```{r} +knitr::opts_chunk$set(eval = FALSE) +``` + Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. ## Minimal scenario diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 6b2a917..59c3337 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -10,6 +10,11 @@ format: number-sections: true --- +```{r} +knitr::opts_chunk$set(eval = FALSE) +``` + + ### minimal BayesianMCPMod ```{r} From bf02813e0b2909b52eed1beba49749a36b82e990 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Fri, 26 Jul 2024 15:57:05 +0200 Subject: [PATCH 34/39] removed yml --- .../Comparison_BayesianMCPMod.qmd | 12 ------------ .../Comparison_vignette/Comparison_MCPModPack.qmd | 12 ------------ .../Comparison_vignette/Comparison_convergence.qmd | 12 ------------ 3 files changed, 36 deletions(-) diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd index c54e8eb..55ee286 100644 --- a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd +++ b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd @@ -1,15 +1,3 @@ ---- -title: "Vignette BayesianMCPMod - BayesianMCPMod Analysis" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true ---- - ```{r} knitr::opts_chunk$set(eval = FALSE) ``` diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd index 1f054cd..702d539 100644 --- a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd +++ b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd @@ -1,15 +1,3 @@ ---- -title: "Vignette BayesianMCPMod - MCPModPack Analysis" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true ---- - ```{r} knitr::opts_chunk$set(eval = FALSE) ``` diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd index 59c3337..393d2a6 100644 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ b/vignettes/Comparison_vignette/Comparison_convergence.qmd @@ -1,15 +1,3 @@ ---- -title: "Vignette BayesianMCPMod - convergence of power values" -subtitle: "WORK IN PROGRESS" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true ---- - ```{r} knitr::opts_chunk$set(eval = FALSE) ``` From c6d0452abc27d4513001caf0352cc5f2428d1786 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Mon, 29 Jul 2024 10:50:22 +0200 Subject: [PATCH 35/39] merged vignette into one file --- vignettes/Comparison_vignette.qmd | 3187 +++++++++++++++++ .../Comparison_BayesianMCPMod.qmd | 494 --- .../Comparison_MCPModPack.qmd | 1102 ------ .../Comparison_convergence.qmd | 564 --- .../Comparison_vignette.qmd | 1033 ------ 5 files changed, 3187 insertions(+), 3193 deletions(-) create mode 100644 vignettes/Comparison_vignette.qmd delete mode 100644 vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd delete mode 100644 vignettes/Comparison_vignette/Comparison_MCPModPack.qmd delete mode 100644 vignettes/Comparison_vignette/Comparison_convergence.qmd delete mode 100644 vignettes/Comparison_vignette/Comparison_vignette.qmd diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd new file mode 100644 index 0000000..495be07 --- /dev/null +++ b/vignettes/Comparison_vignette.qmd @@ -0,0 +1,3187 @@ +--- +title: "Vignette BayesianMCPMod" +date: today +format: + html: + fig-height: 3.5 + self-contained: true + toc: true + number-sections: true + #bibliography: references.bib + code-fold: true +vignette: > + %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{quarto::html} +editor: + markdown: + wrap: 72 +--- + +```{r} +#| code-summary: setup +#| code-fold: true +#| message: false +#| warning: false + +#' Display Parameters Table +#' +#' This function generates a markdown table displaying the names and values of parameters +#' from a named list. +#' +#' @param named_list A named list where each name represents a parameter name and the list +#' element represents the parameter value. Date values in the list are automatically +#' converted to character strings for display purposes. +#' +#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". +#' The function does not return a value but displays the table directly to the output. +#' +#' @importFrom knitr kable +#' @examples +#' params <- list("Start Date" = as.Date("2020-01-01"), +#' "End Date" = as.Date("2020-12-31"), +#' "Threshold" = 10) +#' display_params_table(params) +#' +#' @export +display_params_table <- function(named_list) { + display_table <- data.frame() + value_names <- data.frame() + for (i in 1:length(named_list)) { + # dates will display as numeric by default, so convert to char first + if (class(named_list[[i]]) == "Date") { + named_list[[i]] = as.character(named_list[[i]]) + } + if (!is.null(names(named_list[[i]]))) { + value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) + } + values <- data.frame(I(list(named_list[[i]]))) + display_table <- rbind(display_table, values) + } + + round_numeric <- function(x, digits = 3) { + if (is.numeric(x)) { + return(round(x, digits)) + } else { + return(x) + } + } + + display_table[1] <- lapply(display_table[1], function(sublist) { + lapply(sublist, round_numeric) + }) + + class(display_table[[1]]) <- "list" + + if (nrow(value_names) == 0) { + knitr::kable( + cbind(names(named_list), display_table), + col.names = c("Name", "Value") + ) + } else { + knitr::kable( + cbind(names(named_list), value_names, display_table), + col.names = c("Name", "Value Labels", "Value") + ) + } +} +# function to solve power results for tables (different max eff) BayesianMCPMod +# return(successrates models, average) +extract_success_rates <- function(results_list, models) { + success_rates <- list() + + for (i in seq_along(results_list)) { + success_rate <- c() + for (model in models) { + success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) + } + success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate")) + } + + return(success_rates) + } + +# function to solve power results for tables (different nsample) BayesianMCPMod +#models % + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + + + +print_result_Bay_nsample <- function(results, scenario, variable) { + + result_table <- t(data.table( + Bay_1 = results$Bay_1, + Bay_2 = results$Bay_2, + Bay_3 = results$Bay_3, + Bay_4 = results$Bay_4)) + + result_table <- as.data.table(result_table) + names(result_table) <- scenario + #return(result_table) + + kable_result <- kable(cbind(variable, result_table))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>% + add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) + + list(result_table = result_table, kable_result = kable_result) +} + +plot_power_deviation <- function(data, x, xlab){ + plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ + geom_point()+ + geom_line() + + scale_x_continuous(breaks = c(0, 100, 500, 1000, 2500, 5000, 10000), + labels = c("", "100", "", "1000", "2500", "5000", "10000")) + + geom_hline(aes(yintercept = 0), linetype = 2)+ + geom_hline(aes(yintercept = -0.05), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = 0.05), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = -0.1), linetype = 2, color = "darkgrey")+ + geom_hline(aes(yintercept = 0.1), linetype = 2, color = "darkgrey")+ + scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + labs(x = xlab, y = "power deviation")+ + ylim(-0.15, 0.15)+ + theme_classic() + return(plot) +} + + + + +# parallel---------------------------------------------- +chunkVector <- function (x, n_chunks) { + if (n_chunks <= 1) { + chunk_list <- list(x) + } else { + chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) + } + return(chunk_list) +} + +library(BayesianMCPMod) +library(RBesT) +library(clinDR) +library(dplyr) +library(tibble) +library(reactable) +library(DoseFinding) +library(MCPModPack) +library(kableExtra) +library(data.table) +library(doFuture) +library(doRNG) + +registerDoFuture() +plan(multisession) + + + +set.seed(7015) +``` + +# Introduction + +This vignette demonstrates the application of the {BayesianMCPMod} +package for sample size calculations and the comparison with the +{MCPModPack} package. As for other bayesian approaches BMCPMod is able +to mimic the results of the frequentist MCPMod for non-informative +priors and this is shown here for the sample size planning of different +scenarios. + +In order to test and compare BayesianMCPMod and MCPModPack sample size +calculations in different scenarios, the data used for the comparisons +will be simulated multiple times using different input values. Every +scenario will be named to make the differentiation between each scenario +simpler. Altogether, four different scenarios were simulated. The first +three scenarios are pretty similiar, they only differ in the pre-defined +set of candidate models M. The other design choices, like the number of +dose levels or sample size allocation stay the same between the +scenarios. For the first three scenarios, these design choices are: + +- four dose levels plus placebo (0 mg, 1 mg, 2 mg, 4 mg, 8 mg) + +- total sample size of N = 200 + +- equal allocation ratio for each dose group + +- expected effect for maximum dose of 0.2 mg + +- standard deviation of 0.4 for every dose group + +The fourth scenario, the variability scenario, has some different design +choices: - three dose levels plus placebo (0 mg, 1 mg, 4 mg, 8 mg) - +total sample size of N = 100 - equal allocation ratio for each dose +group - expected effect for maximum dose of 0.2 mg - standard deviation +of 0.4 for every dose group + +Building on the initial scenarios, we further delve into the exploration +of varying input parameters. The varying parameters are: + +- expected effect for maximum dose of (0.05 mg, 0.1 mg, 0.2 mg, 0.3 + mg, 0.5 mg) + +- different total sample size with different allocation: + +- (40,20,20,20,40), (30,30,30,30,30), (48,24,24,24,48), + (36,36,36,36,36) (for the first three scenarios) + +- (40,20,20,40), (30,30,30,30), (48,24,24,48), (36,36,36,36) (for the + variability scenario) + +In a subsequent step, we extend our analysis to test the convergence of +power values as the number of simulations increases. For this part of +the study, we assume an expected effect for the maximum dose of 0.2 mg. +The sample size is set to 200 for the linear, monotonic and +non-monotonic scenario and 100 for the variability scenario. This +further exploration allows us to deepen our understanding of the +BayesianMCPMod and MCPModPack packages and their performance under +varying conditions. + +For each of these simulation cases, 10000 simulation runs are performed. Given the number of simulations, the difference should be in the range of 1-3% (based on the law of large numbers). + +```{r} +####### General assumptions ######### +# simulations +n_sim <- 100 #to be upscaled to 10000 + +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) +nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") + +# define input parameters +doses.sim <- c(0,1,2,4,8) # dose levels +max.dose <- max(doses.sim) # specify max dose possibly available +plc.guess <- 0 # expected placebo effect +Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) +expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) +expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) +sd.sim <- c(0.4) + +#input paramters variability scenario +doses_var <- c(0, 1, 4, 8) +sd.sim_var <- 0.4 +Nsample_var <- c(25, 25, 25, 25) +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + + +# define model functions +emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") +exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) +logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) +sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") +quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") +beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) + +### define models to be tested in MCPMod +models <- Mods(linear=NULL, + emax = emax.g, + exponential = exp.g, + logistic=logit.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) + +alpha <- 0.05 + +# display_params_table(models) + + +# kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% +# kable_classic(full_width = TRUE)%>% +# add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) +# +# +# kable(t(data.table(placebo_guess = plc.guess, +# sd = sd.sim[1], +# alpha = alpha )))%>% +# kable_classic(full_width = TRUE) + +``` + +## Scenarios + +In the following the candidate models for the different scenarios are +plotted. + +```{r} + +#Specification of considered models for different scenarios for BayesianMCPMod + +min_scenario <- c("linear", "exponential", "emax") +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(min_models, main = "minimal Scenario") + + +monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(monotonic_models, main = "monotonic Scenario") + + +non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6) +) +plot(non_monotonic_models,main = "non monotonic Scenario") + + +variability_scenario <- c("linear","exponential", "emax") + +kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c( "Doses variability scenario" = 5), font_size = 15) + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing" +) +plot(var_models, main = "variability Scenario") + +``` + +# MCPModPack + +```{r} + +#Specification of considered models for different scenarios for MCPModPack + +min_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667) + +monotonic_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +non_monotonic_modelsPack = list(linear = NA, + emax = 0.6666667 , + sigEmax = c(1.528629, 4.087463), + quadratic = -0.09688711) +#beta + +var_modelsPack = list(linear = NA, + exponential = 4.447149, + emax = 0.6666667, + logistic = c(1.5, 0.2275598), + sigEmax = c(1.528629, 4.087463)) + +``` + +```{r, include=FALSE, eval=FALSE} +# Comparison_MCPModPack.qmd +``` + +Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. + +## Minimal scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_min <- list() + +# Run simulation +func_sim <- function(models ,sim_models, sim_parameters){ + +sim_result = MCPModSimulation(endpoint_type = "Normal", + models = models, + alpha = alpha, + direction = "increasing", + model_selection = "aveAIC", + Delta = 0.1, + sim_models = sim_models, + sim_parameters = sim_parameters) +} + + +list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + + +#store results +results_min_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_min[[1]]$sim_results$power), + exponential = c(results_list_min[[2]]$sim_results$power), + emax = c(results_list_min[[3]]$sim_results$power), + Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, + sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, + sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, + sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, + sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) + + +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +### varying sample size +```{r warning=FALSE} +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + +# store results +power_min_nsample_linear <- vector() +power_min_nsample_exp <- vector() +power_min_nsample_emax <- vector() + + + + + +# # Loop over nsample values +# for (i in seq_along(nsample_list)) { +# +# # Update nsample in simulation parameters +# sim_parameters$n <- nsample_list[[i]] +# +# # Set max_effect to 0.2 +# min_modelsPack$max_effect <- expectedEffect_fix +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) +# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) +# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) +# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power +# +# } +# Set max_effect to 0.2 +min_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) + +#ind_tasks <- 1:12 + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + +# store results +results_min_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), + Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), + Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), + Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, + sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, + sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, + sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) +) + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) + + + +``` + +## Monotonic scenario + +### varying expected effect for maximum dose +```{r warning=FALSE} +# assumed dose - response models +sim_models_monotonic_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_monotonic_emax= list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +# Simulation parameters +sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# Initialize list to store results +results_list_monotonic <- list() + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_monotonic_MCP <- data.table( + max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = c(results_list_monotonic[[1]]$sim_results$power), + exp = c(results_list_monotonic[[2]]$sim_results$power), + emax = c(results_list_monotonic[[3]]$sim_results$power), + logistic = c(results_list_monotonic[[4]]$sim_results$power), + sigEmax = c(results_list_monotonic[[5]]$sim_results$power), + Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), + (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), +(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) +) + +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assumed dose- response model with assumed maximum effect = 0.2 +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +# store results +power_monotonic_nsample_linear <- vector() +power_monotonic_nsample_exp <- vector() +power_monotonic_nsample_emax <- vector() +power_monotonic_nsample_logistic <- vector() +power_monotonic_nsample_sigemax <- vector() + + + +# Set max_effect to 0.2 +monotonic_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), + 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list[[i]], + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +# store results +results_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), + Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), + Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), + Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), + sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), +Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), + (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) + + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) + + +``` + +## Non-monotonic scenario + +### varying expected effect for maximum dose + +For the simulations of the non-monotonic scenario, the R package 'Dosefinding' was used instead of 'MCPModPack + +```{r} +# linear with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_linear <- result$linear +``` + + +```{r} +# emax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` + + +```{r} +# sigemax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` +``` + + + +```{r} +#quadratic with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` + +``` + +```{r} +# beta with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` +``` + + +```{r} +#linear, emax, sigemax, quadratic +results_non_monotonic_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = power_non_monotonic_linear, + emax = power_non_monotonic_emax, + sigEmax = power_non_monotonic_sigemax, + quadratic = power_non_monotonic_quadratic, + beta = power_non_monotonic_beta, + average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), + (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), + (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), + (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), + (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) + ) + + +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) +``` + +### varying sample size + +```{r warning=FALSE} + + +# store results +power_non_monotonic_nsample_linear <- vector() +power_non_monotonic_nsample_emax <- vector() +power_non_monotonic_nsample_quadratic <- vector() +power_non_monotonic_nsample_sigemax <- vector() +power_non_monotonic_nsample_beta <- vector() + + +``` + +```{r} +# linear with DoseFinding +# allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[2] <- result$linear[1] +power_non_monotonic_nsample_linear[4] <- result$linear[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_linear[1] <- result$linear[1] +power_non_monotonic_nsample_linear[3] <- result$linear[2] +``` + + +```{r} + +# emax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] +power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] +``` + + + +```{r} +# sigemax with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] +power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] +``` + + + + +```{r} +# quadratic with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] +power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] +``` + + + +```{r} +# beta with DoseFinding +#allocation = c(1,1,1,1,1) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] + +# allocation = c(2,1,1,1,2) +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(2,1,1,1,2) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] +power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] +``` + + +```{r} +#store results +results_non_monotonic_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = power_non_monotonic_nsample_linear, + Emax = power_non_monotonic_nsample_emax, + sigEmax = power_non_monotonic_nsample_sigemax, + quadratic = power_non_monotonic_nsample_quadratic, + beta = power_non_monotonic_nsample_beta +) + + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) + +``` + +## Variability scenario + + +### varying expected effect for maximum dose + +```{r warning=FALSE} +# assumed dose - response model +sim_models_var_linear = list(linear = NA, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_exp = list( exponential = 4.447149, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + +sim_models_var_emax = list(emax = 0.6666667, + max_effect = c(0.05,0.1,0.2,0.3,0.5), + sd = rep(sd.sim_var, length(doses_var)), + placebo_effect = plc.guess) + + + +# Simulation parameters +sim_parameters_var = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + +# perform Simulations + +list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) + + }) + +} + + +# store results +results_var_MCP <- data.table( + Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), + linear = results_list_var[[1]]$sim_results$power, + exponential = results_list_var[[2]]$sim_results$power, + emax = results_list_var[[3]]$sim_results$power, + average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), + (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), + (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), + (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), + (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) +) + +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + + +``` + +### varying sample size +```{r warning=FALSE} +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + + +# store results +power_var_nsample_linear <- vector() +power_var_nsample_exp <- vector() +power_var_nsample_emax <- vector() + +# # Loop over nsample values +# for (i in seq_along(nsample_list_var)) { +# +# # Update nsample in simulation parameters +# sim_parameters_var$n <- nsample_list_var[[i]] +# +# +# # power values for different assumed true models +# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) +# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power +# +# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) +# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power +# +# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) +# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power +# +# +# } + +var_modelsPack$max_effect <- expectedEffect_fix +#list of different samole sizes +nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), + 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) + + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { + lapply(k, function (i) { + sim_parameters = list(n = nsample_list_var[[i]], + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim) + + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +results_var_MCP_nsample <- data.table( + N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), + Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), + Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), + Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), + Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), + (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), + (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), + (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) +) + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +``` + + +# BayesianMCPMod + +```{r, include=FALSE, eval=FALSE} +# Comparison_BayesianMCPMod.qmd +``` + + +Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. + + +# Prior Specification +In a first step an uninformativ prior is calculated. + +```{r} +uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), + DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") + +) +``` + +To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. + +## Minimal scnenario +### varying expected effect for maximum dose + + +```{r} + +# list to store results +results_list_Bay_min <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + #optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) + +minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) + +minimal_Bay$kable_result + + + +``` +### varying sample size + + +```{r} +# Define the list of sample sizes +nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + +# Initialize list to store results +results_list_nsample_min_Bay <- list() + +#Models with maxEff = 0.2 +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_min <- assessDesign( + n_patients = nsample_list[[i]], + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) + +minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) +minimal_nsample_Bay$kable_result + + + +``` + + + +## Monotonic scenario + +### varying expected effect for maximum dose + +```{r} +results_list_Bay_monotonic <- list() + + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + # optimal contrasts + contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + # perform Simulations + success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + + }) + +} + + +##power results in vector for tables +results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) + + +monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) + + +monotonic_Bay$kable_result + + + +``` + +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_monotonic_Bay <- list() + +# dose - response models +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +#allocation c(1,1,1,1,1) +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +#allocation c(2,1,1,1,2) +contM_2 <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) + + +monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) +monotonic_nsample_Bay$kable_result + + +``` + + +## Non-monotonic scenario +### varying expected effect for maximum dose +```{r} +results_list_Bay_non_monotonic <- list() + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + + non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts + contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + + success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + + }) + +} + +results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) + +non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) + +non_monotonic_Bay$kable_result + + +``` +### varying sample size +```{r} +# Initialize list to store results +results_list_nsample_non_monotonic_Bay <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +contM_2 <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(2,1,1,1,2)) + +contrasts_list = list(contM_2, contM, contM_2, contM) + + + +chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) + +results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + + success_probabilities_non_monotonic <- assessDesign( + n_patients = nsample_list[[i]], + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + }) +} + + +results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) + + +non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) +non_monotonic_nsample_Bay$kable_result + + +``` + + +## Variability scenario +### varying expected effect for maximum dose +```{r} + +# prior +var_uninf_prior_list <- list( + Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), + DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) + +results_list_Bay_var <- list() + + + +list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) +chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) + + + +results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { + + lapply(k, function (i) { + + var_models <- Mods(linear = NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = list_max_eff[[i]], + direction = "increasing") + + contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + + success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + +results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) + +variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) + +variability_Bay$kable_result + + +``` +### varying sample size +```{r} +results_list_nsample_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +contM_2 <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(2,1,1,2)) +contrasts_list = list(contM_2, contM, contM_2, contM) + + +nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) + +chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) + +results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { + + lapply(k, function (i) { + success_probabilities_var <- assessDesign( + n_patients = nsample_list_var[[i]], + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim, + alpha_crit_val = alpha, + contr = contrasts_list[[i]]) + + }) +} + + +results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) + + +var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) +var_nsample_Bay$kable_result + + +``` + +# Comparison + +In the following, we will draw comparisons between the power values of various scenarios and differnt parameters. + +The following plots show the difference between the results with MCPModPack and BayesianMCPMod. The results with MCPModPack are shown as a line and the difference to the result with BayesianMCPMod is shown as a bar. The dose-response model assumed to be true during the analysis is shown as a different colour. + +## varying expected effect for maximum dose + +### minimal scenario + +```{r} + +#table with results +kable(results_min_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 5), font_size = 15, bold = TRUE) + +minimal_Bay$kable_result + + +data_plot_eff_min <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_min_MCP$linear, + end_linear = minimal_Bay$result_table$linear, + start_exp = results_min_MCP$exponential, + end_exp = minimal_Bay$result_table$exponential, + start_emax = results_min_MCP$emax, + end_emax = minimal_Bay$result_table$emax +) + + + + +# Create the plot +ggplot(data = data_plot_eff_min, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_min$max_eff_num, labels = data_plot_eff_min$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values different expected effect for maximum dose") + + geom_vline(xintercept = data_plot_eff_min$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + + +``` + + +### monotonic scenario + +```{r} + +#table with results +kable(results_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack " = 7), font_size = 15, bold = TRUE) + +monotonic_Bay$kable_result + + +data_plot_eff_monotonic <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_monotonic_MCP$linear, + end_linear = monotonic_Bay$result_table$linear, + start_exp = results_monotonic_MCP$exp, + end_exp = monotonic_Bay$result_table$exponential, + start_emax = results_monotonic_MCP$emax, + end_emax = monotonic_Bay$result_table$emax, + start_logistic = results_monotonic_MCP$logistic, + end_logistic = monotonic_Bay$result_table$logistic, + start_sigemax = results_monotonic_MCP$sigEmax, + end_sigemax = monotonic_Bay$result_table$sigEmax +) + + +# Create the plot +ggplot(data = data_plot_eff_monotonic, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num- 0.25, xend = max_eff_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_monotonic$max_eff_num, labels = data_plot_eff_monotonic$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + +``` + +### non - monotonic scenario + +```{r} + +# table results +kable(results_non_monotonic_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +non_monotonic_Bay$kable_result + + +data_plot_eff_non_monotonic <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_non_monotonic_MCP$linear, + end_linear = non_monotonic_Bay$result_table$linear, + start_emax = results_non_monotonic_MCP$emax, + end_emax = non_monotonic_Bay$result_table$emax, + start_sigemax = results_non_monotonic_MCP$sigEmax, + end_sigemax =non_monotonic_Bay$result_table$sigEmax, + start_quadratic = results_non_monotonic_MCP$quadratic, + end_quadratic = non_monotonic_Bay$result_table$quadratic, + start_beta = results_non_monotonic_MCP$beta, + end_beta = non_monotonic_Bay$result_table$betaMod +) + + +# Create the plot +ggplot(data = data_plot_eff_non_monotonic, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + + geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + + geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + + geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + + scale_x_continuous(breaks = data_plot_eff_non_monotonic$max_eff_num, labels = data_plot_eff_non_monotonic$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 2))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values for different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_non_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) +``` + +### variability scenario + +```{r} + +#table with results +kable(results_var_MCP)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +variability_Bay$kable_result + +data_plot_eff_var <- data.frame( + max_eff = expectedEffect, + max_eff_num = c(1, 2, 3, 4, 5), + start_linear = results_var_MCP$linear, + end_linear = variability_Bay$result_table$linear, + start_exp = results_var_MCP$exponential, + end_exp = variability_Bay$result_table$exponential, + start_emax = results_var_MCP$emax, + end_emax = variability_Bay$result_table$emax +) + + +# Create the plot +ggplot(data = data_plot_eff_var, aes(x = max_eff_num)) + + geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_eff_var$max_eff_num, labels = data_plot_eff_var$max_eff) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + xlab("expected effect for maximum dose")+ + ggtitle("Power values for different expected effect for maximum dose")+ + geom_vline(xintercept = data_plot_eff_var$max_eff_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) +``` + +## varying sample size + +```{r} +nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) +``` + +### minimal scenario + +```{r} + +kable(results_min_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) + +minimal_nsample_Bay$kable_result + + + + +data_plot_nsample_min <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = results_min_MCP_nsample$Linear, + end_linear = minimal_nsample_Bay$result_table$linear, + start_exp = results_min_MCP_nsample$Exponential, + end_exp = minimal_nsample_Bay$result_table$exponential, + start_emax = results_min_MCP_nsample$Emax, + end_emax = minimal_nsample_Bay$result_table$emax +) + + + + +# Create the plot +ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes") + + geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + + + + +``` + +### monotonic scenario + +```{r} + +kable(results_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) + +monotonic_nsample_Bay$kable_result + +data_plot_nsample_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = results_monotonic_MCP_nsample$Linear, + end_linear = monotonic_nsample_Bay$result_table$linear, + start_exp = results_monotonic_MCP_nsample$Exponential, + end_exp = monotonic_nsample_Bay$result_table$exponential, + start_emax = results_monotonic_MCP_nsample$Emax, + end_emax = monotonic_nsample_Bay$result_table$emax, + start_logistic = results_monotonic_MCP_nsample$Logistic, + end_logistic = monotonic_nsample_Bay$result_table$logistic, + start_sigemax = results_monotonic_MCP_nsample$sigEmax, + end_sigemax = monotonic_nsample_Bay$result_table$sigEmax +) + + +# Create the plot +ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + + +``` + +### non-monotonic scenario + +```{r} + +kable(results_non_monotonic_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% + add_header_above(c("MCPModPack" = 6), font_size = 15, bold = TRUE) + +non_monotonic_nsample_Bay$kable_result + +data_plot_nsample_non_monotonic <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = results_non_monotonic_MCP_nsample$Linear, + end_linear = non_monotonic_nsample_Bay$result_table$linear, + start_emax = results_non_monotonic_MCP_nsample$Emax, + end_emax = non_monotonic_nsample_Bay$result_table$emax, + start_sigemax = results_non_monotonic_MCP_nsample$sigEmax, + end_sigemax =non_monotonic_nsample_Bay$result_table$sigEmax, + start_quadratic = results_non_monotonic_MCP_nsample$quadratic, + end_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, + start_beta = results_non_monotonic_MCP_nsample$beta, + end_beta = non_monotonic_nsample_Bay$result_table$betaMod +) + + +# Create the plot +ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + + geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + + geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + + geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + + scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_non_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + + + +``` + +### variability sceanrio + +```{r} + +kable(results_var_MCP_nsample)%>% + kable_classic(full_width = TRUE)%>% + add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% + add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) + +var_nsample_Bay$kable_result + + +data_plot_nsample_var <- data.frame( + sample_sizes = nsample_vector, + sample_sizes_num = c(1, 2, 3, 4), + start_linear = results_var_MCP_nsample$Linear, + end_linear = var_nsample_Bay$result_table$linear, + start_exp = results_var_MCP_nsample$Exponential, + end_exp = var_nsample_Bay$result_table$exponential, + start_emax = results_var_MCP_nsample$Emax, + end_emax = var_nsample_Bay$result_table$emax +) + + +# Create the plot +ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + + geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + + geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + + geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + + scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + + scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ + scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ + theme_minimal() + + ylab("Power") + + ylim(c(0.25,1))+ + xlab("sample sizes")+ + ggtitle("Power values different sample sizes")+ + geom_vline(xintercept = data_plot_nsample_var$sample_sizes_num + 0.5, linetype="dashed", color = "black") + + theme(legend.position = "bottom") + + guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) + + +``` + +## convergence of power values + +In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000, 10000. + +```{r, include=FALSE, eval=FALSE} +# Comparison_convergence.qmd +``` + + +### minimal BayesianMCPMod +```{r} + + +# Define a vector of different n_sim values +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) +n_sim_values <- c(10, 50, 100, 250, 500, 1000) #c(100, 500, 1000, 2500, 5000, 10000) + +# Initialize a list to store the results +results_list_nsim_Bay <- list() + +min_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") +#optimal contrasts +contM <- getContr(mods = min_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_min <- assessDesign( + n_patients = Nsample, + mods = min_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + +results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) + + +``` + +### minimal MCPModPack +```{r warning=FALSE} + + +# assumed dose - response model +sim_models_min_linear = list(linear = NA, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_exp = list(exponential = 4.447149, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + +sim_models_min_emax = list( emax = 0.6666667, + max_effect = expectedEffect_fix, + sd = rep(sd.sim, length(doses.sim)), + placebo_effect = plc.guess) + + + + +list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, + sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, + sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) +#as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(min_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + + +``` + + + +### monotonic BayesianMCPMod +```{r} + + +# Initialize a list to store the results + results_list_nsim_Bay_monotonic <- list() + +monotonic_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + logistic=logit.g, + sigEmax = sigEmax.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +#optimal contrasts +contM <- getContr(mods = monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_monotonic <- assessDesign( + n_patients = Nsample, + mods = monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) + +``` + +### monotonic MCPModPack + +```{r warning=FALSE} + + +sim_models_monotonic_linear$max_effect <- expectedEffect_fix +sim_models_monotonic_exp$max_effect <- expectedEffect_fix +sim_models_monotonic_emax$max_effect <- expectedEffect_fix +sim_models_monotonic_logistic$max_effect <- expectedEffect_fix +sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix + +list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, + sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, + sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, + sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, + sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax + ) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) + + #as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample, + doses = doses.sim, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + +### non-monotonic BayesianMCPMod + +```{r} + + +# Initialize list to store results +results_list_nsim_Bay_non_monotonic <- list() + +non_monotonic_models <- Mods(linear=NULL, + emax = emax.g, + sigEmax = sigEmax.g, + quadratic = quad.g, + betaMod = beta.g, + doses = doses.sim, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing", + addArgs = list(scal=9.6)) + + #optimal contrasts +contM <- getContr(mods = non_monotonic_models, + dose_levels = doses.sim, + prior_list = uninf_prior_list, + dose_weights = c(1,1,1,1,1)) + +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_non_monotonic <- assessDesign( + n_patients = Nsample, + mods = non_monotonic_models, + prior_list = uninf_prior_list, + sd = sd.sim, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) +``` + +### non-monotonic MCPModPack + + +```{r} +# linear with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(linear = NULL) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_linear <- result$linear + + +``` + +```{r} +# emax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(emax = 0.6666667) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_emax <- result$`emax (ED50=0.6666667)` +``` + + +```{r} +# sigemax with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` + +``` +```{r} +#quadratic with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(quadratic = -0.09688711) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) + +results_nsim_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` + +``` + +```{r} +# beta with DoseFinding package +mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) +doses <- c(0,1,2,4,8) +allocation <- c(1,1,1,1,1) +alpha <- 0.05 +addArgs <- list(off = 0.08, scal = 9.6) + +resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) +cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) +mods <- do.call(Mods, append(cand_mod_list, + list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) +cont_mat <- optContr(mods, w = allocation) + +grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) +power_list <- vector("list", nrow(grd)) +dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) +colnames(dat_n) <- paste0("D", doses) +for (i in 1:nrow(grd)) { + ###### + mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, + placEff = 0, addArgs = addArgs))) + n <- dat_n[i, ] + power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) +} +power_df <- as.data.frame(do.call("rbind", power_list)) +mu <- getResp(mods) +parList <- attr(mu, 'parList') +mod_nams <- DoseFinding:::getModNams(parList) +colnames(power_df) <- mod_nams +power_df[['mean power']] <- apply(power_df, 1, mean) +result <- cbind(grd, power_df, dat_n) +results_nsim_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` + +``` +```{r} +results_nsim_MCP_non_monotonic <- data.table( + linear = results_nsim_non_monotonic_linear, + emax = results_nsim_non_monotonic_emax, + sigemax = results_nsim_non_monotonic_sigemax, + quadratic = results_nsim_non_monotonic_quadratic, + beta = results_nsim_non_monotonic_beta +) +``` + + + + +### variability BayesianMCPMod +```{r} + + +# Initialize list to store results +results_list_nsim_Bay_var <- list() + +var_models <- Mods(linear=NULL, + exponential = exp.g, + emax = emax.g, + doses = doses_var, + placEff = plc.guess, + maxEff = expectedEffect_fix, + direction = "increasing") + +contM <- getContr(mods = var_models, + dose_levels = doses_var, + prior_list = var_uninf_prior_list, + dose_weights = c(1,1,1,1)) + +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) + + +results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { + + lapply(k, function (i) { + + + # Simulation step + success_probabilities_var <- assessDesign( + n_patients = Nsample_var, + mods = var_models, + prior_list = var_uninf_prior_list, + sd = sd.sim_var, + n_sim = n_sim_values_list[[i]], + alpha_crit_val = alpha, + contr = contM) + + }) + +} + + + +results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) +``` + + +### variability MCPModPack +```{r, warning=FALSE} + + +results_list_nsim_MCP_var = list( + power_var_nsim_linear = vector(), + power_var_nsim_exp = vector(), + power_var_nsim_emax= vector()) + +# assume maximum effect = 0.2 +sim_models_var_linear$max_effect <- expectedEffect_fix +sim_models_var_exp$max_effect <- expectedEffect_fix +sim_models_var_emax$max_effect <- expectedEffect_fix + +sim_parameters_var$n <- Nsample_var + + +list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, + sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, + sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) +n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000, + 10, 50, 100, 250, 500, 1000)) + +# as.list(c(100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000, + # 100, 500, 1000, 2500, 5000, 10000)) + +chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) + +results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { + + lapply(k, function (i) { + # Simulation parameters + sim_parameters = list(n = Nsample_var, + doses = doses_var, + dropout_rate = 0.0, + go_threshold = 0.1, + nsims = n_sim_values_list[[i]]) + + func_sim(var_modelsPack, list_models[[i]], sim_parameters) + + }) + +} + + +``` + + +## Results + +The following plots show the result of the convergence test of the power values for an increasing number of simulations. The difference between the power values of the frequency and Bayesian simulations is shown. +In the non-monotonous scenario, the DoseFinding package was used instead of the MCPModPack. This package does not simulate but accurately calculates the values. The difference between the Bayesian results and the true value of the DoseFinding calculation is also shown. + +### minimal scenario + + +```{r} +#safe results in data.table for plot +results_nsim <- data.table( + MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power, results_list_nsim_MCP[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power, results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power, results_list_nsim_MCP[[16]]$sim_results$power, results_list_nsim_MCP[[17]]$sim_results$power, results_list_nsim_MCP[[18]]$sim_results$power), + Bay_linear = results_nsim_Bay$Bay_linear, + Bay_exp = results_nsim_Bay$Bay_exponential, + Bay_emax = results_nsim_Bay$Bay_emax) + +results_nsim_diff <- data.table( + linear = results_nsim$Bay_linear - results_nsim$MCP_linear, + exponential = results_nsim$Bay_exp - results_nsim$MCP_exp, + emax = results_nsim$Bay_emax - results_nsim$MCP_emax, + n_sim = n_sim_values +) + +results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") + +plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim") +plot_nsim +``` + +### monotonic scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_monotonic <- data.table( + MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power, results_list_nsim_MCP_monotonic[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power, results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power, results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power), + MCP_logistic = c(results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power, results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power), + MCP_sigemax = c(results_list_nsim_MCP_monotonic[[25]]$sim_results$power, results_list_nsim_MCP_monotonic[[26]]$sim_results$power, results_list_nsim_MCP_monotonic[[27]]$sim_results$power, results_list_nsim_MCP_monotonic[[28]]$sim_results$power, results_list_nsim_MCP_monotonic[[29]]$sim_results$power, results_list_nsim_MCP_monotonic[[30]]$sim_results$power), + Bay_linear = results_nsim_Bay_monotonic$Bay_linear, + Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_logistic = results_nsim_Bay_monotonic$Bay_logistic, + Bay_sigemax = results_nsim_Bay_monotonic$Bay_sigEmax) + +results_nsim_diff_monotonic <- data.table( + linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, + exponential = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, + emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, + logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, + sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, + n_sim = n_sim_values +) + +results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") + +plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim") +plot_nsim_monotonic +``` + +### non - monotonic scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_non_monotonic <- data.table( + MCP_linear = replicate(6,results_nsim_MCP_non_monotonic$linear), + MCP_emax = replicate(6,results_nsim_MCP_non_monotonic$emax), + MCP_sigemax = replicate(6,results_nsim_MCP_non_monotonic$sigemax), + MCP_quadratic = replicate(6,results_nsim_MCP_non_monotonic$quadratic), + MCP_beta = replicate(6,results_nsim_MCP_non_monotonic$beta), + Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, + Bay_emax = results_nsim_Bay_monotonic$Bay_emax, + Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, + Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic, + Bay_beta = results_nsim_Bay_non_monotonic$Bay_betaMod) + +results_nsim_diff_non_monotonic <- data.table( + linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, + emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, + sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, + quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, + beta = results_nsim_non_monotonic$Bay_beta - results_nsim_non_monotonic$MCP_beta, + n_sim = n_sim_values +) + + +results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") + +plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim") +plot_nsim_non_monotonic + +``` + +### variability scenario + + + +```{r} +#safe results in data.table for plot +results_nsim_var <- data.table( + MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power, results_list_nsim_MCP_var[[6]]$sim_results$power), + MCP_exp = c(results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power, results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power), + MCP_emax = c(results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power, results_list_nsim_MCP_var[[16]]$sim_results$power, results_list_nsim_MCP_var[[17]]$sim_results$power, results_list_nsim_MCP_var[[18]]$sim_results$power), + Bay_linear = results_nsim_Bay_var$Bay_linear, + Bay_exp = results_nsim_Bay_var$Bay_exponential, + Bay_emax = results_nsim_Bay_var$Bay_emax +) + +results_nsim_diff_var <- data.table( + linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, + exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, + emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, + n_sim = n_sim_values + ) + +results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") + +plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim") +plot_nsim_var +``` + +```{r} +# save( results_min_MCP, minimal_Bay, results_monotonic_MCP, monotonic_Bay, results_non_monotonic_MCP, non_monotonic_Bay, results_var_MCP, variability_Bay, +# results_min_MCP_nsample, minimal_nsample_Bay, results_monotonic_MCP_nsample, monotonic_nsample_Bay, results_non_monotonic_MCP_nsample, non_monotonic_nsample_Bay, results_var_MCP_nsample, +# var_nsample_Bay, results_list_nsim_MCP, results_nsim_Bay, results_list_nsim_MCP_monotonic, results_nsim_Bay_monotonic, results_nsim_MCP_non_monotonic, results_nsim_Bay_non_monotonic, results_list_nsim_MCP_var, results_nsim_Bay_var +# file = "simulation_data.RData") +``` diff --git a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd b/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd deleted file mode 100644 index 55ee286..0000000 --- a/vignettes/Comparison_vignette/Comparison_BayesianMCPMod.qmd +++ /dev/null @@ -1,494 +0,0 @@ -```{r} -knitr::opts_chunk$set(eval = FALSE) -``` - - -Following simulations will be conducted utilizing the BayesianMCPMod' package, with varying the expected effect for maximum dose and the sample sizes. - - -# Prior Specification -In a first step an uninformativ prior is calculated. - -```{r} -uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn"), - DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim, param = "mn") - -) -``` - -To calculate success probabilities for the different assumed dose-response models and the specified trial design we will apply the assessDesign function. - -## Minimal scnenario -### varying expected effect for maximum dose - - -```{r} - -# list to store results -results_list_Bay_min <- list() - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - #optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_min_Bay <- extract_success_rates(results_list_Bay_min, min_scenario) - -minimal_Bay <- print_result_Bay_max_eff(results_min_Bay, c(min_scenario, "average"), expectedEffect) - -minimal_Bay$kable_result - - - -``` -### varying sample size - - -```{r} -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - -# Initialize list to store results -results_list_nsample_min_Bay <- list() - -#Models with maxEff = 0.2 -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_min_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_min <- assessDesign( - n_patients = nsample_list[[i]], - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - - -results_min_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_min_Bay, min_scenario) - -minimal_nsample_Bay <- print_result_Bay_nsample(results_min_Bay_nsample, c(min_scenario, "average"), nsample_vector) -minimal_nsample_Bay$kable_result - - - -``` - - - -## Monotonic scenario - -### varying expected effect for maximum dose - -```{r} -results_list_Bay_monotonic <- list() - - - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - - # optimal contrasts - contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - # perform Simulations - success_probabilities_monotonic <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - - - }) - -} - - -##power results in vector for tables -results_monotonic_Bay <- extract_success_rates(results_list_Bay_monotonic, monotonic_scenario) - - -monotonic_Bay <- print_result_Bay_max_eff(results_monotonic_Bay, c(monotonic_scenario, "average"), expectedEffect) - - -monotonic_Bay$kable_result - - - -``` - -### varying sample size -```{r} -# Initialize list to store results -results_list_nsample_monotonic_Bay <- list() - -# dose - response models -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -#allocation c(1,1,1,1,1) -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -#allocation c(2,1,1,1,2) -contM_2 <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) -} - - -results_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_monotonic_Bay, monotonic_scenario) - - -monotonic_nsample_Bay <- print_result_Bay_nsample(results_monotonic_Bay_nsample, c(monotonic_scenario, "average"), nsample_vector) -monotonic_nsample_Bay$kable_result - - -``` - - -## Non-monotonic scenario -### varying expected effect for maximum dose -```{r} -results_list_Bay_non_monotonic <- list() - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_non_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - - non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts - contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - - success_probabilities_non_monotonic <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - - }) - -} - -results_non_monotonic_Bay <- extract_success_rates(results_list_Bay_non_monotonic, non_monotonic_scenario) - -non_monotonic_Bay <- print_result_Bay_max_eff(results_non_monotonic_Bay, c(non_monotonic_scenario, "average"), expectedEffect) - -non_monotonic_Bay$kable_result - - -``` -### varying sample size -```{r} -# Initialize list to store results -results_list_nsample_non_monotonic_Bay <- list() - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -contM_2 <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(2,1,1,1,2)) - -contrasts_list = list(contM_2, contM, contM_2, contM) - - - -chunks <- chunkVector(seq_along(nsample_list), getDoParWorkers()) - -results_list_nsample_non_monotonic_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - - success_probabilities_non_monotonic <- assessDesign( - n_patients = nsample_list[[i]], - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - }) -} - - -results_non_monotonic_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_non_monotonic_Bay, non_monotonic_scenario) - - -non_monotonic_nsample_Bay <- print_result_Bay_nsample(results_non_monotonic_Bay_nsample, c(non_monotonic_scenario, "average"), nsample_vector) -non_monotonic_nsample_Bay$kable_result - - -``` - - -## Variability scenario -### varying expected effect for maximum dose -```{r} - -# prior -var_uninf_prior_list <- list( - Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn"), - DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 0, n = 1), sigma = sd.sim_var, param = "mn")) - -results_list_Bay_var <- list() - - - -list_max_eff <- as.list(c(0.05,0.1,0.2,0.3,0.5)) -chunks <- chunkVector(seq_along(list_max_eff), getDoParWorkers()) - - - -results_list_Bay_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - var_models <- Mods(linear = NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = list_max_eff[[i]], - direction = "increasing") - - contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - - success_probabilities_var <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - -results_variability_Bay <- extract_success_rates(results_list_Bay_var, variability_scenario) - -variability_Bay <- print_result_Bay_max_eff(results_variability_Bay, c(variability_scenario, "average"), expectedEffect) - -variability_Bay$kable_result - - -``` -### varying sample size -```{r} -results_list_nsample_Bay_var <- list() - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -contM_2 <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(2,1,1,2)) -contrasts_list = list(contM_2, contM, contM_2, contM) - - -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - -chunks <- chunkVector(seq_along(nsample_list_var), getDoParWorkers()) - -results_list_nsample_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contrasts_list))) %dorng% { - - lapply(k, function (i) { - success_probabilities_var <- assessDesign( - n_patients = nsample_list_var[[i]], - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim, - alpha_crit_val = alpha, - contr = contrasts_list[[i]]) - - }) -} - - -results_variability_Bay_nsample <- extract_success_rates_nsample(results_list_nsample_Bay_var, variability_scenario) - - -var_nsample_Bay <- print_result_Bay_nsample(results_variability_Bay_nsample, c(variability_scenario, "average"), as.vector(nsample_list_var)) -var_nsample_Bay$kable_result - - -``` diff --git a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd b/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd deleted file mode 100644 index 702d539..0000000 --- a/vignettes/Comparison_vignette/Comparison_MCPModPack.qmd +++ /dev/null @@ -1,1102 +0,0 @@ -```{r} -knitr::opts_chunk$set(eval = FALSE) -``` - -Following simulations will be conducted utilizing the MCPModPack package, with varying the expected effect for maximum dose and the sample sizes. - -## Minimal scenario - -### varying expected effect for maximum dose -```{r warning=FALSE} -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_min <- list() - -# Run simulation -func_sim <- function(models ,sim_models, sim_parameters){ - -sim_result = MCPModSimulation(endpoint_type = "Normal", - models = models, - alpha = alpha, - direction = "increasing", - model_selection = "aveAIC", - Delta = 0.1, - sim_models = sim_models, - sim_parameters = sim_parameters) -} - - -list_models <- list(sim_models_min_linear, sim_models_min_exp, sim_models_min_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - - - -#store results -results_min_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_min[[1]]$sim_results$power), - exponential = c(results_list_min[[2]]$sim_results$power), - emax = c(results_list_min[[3]]$sim_results$power), - Average = c(sum(results_list_min[[1]]$sim_results$power[1], results_list_min[[2]]$sim_results$power[1], results_list_min[[3]]$sim_results$power[1])/3, - sum(results_list_min[[1]]$sim_results$power[2], results_list_min[[2]]$sim_results$power[2], results_list_min[[3]]$sim_results$power[2])/3, - sum(results_list_min[[1]]$sim_results$power[3], results_list_min[[2]]$sim_results$power[3], results_list_min[[3]]$sim_results$power[3])/3, - sum(results_list_min[[1]]$sim_results$power[4], results_list_min[[2]]$sim_results$power[4], results_list_min[[3]]$sim_results$power[4])/3, - sum(results_list_min[[1]]$sim_results$power[5], results_list_min[[2]]$sim_results$power[5], results_list_min[[3]]$sim_results$power[5])/3)) - - -kable(results_min_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -### varying sample size -```{r warning=FALSE} -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - -# store results -power_min_nsample_linear <- vector() -power_min_nsample_exp <- vector() -power_min_nsample_emax <- vector() - - - - - -# # Loop over nsample values -# for (i in seq_along(nsample_list)) { -# -# # Update nsample in simulation parameters -# sim_parameters$n <- nsample_list[[i]] -# -# # Set max_effect to 0.2 -# min_modelsPack$max_effect <- expectedEffect_fix -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(min_modelsPack, sim_models_min_linear, sim_parameters) -# power_min_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(min_modelsPack, sim_models_min_exp, sim_parameters) -# power_min_nsample_exp[i] <-power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(min_modelsPack, sim_models_min_emax, sim_parameters) -# power_min_nsample_emax[i] <- power_nsample_exp$sim_results$power -# -# } -# Set max_effect to 0.2 -min_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_min_linear,sim_models_min_linear,sim_models_min_linear,sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp,sim_models_min_exp,sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) - -#ind_tasks <- 1:12 - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_min_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - -# store results -results_min_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[4]]$sim_results$power), - Exponential = c(results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power), - Emax = c(results_list_min_nsample[[9]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power), - Average = c(sum(results_list_min_nsample[[1]]$sim_results$power, results_list_min_nsample[[5]]$sim_results$power, results_list_min_nsample[[9]]$sim_results$power)/3, - sum(results_list_min_nsample[[2]]$sim_results$power, results_list_min_nsample[[6]]$sim_results$power, results_list_min_nsample[[10]]$sim_results$power)/3, - sum(results_list_min_nsample[[3]]$sim_results$power, results_list_min_nsample[[7]]$sim_results$power, results_list_min_nsample[[11]]$sim_results$power)/3, - sum(results_list_min_nsample[[4]]$sim_results$power, results_list_min_nsample[[8]]$sim_results$power, results_list_min_nsample[[12]]$sim_results$power)/3) -) - -kable(results_min_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Minimal scenario " = 5), font_size = 15, bold = TRUE) - - - -``` - -## Monotonic scenario - -### varying expected effect for maximum dose -```{r warning=FALSE} -# assumed dose - response models -sim_models_monotonic_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_logistic = list(logistic = c(1.5, 0.2275598), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_sigemax= list(sigemax = c(1.528629, 4.087463), - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_monotonic_emax= list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -# Simulation parameters -sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# Initialize list to store results -results_list_monotonic <- list() - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_exp, sim_models_monotonic_emax, sim_models_monotonic_logistic, sim_models_monotonic_sigemax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_monotonic_MCP <- data.table( - max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = c(results_list_monotonic[[1]]$sim_results$power), - exp = c(results_list_monotonic[[2]]$sim_results$power), - emax = c(results_list_monotonic[[3]]$sim_results$power), - logistic = c(results_list_monotonic[[4]]$sim_results$power), - sigEmax = c(results_list_monotonic[[5]]$sim_results$power), - Average = c((sum(results_list_monotonic[[1]]$sim_results$power[1], results_list_monotonic[[2]]$sim_results$power[1], results_list_monotonic[[3]]$sim_results$power[1], results_list_monotonic[[4]]$sim_results$power[1], results_list_monotonic[[5]]$sim_results$power[1])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[2], results_list_monotonic[[2]]$sim_results$power[2], results_list_monotonic[[3]]$sim_results$power[2], results_list_monotonic[[4]]$sim_results$power[2], results_list_monotonic[[5]]$sim_results$power[2])/5), - (sum(results_list_monotonic[[1]]$sim_results$power[3], results_list_monotonic[[2]]$sim_results$power[3], results_list_monotonic[[3]]$sim_results$power[3], results_list_monotonic[[4]]$sim_results$power[3], results_list_monotonic[[5]]$sim_results$power[3])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[4], results_list_monotonic[[2]]$sim_results$power[4], results_list_monotonic[[3]]$sim_results$power[4], results_list_monotonic[[4]]$sim_results$power[4], results_list_monotonic[[5]]$sim_results$power[4])/5), -(sum(results_list_monotonic[[1]]$sim_results$power[5], results_list_monotonic[[2]]$sim_results$power[5], results_list_monotonic[[3]]$sim_results$power[5], results_list_monotonic[[4]]$sim_results$power[5], results_list_monotonic[[5]]$sim_results$power[5])/5)) -) - -kable(results_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario " = 7), font_size = 15, bold = TRUE) - - -``` - -### varying sample size -```{r warning=FALSE} -# assumed dose- response model with assumed maximum effect = 0.2 -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -# store results -power_monotonic_nsample_linear <- vector() -power_monotonic_nsample_exp <- vector() -power_monotonic_nsample_emax <- vector() -power_monotonic_nsample_logistic <- vector() -power_monotonic_nsample_sigemax <- vector() - - - -# Set max_effect to 0.2 -monotonic_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1), - 20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_monotonic_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list[[i]], - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -# store results -results_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[4]]$sim_results$power), - Exponential = c(results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power), - Emax = c(results_list_monotonic_nsample[[9]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power), - Logistic = c(results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power), - sigEmax = c(results_list_monotonic_nsample[[17]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power), -Average = c((sum(results_list_monotonic_nsample[[1]]$sim_results$power, results_list_monotonic_nsample[[5]]$sim_results$power, results_list_monotonic_nsample[[9]]$sim_results$power, ... = results_list_monotonic_nsample[[13]]$sim_results$power, results_list_monotonic_nsample[[17]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[2]]$sim_results$power, results_list_monotonic_nsample[[6]]$sim_results$power, results_list_monotonic_nsample[[10]]$sim_results$power, results_list_monotonic_nsample[[14]]$sim_results$power, results_list_monotonic_nsample[[18]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[3]]$sim_results$power, results_list_monotonic_nsample[[7]]$sim_results$power, results_list_monotonic_nsample[[11]]$sim_results$power, results_list_monotonic_nsample[[15]]$sim_results$power, results_list_monotonic_nsample[[19]]$sim_results$power)/5), - (sum(results_list_monotonic_nsample[[4]]$sim_results$power, results_list_monotonic_nsample[[8]]$sim_results$power, results_list_monotonic_nsample[[12]]$sim_results$power, results_list_monotonic_nsample[[16]]$sim_results$power, results_list_monotonic_nsample[[20]]$sim_results$power)/5))) - - -kable(results_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Monotonic scenario" = 7), font_size = 15, bold = TRUE) - - -``` - -## Non-monotonic scenario - -### varying expected effect for maximum dose - -For the simulations of the non-monotonic scenario, the R package 'Dosefinding' was used instead of 'MCPModPack - -```{r} -# linear with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_linear <- result$linear -``` - - -```{r} -# emax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_emax <- result$`emax (ED50=0.6666667)` -``` - - -```{r} -# sigemax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` -``` - - - -```{r} -#quadratic with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` - -``` - -```{r} -# beta with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.05,0.1,0.2,0.3,0.5), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` -``` - - -```{r} -#linear, emax, sigemax, quadratic -results_non_monotonic_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = power_non_monotonic_linear, - emax = power_non_monotonic_emax, - sigEmax = power_non_monotonic_sigemax, - quadratic = power_non_monotonic_quadratic, - beta = power_non_monotonic_beta, - average = c((sum(power_non_monotonic_linear[1],power_non_monotonic_emax[1], power_non_monotonic_sigemax[1], power_non_monotonic_quadratic[1], power_non_monotonic_beta[1])/5), - (sum(power_non_monotonic_linear[2],power_non_monotonic_emax[2], power_non_monotonic_sigemax[2], power_non_monotonic_quadratic[2], power_non_monotonic_beta[2])/5), - (sum(power_non_monotonic_linear[3],power_non_monotonic_emax[3], power_non_monotonic_sigemax[3], power_non_monotonic_quadratic[3], power_non_monotonic_beta[3])/5), - (sum(power_non_monotonic_linear[4],power_non_monotonic_emax[4], power_non_monotonic_sigemax[4], power_non_monotonic_quadratic[4], power_non_monotonic_beta[4])/5), - (sum(power_non_monotonic_linear[5],power_non_monotonic_emax[5], power_non_monotonic_sigemax[5], power_non_monotonic_quadratic[5], power_non_monotonic_beta[5])/5)) - ) - - -kable(results_non_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 7), font_size = 15, bold = TRUE) -``` - -### varying sample size - -```{r warning=FALSE} - - -# store results -power_non_monotonic_nsample_linear <- vector() -power_non_monotonic_nsample_emax <- vector() -power_non_monotonic_nsample_quadratic <- vector() -power_non_monotonic_nsample_sigemax <- vector() -power_non_monotonic_nsample_beta <- vector() - - -``` - -```{r} -# linear with DoseFinding -# allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[2] <- result$linear[1] -power_non_monotonic_nsample_linear[4] <- result$linear[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_linear[1] <- result$linear[1] -power_non_monotonic_nsample_linear[3] <- result$linear[2] -``` - - -```{r} - -# emax with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[2] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[4] <- result$`emax (ED50=0.6666667)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_emax[1] <- result$`emax (ED50=0.6666667)`[1] -power_non_monotonic_nsample_emax[3] <- result$`emax (ED50=0.6666667)`[2] -``` - - - -```{r} -# sigemax with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[2] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[4] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_sigemax[1] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[1] -power_non_monotonic_nsample_sigemax[3] <- result$`sigEmax (ED50=1.528629,h=4.087463)`[2] -``` - - - - -```{r} -# quadratic with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[2] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[4] <- result$`quadratic (delta=-0.09688711)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_quadratic[1] <- result$`quadratic (delta=-0.09688711)`[1] -power_non_monotonic_nsample_quadratic[3] <- result$`quadratic (delta=-0.09688711)`[2] -``` - - - -```{r} -# beta with DoseFinding -#allocation = c(1,1,1,1,1) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(150,180)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[2] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[4] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] - -# allocation = c(2,1,1,1,2) -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(2,1,1,1,2) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(140,168)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -power_non_monotonic_nsample_beta[1] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[1] -power_non_monotonic_nsample_beta[3] <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)`[2] -``` - - -```{r} -#store results -results_non_monotonic_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = power_non_monotonic_nsample_linear, - Emax = power_non_monotonic_nsample_emax, - sigEmax = power_non_monotonic_nsample_sigemax, - quadratic = power_non_monotonic_nsample_quadratic, - beta = power_non_monotonic_nsample_beta -) - - -kable(results_non_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("Non-monotonic scenario" = 6), font_size = 15, bold = TRUE) - -``` - -## Variability scenario - - -### varying expected effect for maximum dose - -```{r warning=FALSE} -# assumed dose - response model -sim_models_var_linear = list(linear = NA, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_exp = list( exponential = 4.447149, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - -sim_models_var_emax = list(emax = 0.6666667, - max_effect = c(0.05,0.1,0.2,0.3,0.5), - sd = rep(sd.sim_var, length(doses_var)), - placebo_effect = plc.guess) - - - -# Simulation parameters -sim_parameters_var = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - -# perform Simulations - -list_models <- list(sim_models_var_linear, sim_models_var_exp, sim_models_var_emax) -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var <- foreach(k = chunks, .combine = c) %dorng% { - - lapply(k, function (i) { - - func_sim(var_modelsPack, list_models[[i]], sim_parameters_var) - - }) - -} - - -# store results -results_var_MCP <- data.table( - Max_eff = c(0.05, 0.1, 0.2, 0.3, 0.5), - linear = results_list_var[[1]]$sim_results$power, - exponential = results_list_var[[2]]$sim_results$power, - emax = results_list_var[[3]]$sim_results$power, - average = c((sum(results_list_var[[1]]$sim_results$power[1], results_list_var[[2]]$sim_results$power[1],results_list_var[[3]]$sim_results$power[1])/3), - (sum(results_list_var[[1]]$sim_results$power[2], results_list_var[[2]]$sim_results$power[2],results_list_var[[3]]$sim_results$power[2])/3), - (sum(results_list_var[[1]]$sim_results$power[3], results_list_var[[2]]$sim_results$power[3],results_list_var[[3]]$sim_results$power[3])/3), - (sum(results_list_var[[1]]$sim_results$power[4], results_list_var[[2]]$sim_results$power[4],results_list_var[[3]]$sim_results$power[4])/3), - (sum(results_list_var[[1]]$sim_results$power[5], results_list_var[[2]]$sim_results$power[5],results_list_var[[3]]$sim_results$power[5])/3)) -) - -kable(results_var_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - - -``` - -### varying sample size -```{r warning=FALSE} -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - - -# store results -power_var_nsample_linear <- vector() -power_var_nsample_exp <- vector() -power_var_nsample_emax <- vector() - -# # Loop over nsample values -# for (i in seq_along(nsample_list_var)) { -# -# # Update nsample in simulation parameters -# sim_parameters_var$n <- nsample_list_var[[i]] -# -# -# # power values for different assumed true models -# power_nsample_linear <- func_sim(var_modelsPack, sim_models_var_linear, sim_parameters_var) -# power_var_nsample_linear[i] <- power_nsample_linear$sim_results$power -# -# power_nsample_exp <- func_sim(var_modelsPack, sim_models_var_exp, sim_parameters_var) -# power_var_nsample_exp[i] <- power_nsample_exp$sim_results$power -# -# power_nsample_emax <- func_sim(var_modelsPack, sim_models_var_emax, sim_parameters_var) -# power_var_nsample_emax[i] <-power_nsample_emax$sim_results$power -# -# -# } - -var_modelsPack$max_effect <- expectedEffect_fix -#list of different samole sizes -nsample_list_var = list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1), - 20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) - - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_var_nsample <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack), as.character(nsample_list))) %dorng% { - lapply(k, function (i) { - sim_parameters = list(n = nsample_list_var[[i]], - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim) - - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -results_var_MCP_nsample <- data.table( - N_sample = c("(40,20,20,20,40)","(30,30,30,30,30)", "(48,24,24,24,48)","(36,36,36,36,36)"), - Linear = c(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[4]]$sim_results$power), - Exponential =c(results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power), - Emax = c(results_list_var_nsample[[9]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power), - Average = c((sum(results_list_var_nsample[[1]]$sim_results$power, results_list_var_nsample[[5]]$sim_results$power, results_list_var_nsample[[9]]$sim_results$power)/3), - (sum(results_list_var_nsample[[2]]$sim_results$power, results_list_var_nsample[[6]]$sim_results$power, results_list_var_nsample[[10]]$sim_results$power)/3), - (sum(results_list_var_nsample[[3]]$sim_results$power, results_list_var_nsample[[7]]$sim_results$power, results_list_var_nsample[[11]]$sim_results$power)/3), - (sum(results_list_var_nsample[[4]]$sim_results$power, results_list_var_nsample[[8]]$sim_results$power, results_list_var_nsample[[12]]$sim_results$power)/3)) -) - -kable(results_var_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - -``` diff --git a/vignettes/Comparison_vignette/Comparison_convergence.qmd b/vignettes/Comparison_vignette/Comparison_convergence.qmd deleted file mode 100644 index 393d2a6..0000000 --- a/vignettes/Comparison_vignette/Comparison_convergence.qmd +++ /dev/null @@ -1,564 +0,0 @@ -```{r} -knitr::opts_chunk$set(eval = FALSE) -``` - - -### minimal BayesianMCPMod -```{r} - - -# Define a vector of different n_sim values -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) -n_sim_values <- c(10, 50, 100, 250, 500, 1000) #c(100, 500, 1000, 2500, 5000, 10000) - -# Initialize a list to store the results -results_list_nsim_Bay <- list() - -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") -#optimal contrasts -contM <- getContr(mods = min_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay <- foreach(k = chunks, .combine = c, .export = c(as.character(min_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_min <- assessDesign( - n_patients = Nsample, - mods = min_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - -results_nsim_Bay <- extract_success_rates_nsim(results_list_nsim_Bay, min_scenario, n_sim_values) - - -``` - -### minimal MCPModPack -```{r warning=FALSE} - - -# assumed dose - response model -sim_models_min_linear = list(linear = NA, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_exp = list(exponential = 4.447149, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - -sim_models_min_emax = list( emax = 0.6666667, - max_effect = expectedEffect_fix, - sd = rep(sd.sim, length(doses.sim)), - placebo_effect = plc.guess) - - - - -list_models <- list(sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, sim_models_min_linear, - sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, sim_models_min_exp, - sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax, sim_models_min_emax) -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000)) -#as.list(c(100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP <- foreach(k = chunks, .combine = c, .export = c(as.character(min_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(min_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - - -``` - - - -### monotonic BayesianMCPMod -```{r} - - -# Initialize a list to store the results - results_list_nsim_Bay_monotonic <- list() - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -#optimal contrasts -contM <- getContr(mods = monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000)) #as.list(c(100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_monotonic <- assessDesign( - n_patients = Nsample, - mods = monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_monotonic, monotonic_scenario, n_sim_values) - -``` - -### monotonic MCPModPack - -```{r warning=FALSE} - - -sim_models_monotonic_linear$max_effect <- expectedEffect_fix -sim_models_monotonic_exp$max_effect <- expectedEffect_fix -sim_models_monotonic_emax$max_effect <- expectedEffect_fix -sim_models_monotonic_logistic$max_effect <- expectedEffect_fix -sim_models_monotonic_sigemax$max_effect <- expectedEffect_fix - -list_models <- list(sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, sim_models_monotonic_linear, - sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, sim_models_monotonic_exp, - sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, sim_models_monotonic_emax, - sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, sim_models_monotonic_logistic, - sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax, sim_models_monotonic_sigemax - ) -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000)) - - #as.list(c(100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(monotonic_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample, - doses = doses.sim, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(monotonic_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` - -### non-monotonic BayesianMCPMod - -```{r} - - -# Initialize list to store results -results_list_nsim_Bay_non_monotonic <- list() - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6)) - - #optimal contrasts -contM <- getContr(mods = non_monotonic_models, - dose_levels = doses.sim, - prior_list = uninf_prior_list, - dose_weights = c(1,1,1,1,1)) - -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_non_monotonic <- foreach(k = chunks, .combine = c, .export = c(as.character(non_monotonic_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_non_monotonic <- assessDesign( - n_patients = Nsample, - mods = non_monotonic_models, - prior_list = uninf_prior_list, - sd = sd.sim, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_non_monotonic <- extract_success_rates_nsim(results_list_nsim_Bay_non_monotonic, non_monotonic_scenario, n_sim_values) -``` - -### non-monotonic MCPModPack - - -```{r} -# linear with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(linear = NULL) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -results_nsim_non_monotonic_linear <- result$linear - - -``` - -```{r} -# emax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(emax = 0.6666667) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -results_nsim_non_monotonic_emax <- result$`emax (ED50=0.6666667)` -``` - - -```{r} -# sigemax with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(sigEmax = rbind(c(1.528629, 4.087463))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -results_nsim_non_monotonic_sigemax <- result$`sigEmax (ED50=1.528629,h=4.087463)` - -``` -```{r} -#quadratic with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(quadratic = -0.09688711) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) - -results_nsim_non_monotonic_quadratic <- result$`quadratic (delta=-0.09688711)` - -``` - -```{r} -# beta with DoseFinding package -mvt_control <- mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0) -doses <- c(0,1,2,4,8) -allocation <- c(1,1,1,1,1) -alpha <- 0.05 -addArgs <- list(off = 0.08, scal = 9.6) - -resp_mod_list <- list(betaMod = rbind(c(1.396434, 1.040978))) -cand_mod_list <- list(linear = NULL, emax = 0.6666667, quadratic = -0.09688711, betaMod = rbind(c(1.396434, 1.040978)), sigEmax = rbind(c(1.528629, 4.087463))) -mods <- do.call(Mods, append(cand_mod_list, - list(maxEff = 1, doses = doses, placEff = 0, addArgs = addArgs))) -cont_mat <- optContr(mods, w = allocation) - -grd <- expand.grid(max_eff = c(0.2), sd = c(0.4), n_total = c(200)) -power_list <- vector("list", nrow(grd)) -dat_n <- t(sapply(grd$n_total, function(n) round(n*allocation/sum(allocation)))) -colnames(dat_n) <- paste0("D", doses) -for (i in 1:nrow(grd)) { - ###### - mods <- do.call(Mods, append(resp_mod_list, list(maxEff = grd$max_eff[i], doses = doses, - placEff = 0, addArgs = addArgs))) - n <- dat_n[i, ] - power_list[[i]] <- powMCT(cont_mat, alpha, mods, n, grd$sd[i], control = mvt_control) -} -power_df <- as.data.frame(do.call("rbind", power_list)) -mu <- getResp(mods) -parList <- attr(mu, 'parList') -mod_nams <- DoseFinding:::getModNams(parList) -colnames(power_df) <- mod_nams -power_df[['mean power']] <- apply(power_df, 1, mean) -result <- cbind(grd, power_df, dat_n) -results_nsim_non_monotonic_beta <- result$`betaMod (delta1=1.396434,delta2=1.040978,scal=9.6)` - -``` -```{r} -results_nsim_MCP_non_monotonic <- data.table( - linear = results_nsim_non_monotonic_linear, - emax = results_nsim_non_monotonic_emax, - sigemax = results_nsim_non_monotonic_sigemax, - quadratic = results_nsim_non_monotonic_quadratic, - beta = results_nsim_non_monotonic_beta -) -``` - - - - -### variability BayesianMCPMod -```{r} - - -# Initialize list to store results -results_list_nsim_Bay_var <- list() - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing") - -contM <- getContr(mods = var_models, - dose_levels = doses_var, - prior_list = var_uninf_prior_list, - dose_weights = c(1,1,1,1)) - -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000))#as.list(c(100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(n_sim_values_list), getDoParWorkers()) - - -results_list_nsim_Bay_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_models), as.character(contM))) %dorng% { - - lapply(k, function (i) { - - - # Simulation step - success_probabilities_var <- assessDesign( - n_patients = Nsample_var, - mods = var_models, - prior_list = var_uninf_prior_list, - sd = sd.sim_var, - n_sim = n_sim_values_list[[i]], - alpha_crit_val = alpha, - contr = contM) - - }) - -} - - - -results_nsim_Bay_var <- extract_success_rates_nsim(results_list_nsim_Bay_var, variability_scenario, n_sim_values) -``` - - -### variability MCPModPack -```{r, warning=FALSE} - - -results_list_nsim_MCP_var = list( - power_var_nsim_linear = vector(), - power_var_nsim_exp = vector(), - power_var_nsim_emax= vector()) - -# assume maximum effect = 0.2 -sim_models_var_linear$max_effect <- expectedEffect_fix -sim_models_var_exp$max_effect <- expectedEffect_fix -sim_models_var_emax$max_effect <- expectedEffect_fix - -sim_parameters_var$n <- Nsample_var - - -list_models <- list(sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, sim_models_var_linear, - sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, sim_models_var_exp, - sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax, sim_models_var_emax) -n_sim_values_list <- as.list(c(10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000, - 10, 50, 100, 250, 500, 1000)) - -# as.list(c(100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000, - # 100, 500, 1000, 2500, 5000, 10000)) - -chunks <- chunkVector(seq_along(list_models), getDoParWorkers()) - -results_list_nsim_MCP_var <- foreach(k = chunks, .combine = c, .export = c(as.character(var_modelsPack))) %dorng% { - - lapply(k, function (i) { - # Simulation parameters - sim_parameters = list(n = Nsample_var, - doses = doses_var, - dropout_rate = 0.0, - go_threshold = 0.1, - nsims = n_sim_values_list[[i]]) - - func_sim(var_modelsPack, list_models[[i]], sim_parameters) - - }) - -} - - -``` diff --git a/vignettes/Comparison_vignette/Comparison_vignette.qmd b/vignettes/Comparison_vignette/Comparison_vignette.qmd deleted file mode 100644 index 6cc0ab3..0000000 --- a/vignettes/Comparison_vignette/Comparison_vignette.qmd +++ /dev/null @@ -1,1033 +0,0 @@ ---- -title: "Vignette BayesianMCPMod" -date: today -format: - html: - fig-height: 3.5 - self-contained: true - toc: true - number-sections: true - #bibliography: references.bib - code-fold: true -vignette: > - %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{quarto::html} -editor: - markdown: - wrap: 72 ---- - -```{r} -#| code-summary: setup -#| code-fold: true -#| message: false -#| warning: false - -#' Display Parameters Table -#' -#' This function generates a markdown table displaying the names and values of parameters -#' from a named list. -#' -#' @param named_list A named list where each name represents a parameter name and the list -#' element represents the parameter value. Date values in the list are automatically -#' converted to character strings for display purposes. -#' -#' @return Prints a markdown table with two columns: "Parameter Name" and "Parameter Values". -#' The function does not return a value but displays the table directly to the output. -#' -#' @importFrom knitr kable -#' @examples -#' params <- list("Start Date" = as.Date("2020-01-01"), -#' "End Date" = as.Date("2020-12-31"), -#' "Threshold" = 10) -#' display_params_table(params) -#' -#' @export -display_params_table <- function(named_list) { - display_table <- data.frame() - value_names <- data.frame() - for (i in 1:length(named_list)) { - # dates will display as numeric by default, so convert to char first - if (class(named_list[[i]]) == "Date") { - named_list[[i]] = as.character(named_list[[i]]) - } - if (!is.null(names(named_list[[i]]))) { - value_names <- rbind(value_names, paste(names(named_list[[i]]), collapse = ', ')) - } - values <- data.frame(I(list(named_list[[i]]))) - display_table <- rbind(display_table, values) - } - - round_numeric <- function(x, digits = 3) { - if (is.numeric(x)) { - return(round(x, digits)) - } else { - return(x) - } - } - - display_table[1] <- lapply(display_table[1], function(sublist) { - lapply(sublist, round_numeric) - }) - - class(display_table[[1]]) <- "list" - - if (nrow(value_names) == 0) { - knitr::kable( - cbind(names(named_list), display_table), - col.names = c("Name", "Value") - ) - } else { - knitr::kable( - cbind(names(named_list), value_names, display_table), - col.names = c("Name", "Value Labels", "Value") - ) - } -} -# function to solve power results for tables (different max eff) BayesianMCPMod -# return(successrates models, average) -extract_success_rates <- function(results_list, models) { - success_rates <- list() - - for (i in seq_along(results_list)) { - success_rate <- c() - for (model in models) { - success_rate <- c(success_rate, attr(results_list[[i]][[model]]$BayesianMCP,"successRate")) - } - success_rates[[paste0("Bay_", attr(results_list[[i]],"maxEff"))]] <- c(success_rate, attr(results_list[[i]], "avgSuccessRate")) - } - - return(success_rates) - } - -# function to solve power results for tables (different nsample) BayesianMCPMod -#models % - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = length(scenario)+1), font_size = 15, bold = TRUE)%>% - add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) - - list(result_table = result_table, kable_result = kable_result) -} - - - -print_result_Bay_nsample <- function(results, scenario, variable) { - - result_table <- t(data.table( - Bay_1 = results$Bay_1, - Bay_2 = results$Bay_2, - Bay_3 = results$Bay_3, - Bay_4 = results$Bay_4)) - - result_table <- as.data.table(result_table) - names(result_table) <- scenario - #return(result_table) - - kable_result <- kable(cbind(variable, result_table))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Success probability results different sample sizes " = length(scenario)+1), font_size = 15, bold = TRUE)%>% - add_header_above(c("BayesianMCPMod " = length(scenario)+1), font_size = 15, bold = TRUE) - - list(result_table = result_table, kable_result = kable_result) -} - -plot_power_deviation <- function(data, x, xlab){ - plot <- ggplot2::ggplot(data, aes(x = x, y = value, color = variable, group = variable))+ - geom_point()+ - geom_line() + - scale_x_continuous(breaks = c(0, 100, 500, 1000, 2500, 5000, 10000), - labels = c("", "100", "", "1000", "2500", "5000", "10000")) + - geom_hline(aes(yintercept = 0), linetype = 2)+ - geom_hline(aes(yintercept = -0.05), linetype = 2, color = "darkgrey")+ - geom_hline(aes(yintercept = 0.05), linetype = 2, color = "darkgrey")+ - geom_hline(aes(yintercept = -0.1), linetype = 2, color = "darkgrey")+ - geom_hline(aes(yintercept = 0.1), linetype = 2, color = "darkgrey")+ - scale_color_manual(name = "assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - labs(x = xlab, y = "power deviation")+ - ylim(-0.15, 0.15)+ - theme_classic() - return(plot) -} - - - - -# parallel---------------------------------------------- -chunkVector <- function (x, n_chunks) { - if (n_chunks <= 1) { - chunk_list <- list(x) - } else { - chunk_list <- unname(split(x, cut(seq_along(x), n_chunks, labels = FALSE))) - } - return(chunk_list) -} - -library(BayesianMCPMod) -library(RBesT) -library(clinDR) -library(dplyr) -library(tibble) -library(reactable) -library(DoseFinding) -library(MCPModPack) -library(kableExtra) -library(data.table) -library(doFuture) -library(doRNG) - -registerDoFuture() -plan(multisession) - - - -set.seed(7015) -``` - -# Introduction - -This vignette demonstrates the application of the {BayesianMCPMod} -package for sample size calculations and the comparison with the -{MCPModPack} package. As for other bayesian approaches BMCPMod is able -to mimic the results of the frequentist MCPMod for non-informative -priors and this is shown here for the sample size planning of different -scenarios. - -In order to test and compare BayesianMCPMod and MCPModPack sample size -calculations in different scenarios, the data used for the comparisons -will be simulated multiple times using different input values. Every -scenario will be named to make the differentiation between each scenario -simpler. Altogether, four different scenarios were simulated. The first -three scenarios are pretty similiar, they only differ in the pre-defined -set of candidate models M. The other design choices, like the number of -dose levels or sample size allocation stay the same between the -scenarios. For the first three scenarios, these design choices are: - -- four dose levels plus placebo (0 mg, 1 mg, 2 mg, 4 mg, 8 mg) - -- total sample size of N = 200 - -- equal allocation ratio for each dose group - -- expected effect for maximum dose of 0.2 mg - -- standard deviation of 0.4 for every dose group - -The fourth scenario, the variability scenario, has some different design -choices: - three dose levels plus placebo (0 mg, 1 mg, 4 mg, 8 mg) - -total sample size of N = 100 - equal allocation ratio for each dose -group - expected effect for maximum dose of 0.2 mg - standard deviation -of 0.4 for every dose group - -Building on the initial scenarios, we further delve into the exploration -of varying input parameters. The varying parameters are: - -- expected effect for maximum dose of (0.05 mg, 0.1 mg, 0.2 mg, 0.3 - mg, 0.5 mg) - -- different total sample size with different allocation: - -- (40,20,20,20,40), (30,30,30,30,30), (48,24,24,24,48), - (36,36,36,36,36) (for the first three scenarios) - -- (40,20,20,40), (30,30,30,30), (48,24,24,48), (36,36,36,36) (for the - variability scenario) - -In a subsequent step, we extend our analysis to test the convergence of -power values as the number of simulations increases. For this part of -the study, we assume an expected effect for the maximum dose of 0.2 mg. -The sample size is set to 200 for the linear, monotonic and -non-monotonic scenario and 100 for the variability scenario. This -further exploration allows us to deepen our understanding of the -BayesianMCPMod and MCPModPack packages and their performance under -varying conditions. - -For each of these simulation cases, 10000 simulation runs are performed. Given the number of simulations, the difference should be in the range of 1-3% (based on the law of large numbers). - -```{r} -####### General assumptions ######### -# simulations -n_sim <- 100 #to be upscaled to 10000 - -# Define the list of sample sizes -nsample_list = list(20*c(2,1,1,1,2),30*c(1,1,1,1,1), 24*c(2,1,1,1,2),36*c(1,1,1,1,1)) -nsample_vector <- c("(40,20,20,20,40)", "(30,30,30,30,30)", "(48,24,24,24,48)", "(36,36,36,36,36)") - -# define input parameters -doses.sim <- c(0,1,2,4,8) # dose levels -max.dose <- max(doses.sim) # specify max dose possibly available -plc.guess <- 0 # expected placebo effect -Nsample <-c(40,40,40,40,40) #,36*c(1,1,1,1)) #list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) -expectedEffect_fix <- 0.2 #c(0.05,0.1,0.2,0.3,0.5) -expectedEffect <- c(0.05,0.1,0.2,0.3,0.5) -sd.sim <- c(0.4) - -#input paramters variability scenario -doses_var <- c(0, 1, 4, 8) -sd.sim_var <- 0.4 -Nsample_var <- c(25, 25, 25, 25) -nsample_list_var <- list(20*c(2,1,1,2),30*c(1,1,1,1), 24*c(2,1,1,2),36*c(1,1,1,1)) - - -# define model functions -emax.g <- guesst(d = doses.sim[2], p = 0.6, "emax") -exp.g <- guesst(d=doses.sim[2],p=0.05,model="exponential", Maxd=max.dose) -logit.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.1,0.9),"logistic",Maxd=max.dose) -sigEmax.g <- guesst(d=c(doses.sim[2],doses.sim[3]),p=c(0.15,0.75), model = "sigEmax") -quad.g <- guesst(d=doses.sim[2],p=0.35,model="quadratic") -beta.g <- guesst(d=doses.sim[2],p=0.2,model="betaMod", dMax=5.5, scal=9.6, Maxd=max.dose) - -### define models to be tested in MCPMod -models <- Mods(linear=NULL, - emax = emax.g, - exponential = exp.g, - logistic=logit.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) -) - -alpha <- 0.05 - -# display_params_table(models) - - -# kable(t(as.data.table(cbind(doses.sim, Nsample))))%>% -# kable_classic(full_width = TRUE)%>% -# add_header_above(c( "Doses" = 6), font_size = 15, bold = TRUE) -# -# -# kable(t(data.table(placebo_guess = plc.guess, -# sd = sd.sim[1], -# alpha = alpha )))%>% -# kable_classic(full_width = TRUE) - -``` - -## Scenarios - -In the following the candidate models for the different scenarios are -plotted. - -```{r} - -#Specification of considered models for different scenarios for BayesianMCPMod - -min_scenario <- c("linear", "exponential", "emax") -min_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(min_models, main = "minimal Scenario") - - -monotonic_scenario <- c("linear", "exponential", "emax", "logistic", "sigEmax") - -monotonic_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - logistic=logit.g, - sigEmax = sigEmax.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(monotonic_models, main = "monotonic Scenario") - - -non_monotonic_scenario <- c("linear", "emax", "sigEmax", "quadratic", "betaMod") - -non_monotonic_models <- Mods(linear=NULL, - emax = emax.g, - sigEmax = sigEmax.g, - quadratic = quad.g, - betaMod = beta.g, - doses = doses.sim, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing", - addArgs = list(scal=9.6) -) -plot(non_monotonic_models,main = "non monotonic Scenario") - - -variability_scenario <- c("linear","exponential", "emax") - -kable(t(as.data.table(cbind(doses_var, Nsample_var))))%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c( "Doses variability scenario" = 5), font_size = 15) - -var_models <- Mods(linear=NULL, - exponential = exp.g, - emax = emax.g, - doses = doses_var, - placEff = plc.guess, - maxEff = expectedEffect_fix, - direction = "increasing" -) -plot(var_models, main = "variability Scenario") - -``` - -# MCPModPack - -```{r} - -#Specification of considered models for different scenarios for MCPModPack - -min_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667) - -monotonic_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -non_monotonic_modelsPack = list(linear = NA, - emax = 0.6666667 , - sigEmax = c(1.528629, 4.087463), - quadratic = -0.09688711) -#beta - -var_modelsPack = list(linear = NA, - exponential = 4.447149, - emax = 0.6666667, - logistic = c(1.5, 0.2275598), - sigEmax = c(1.528629, 4.087463)) - -``` - -```{r child = 'Comparison_MCPModPack.qmd'} - -``` - -# BayesianMCPMod - -```{r child = 'Comparison_BayesianMCPMod.qmd'} - -``` - -# Comparison - -In the following, we will draw comparisons between the power values of various scenarios and differnt parameters. - -The following plots show the difference between the results with MCPModPack and BayesianMCPMod. The results with MCPModPack are shown as a line and the difference to the result with BayesianMCPMod is shown as a bar. The dose-response model assumed to be true during the analysis is shown as a different colour. - -## varying expected effect for maximum dose - -### minimal scenario - -```{r} - -#table with results -kable(results_min_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack " = 5), font_size = 15, bold = TRUE) - -minimal_Bay$kable_result - - -data_plot_eff_min <- data.frame( - max_eff = expectedEffect, - max_eff_num = c(1, 2, 3, 4, 5), - start_linear = results_min_MCP$linear, - end_linear = minimal_Bay$result_table$linear, - start_exp = results_min_MCP$exponential, - end_exp = minimal_Bay$result_table$exponential, - start_emax = results_min_MCP$emax, - end_emax = minimal_Bay$result_table$emax -) - - - - -# Create the plot -ggplot(data = data_plot_eff_min, aes(x = max_eff_num)) + - geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_eff_min$max_eff_num, labels = data_plot_eff_min$max_eff) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - theme_minimal() + - ylab("Power") + - xlab("expected effect for maximum dose")+ - ggtitle("Power values different expected effect for maximum dose") + - geom_vline(xintercept = data_plot_eff_min$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - - -``` - - -### monotonic scenario - -```{r} - -#table with results -kable(results_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects " = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack " = 7), font_size = 15, bold = TRUE) - -monotonic_Bay$kable_result - - -data_plot_eff_monotonic <- data.frame( - max_eff = expectedEffect, - max_eff_num = c(1, 2, 3, 4, 5), - start_linear = results_monotonic_MCP$linear, - end_linear = monotonic_Bay$result_table$linear, - start_exp = results_monotonic_MCP$exp, - end_exp = monotonic_Bay$result_table$exponential, - start_emax = results_monotonic_MCP$emax, - end_emax = monotonic_Bay$result_table$emax, - start_logistic = results_monotonic_MCP$logistic, - end_logistic = monotonic_Bay$result_table$logistic, - start_sigemax = results_monotonic_MCP$sigEmax, - end_sigemax = monotonic_Bay$result_table$sigEmax -) - - -# Create the plot -ggplot(data = data_plot_eff_monotonic, aes(x = max_eff_num)) + - geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num- 0.25, xend = max_eff_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_eff_monotonic$max_eff_num, labels = data_plot_eff_monotonic$max_eff) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 2))+ - theme_minimal() + - ylab("Power") + - xlab("expected effect for maximum dose")+ - ggtitle("Power values different expected effect for maximum dose")+ - geom_vline(xintercept = data_plot_eff_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - -``` - -### non - monotonic scenario - -```{r} - -# table results -kable(results_non_monotonic_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) - -non_monotonic_Bay$kable_result - - -data_plot_eff_non_monotonic <- data.frame( - max_eff = expectedEffect, - max_eff_num = c(1, 2, 3, 4, 5), - start_linear = results_non_monotonic_MCP$linear, - end_linear = non_monotonic_Bay$result_table$linear, - start_emax = results_non_monotonic_MCP$emax, - end_emax = non_monotonic_Bay$result_table$emax, - start_sigemax = results_non_monotonic_MCP$sigEmax, - end_sigemax =non_monotonic_Bay$result_table$sigEmax, - start_quadratic = results_non_monotonic_MCP$quadratic, - end_quadratic = non_monotonic_Bay$result_table$quadratic, - start_beta = results_non_monotonic_MCP$beta, - end_beta = non_monotonic_Bay$result_table$betaMod -) - - -# Create the plot -ggplot(data = data_plot_eff_non_monotonic, aes(x = max_eff_num)) + - geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.45, xend = max_eff_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + - geom_segment(aes(x = max_eff_num - 0.2, xend = max_eff_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.25, xend = max_eff_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + - geom_segment(aes(x = max_eff_num, xend = max_eff_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + - geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.15, xend = max_eff_num + 0.25, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + - geom_segment(aes(x = max_eff_num + 0.4, xend = max_eff_num + 0.4, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.35, xend = max_eff_num + 0.45, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + - scale_x_continuous(breaks = data_plot_eff_non_monotonic$max_eff_num, labels = data_plot_eff_non_monotonic$max_eff) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 2))+ - theme_minimal() + - ylab("Power") + - xlab("expected effect for maximum dose")+ - ggtitle("Power values for different expected effect for maximum dose")+ - geom_vline(xintercept = data_plot_eff_non_monotonic$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) -``` - -### variability scenario - -```{r} - -#table with results -kable(results_var_MCP)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different expected effects" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) - -variability_Bay$kable_result - -data_plot_eff_var <- data.frame( - max_eff = expectedEffect, - max_eff_num = c(1, 2, 3, 4, 5), - start_linear = results_var_MCP$linear, - end_linear = variability_Bay$result_table$linear, - start_exp = results_var_MCP$exponential, - end_exp = variability_Bay$result_table$exponential, - start_emax = results_var_MCP$emax, - end_emax = variability_Bay$result_table$emax -) - - -# Create the plot -ggplot(data = data_plot_eff_var, aes(x = max_eff_num)) + - geom_segment(aes(x = max_eff_num - 0.3, xend = max_eff_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.4, xend = max_eff_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num - 0.05, xend = max_eff_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num - 0.15, xend = max_eff_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = max_eff_num + 0.2, xend = max_eff_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = max_eff_num + 0.1, xend = max_eff_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_eff_var$max_eff_num, labels = data_plot_eff_var$max_eff) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - xlab("expected effect for maximum dose")+ - ggtitle("Power values for different expected effect for maximum dose")+ - geom_vline(xintercept = data_plot_eff_var$max_eff_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) -``` - -## varying sample size - -```{r} -nsample_vector <- as.vector(c("(40, 20, 20, 20, 40)", "(30, 30, 30, 30, 30)", "(48, 24, 24, 24, 48)", "(36, 36, 36, 36, 36)")) -``` - -### minimal scenario - -```{r} - -kable(results_min_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes " = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 5), font_size = 15, bold = TRUE) - -minimal_nsample_Bay$kable_result - - - - -data_plot_nsample_min <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = results_min_MCP_nsample$Linear, - end_linear = minimal_nsample_Bay$result_table$linear, - start_exp = results_min_MCP_nsample$Exponential, - end_exp = minimal_nsample_Bay$result_table$exponential, - start_emax = results_min_MCP_nsample$Emax, - end_emax = minimal_nsample_Bay$result_table$emax -) - - - - -# Create the plot -ggplot(data = data_plot_nsample_min, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_nsample_min$sample_sizes_num, labels = data_plot_nsample_min$sample_sizes) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes") + - geom_vline(xintercept = data_plot_nsample_min$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - - - - -``` - -### monotonic scenario - -```{r} - -kable(results_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 7), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 7), font_size = 15, bold = TRUE) - -monotonic_nsample_Bay$kable_result - -data_plot_nsample_monotonic <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = results_monotonic_MCP_nsample$Linear, - end_linear = monotonic_nsample_Bay$result_table$linear, - start_exp = results_monotonic_MCP_nsample$Exponential, - end_exp = monotonic_nsample_Bay$result_table$exponential, - start_emax = results_monotonic_MCP_nsample$Emax, - end_emax = monotonic_nsample_Bay$result_table$emax, - start_logistic = results_monotonic_MCP_nsample$Logistic, - end_logistic = monotonic_nsample_Bay$result_table$logistic, - start_sigemax = results_monotonic_MCP_nsample$sigEmax, - end_sigemax = monotonic_nsample_Bay$result_table$sigEmax -) - - -# Create the plot -ggplot(data = data_plot_nsample_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_logistic, yend = end_logistic, color = "logistic", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.15, xend = sample_sizes_num + 0.25, y = start_logistic, yend = start_logistic, color = "logistic", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num + 0.4, xend = sample_sizes_num + 0.4, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.35, xend = sample_sizes_num + 0.45, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_nsample_monotonic$sample_sizes_num, labels = data_plot_nsample_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - - -``` - -### non-monotonic scenario - -```{r} - -kable(results_non_monotonic_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 6), font_size = 15, bold = TRUE)%>% - add_header_above(c("MCPModPack" = 6), font_size = 15, bold = TRUE) - -non_monotonic_nsample_Bay$kable_result - -data_plot_nsample_non_monotonic <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = results_non_monotonic_MCP_nsample$Linear, - end_linear = non_monotonic_nsample_Bay$result_table$linear, - start_emax = results_non_monotonic_MCP_nsample$Emax, - end_emax = non_monotonic_nsample_Bay$result_table$emax, - start_sigemax = results_non_monotonic_MCP_nsample$sigEmax, - end_sigemax =non_monotonic_nsample_Bay$result_table$sigEmax, - start_quadratic = results_non_monotonic_MCP_nsample$quadratic, - end_quadratic = non_monotonic_nsample_Bay$result_table$quadratic, - start_beta = results_non_monotonic_MCP_nsample$beta, - end_beta = non_monotonic_nsample_Bay$result_table$betaMod -) - - -# Create the plot -ggplot(data = data_plot_nsample_non_monotonic, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.4, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.45, xend = sample_sizes_num - 0.35 , y = start_linear, yend = start_linear, color = "linear", size = "DoseFinding")) + - geom_segment(aes(x = sample_sizes_num - 0.2, xend = sample_sizes_num - 0.2 , y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.25, xend = sample_sizes_num - 0.15, y = start_emax, yend = start_emax, color = "emax", size = "DoseFinding")) + - geom_segment(aes(x = sample_sizes_num, xend = sample_sizes_num, y = start_sigemax, yend = end_sigemax, color = "sigemax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num + 0.05, y = start_sigemax, yend = start_sigemax, color = "sigemax", size = "DoseFinding")) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.1, y = start_quadratic, yend = end_quadratic, color = "quadratic", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.05, xend = sample_sizes_num + 0.15, y = start_quadratic, yend = start_quadratic, color = "quadratic", size = "DoseFinding")) + - geom_segment(aes(x = sample_sizes_num + 0.3, xend = sample_sizes_num + 0.3, y = start_beta, yend = end_beta, color = "beta", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.25, xend = sample_sizes_num + 0.35, y = start_beta, yend = start_beta, color = "beta", size = "DoseFinding")) + - scale_x_continuous(breaks = data_plot_nsample_non_monotonic$sample_sizes_num, labels = data_plot_nsample_non_monotonic$sample_sizes) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("DoseFinding" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_non_monotonic$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - - - -``` - -### variability sceanrio - -```{r} - -kable(results_var_MCP_nsample)%>% - kable_classic(full_width = TRUE)%>% - add_header_above(c("Power results different sample sizes" = 5), font_size = 15, bold = TRUE)%>% - add_header_above(c("Variability scenario" = 5), font_size = 15, bold = TRUE) - -var_nsample_Bay$kable_result - - -data_plot_nsample_var <- data.frame( - sample_sizes = nsample_vector, - sample_sizes_num = c(1, 2, 3, 4), - start_linear = results_var_MCP_nsample$Linear, - end_linear = var_nsample_Bay$result_table$linear, - start_exp = results_var_MCP_nsample$Exponential, - end_exp = var_nsample_Bay$result_table$exponential, - start_emax = results_var_MCP_nsample$Emax, - end_emax = var_nsample_Bay$result_table$emax -) - - -# Create the plot -ggplot(data = data_plot_nsample_var, aes(x = sample_sizes_num)) + - geom_segment(aes(x = sample_sizes_num - 0.3, xend = sample_sizes_num - 0.3, y = start_linear, yend = end_linear, color = "linear", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.4, xend = sample_sizes_num - 0.2 , y = start_linear, yend = start_linear, color = "linear", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num - 0.05, xend = sample_sizes_num - 0.05, y = start_exp, yend = end_exp, color = "exponential", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num - 0.15, xend = sample_sizes_num + 0.05 , y = start_exp, yend = start_exp, color = "exponential", size = "MCPModPack")) + - geom_segment(aes(x = sample_sizes_num + 0.2, xend = sample_sizes_num + 0.2, y = start_emax, yend = end_emax, color = "emax", size = "BayesianMCPMod")) + - geom_segment(aes(x = sample_sizes_num + 0.1, xend = sample_sizes_num + 0.3 , y = start_emax, yend = start_emax, color = "emax", size = "MCPModPack")) + - scale_x_continuous(breaks = data_plot_nsample_var$sample_sizes_num, labels = data_plot_nsample_var$sample_sizes) + - scale_color_manual(name = "Assumed true model", values = c("linear" = "red", "exponential" = "blue", "emax" = "darkgreen", "logistic" = "orange", "sigemax" = "purple", "beta" = "deepskyblue", "quadratic" = "deeppink"))+ - scale_size_manual( name = "Package", values = c("MCPModPack" = 0.5, "BayesianMCPMod" = 3))+ - theme_minimal() + - ylab("Power") + - ylim(c(0.25,1))+ - xlab("sample sizes")+ - ggtitle("Power values different sample sizes")+ - geom_vline(xintercept = data_plot_nsample_var$sample_sizes_num + 0.5, linetype="dashed", color = "black") + - theme(legend.position = "bottom") + - guides(color = guide_legend(nrow= 2 , byrow= TRUE ), size = guide_legend(nrow= 2 , byrow= TRUE )) - - -``` - -## convergence of power values - -In the following simulations, we examine the convergence of power values for an increasing number of simulations. We are considering the following number of simulations: 100, 500, 1000, 2500, 5000, 10000. - -```{r child = 'Comparison_convergence.qmd'} - -``` -## Results - -The following plots show the result of the convergence test of the power values for an increasing number of simulations. The difference between the power values of the frequency and Bayesian simulations is shown. -In the non-monotonous scenario, the DoseFinding package was used instead of the MCPModPack. This package does not simulate but accurately calculates the values. The difference between the Bayesian results and the true value of the DoseFinding calculation is also shown. - -### minimal scenario - - -```{r} -#safe results in data.table for plot -results_nsim <- data.table( - MCP_linear = c(results_list_nsim_MCP[[1]]$sim_results$power, results_list_nsim_MCP[[2]]$sim_results$power, results_list_nsim_MCP[[3]]$sim_results$power, results_list_nsim_MCP[[4]]$sim_results$power, results_list_nsim_MCP[[5]]$sim_results$power, results_list_nsim_MCP[[6]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP[[7]]$sim_results$power, results_list_nsim_MCP[[8]]$sim_results$power, results_list_nsim_MCP[[9]]$sim_results$power, results_list_nsim_MCP[[10]]$sim_results$power, results_list_nsim_MCP[[11]]$sim_results$power, results_list_nsim_MCP[[12]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP[[13]]$sim_results$power, results_list_nsim_MCP[[14]]$sim_results$power, results_list_nsim_MCP[[15]]$sim_results$power, results_list_nsim_MCP[[16]]$sim_results$power, results_list_nsim_MCP[[17]]$sim_results$power, results_list_nsim_MCP[[18]]$sim_results$power), - Bay_linear = results_nsim_Bay$Bay_linear, - Bay_exp = results_nsim_Bay$Bay_exponential, - Bay_emax = results_nsim_Bay$Bay_emax) - -results_nsim_diff <- data.table( - linear = results_nsim$Bay_linear - results_nsim$MCP_linear, - exponential = results_nsim$Bay_exp - results_nsim$MCP_exp, - emax = results_nsim$Bay_emax - results_nsim$MCP_emax, - n_sim = n_sim_values -) - -results_nsim_diff <- melt(results_nsim_diff, id.vars = "n_sim") - -plot_nsim <- plot_power_deviation(results_nsim_diff, results_nsim_diff$n_sim, "nsim") -plot_nsim -``` - -### monotonic scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_monotonic <- data.table( - MCP_linear = c(results_list_nsim_MCP_monotonic[[1]]$sim_results$power, results_list_nsim_MCP_monotonic[[2]]$sim_results$power, results_list_nsim_MCP_monotonic[[3]]$sim_results$power, results_list_nsim_MCP_monotonic[[4]]$sim_results$power, results_list_nsim_MCP_monotonic[[5]]$sim_results$power, results_list_nsim_MCP_monotonic[[6]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_monotonic[[7]]$sim_results$power, results_list_nsim_MCP_monotonic[[8]]$sim_results$power, results_list_nsim_MCP_monotonic[[9]]$sim_results$power, results_list_nsim_MCP_monotonic[[10]]$sim_results$power, results_list_nsim_MCP_monotonic[[11]]$sim_results$power, results_list_nsim_MCP_monotonic[[12]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_monotonic[[13]]$sim_results$power, results_list_nsim_MCP_monotonic[[14]]$sim_results$power, results_list_nsim_MCP_monotonic[[15]]$sim_results$power, results_list_nsim_MCP_monotonic[[16]]$sim_results$power, results_list_nsim_MCP_monotonic[[17]]$sim_results$power, results_list_nsim_MCP_monotonic[[18]]$sim_results$power), - MCP_logistic = c(results_list_nsim_MCP_monotonic[[19]]$sim_results$power, results_list_nsim_MCP_monotonic[[20]]$sim_results$power, results_list_nsim_MCP_monotonic[[21]]$sim_results$power, results_list_nsim_MCP_monotonic[[22]]$sim_results$power, results_list_nsim_MCP_monotonic[[23]]$sim_results$power, results_list_nsim_MCP_monotonic[[24]]$sim_results$power), - MCP_sigemax = c(results_list_nsim_MCP_monotonic[[25]]$sim_results$power, results_list_nsim_MCP_monotonic[[26]]$sim_results$power, results_list_nsim_MCP_monotonic[[27]]$sim_results$power, results_list_nsim_MCP_monotonic[[28]]$sim_results$power, results_list_nsim_MCP_monotonic[[29]]$sim_results$power, results_list_nsim_MCP_monotonic[[30]]$sim_results$power), - Bay_linear = results_nsim_Bay_monotonic$Bay_linear, - Bay_exp = results_nsim_Bay_monotonic$Bay_exponential, - Bay_emax = results_nsim_Bay_monotonic$Bay_emax, - Bay_logistic = results_nsim_Bay_monotonic$Bay_logistic, - Bay_sigemax = results_nsim_Bay_monotonic$Bay_sigEmax) - -results_nsim_diff_monotonic <- data.table( - linear = results_nsim_monotonic$Bay_linear - results_nsim_monotonic$MCP_linear, - exponential = results_nsim_monotonic$Bay_exp - results_nsim_monotonic$MCP_exp, - emax = results_nsim_monotonic$Bay_emax - results_nsim_monotonic$MCP_emax, - logistic = results_nsim_monotonic$Bay_logistic - results_nsim_monotonic$MCP_logistic, - sigemax = results_nsim_monotonic$Bay_sigemax - results_nsim_monotonic$MCP_sigemax, - n_sim = n_sim_values -) - -results_nsim_diff_monotonic <- melt(results_nsim_diff_monotonic, id.vars = "n_sim") - -plot_nsim_monotonic <- plot_power_deviation(results_nsim_diff_monotonic, results_nsim_diff_monotonic$n_sim, "nsim") -plot_nsim_monotonic -``` - -### non - monotonic scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_non_monotonic <- data.table( - MCP_linear = replicate(6,results_nsim_MCP_non_monotonic$linear), - MCP_emax = replicate(6,results_nsim_MCP_non_monotonic$emax), - MCP_sigemax = replicate(6,results_nsim_MCP_non_monotonic$sigemax), - MCP_quadratic = replicate(6,results_nsim_MCP_non_monotonic$quadratic), - MCP_beta = replicate(6,results_nsim_MCP_non_monotonic$beta), - Bay_linear = results_nsim_Bay_non_monotonic$Bay_linear, - Bay_emax = results_nsim_Bay_monotonic$Bay_emax, - Bay_sigemax = results_nsim_Bay_non_monotonic$Bay_sigEmax, - Bay_quadratic = results_nsim_Bay_non_monotonic$Bay_quadratic, - Bay_beta = results_nsim_Bay_non_monotonic$Bay_betaMod) - -results_nsim_diff_non_monotonic <- data.table( - linear = results_nsim_non_monotonic$Bay_linear - results_nsim_non_monotonic$MCP_linear, - emax = results_nsim_non_monotonic$Bay_emax - results_nsim_non_monotonic$MCP_emax, - sigemax =results_nsim_non_monotonic$Bay_sigemax - results_nsim_non_monotonic$MCP_sigemax, - quadratic = results_nsim_non_monotonic$Bay_quadratic - results_nsim_non_monotonic$MCP_quadratic, - beta = results_nsim_non_monotonic$Bay_beta - results_nsim_non_monotonic$MCP_beta, - n_sim = n_sim_values -) - - -results_nsim_diff_non_monotonic <- melt(results_nsim_diff_non_monotonic, id.vars = "n_sim") - -plot_nsim_non_monotonic <- plot_power_deviation(results_nsim_diff_non_monotonic, results_nsim_diff_non_monotonic$n_sim, "nsim") -plot_nsim_non_monotonic - -``` - -### variability scenario - - - -```{r} -#safe results in data.table for plot -results_nsim_var <- data.table( - MCP_linear = c(results_list_nsim_MCP_var[[1]]$sim_results$power, results_list_nsim_MCP_var[[2]]$sim_results$power, results_list_nsim_MCP_var[[3]]$sim_results$power, results_list_nsim_MCP_var[[4]]$sim_results$power, results_list_nsim_MCP_var[[5]]$sim_results$power, results_list_nsim_MCP_var[[6]]$sim_results$power), - MCP_exp = c(results_list_nsim_MCP_var[[7]]$sim_results$power, results_list_nsim_MCP_var[[8]]$sim_results$power, results_list_nsim_MCP_var[[9]]$sim_results$power, results_list_nsim_MCP_var[[10]]$sim_results$power, results_list_nsim_MCP_var[[11]]$sim_results$power, results_list_nsim_MCP_var[[12]]$sim_results$power), - MCP_emax = c(results_list_nsim_MCP_var[[13]]$sim_results$power, results_list_nsim_MCP_var[[14]]$sim_results$power, results_list_nsim_MCP_var[[15]]$sim_results$power, results_list_nsim_MCP_var[[16]]$sim_results$power, results_list_nsim_MCP_var[[17]]$sim_results$power, results_list_nsim_MCP_var[[18]]$sim_results$power), - Bay_linear = results_nsim_Bay_var$Bay_linear, - Bay_exp = results_nsim_Bay_var$Bay_exponential, - Bay_emax = results_nsim_Bay_var$Bay_emax -) - -results_nsim_diff_var <- data.table( - linear = results_nsim_var$Bay_linear - results_nsim_var$MCP_linear, - exponential = results_nsim_var$Bay_exp - results_nsim_var$MCP_exp, - emax = results_nsim_var$Bay_emax - results_nsim_var$MCP_emax, - n_sim = n_sim_values - ) - -results_nsim_diff_var <- melt(results_nsim_diff_var, id.vars = "n_sim") - -plot_nsim_var <- plot_power_deviation(results_nsim_diff_var, results_nsim_diff_var$n_sim, "nsim") -plot_nsim_var -``` - -```{r} -# save( results_min_MCP, minimal_Bay, results_monotonic_MCP, monotonic_Bay, results_non_monotonic_MCP, non_monotonic_Bay, results_var_MCP, variability_Bay, -# results_min_MCP_nsample, minimal_nsample_Bay, results_monotonic_MCP_nsample, monotonic_nsample_Bay, results_non_monotonic_MCP_nsample, non_monotonic_nsample_Bay, results_var_MCP_nsample, -# var_nsample_Bay, results_list_nsim_MCP, results_nsim_Bay, results_list_nsim_MCP_monotonic, results_nsim_Bay_monotonic, results_nsim_MCP_non_monotonic, results_nsim_Bay_non_monotonic, results_list_nsim_MCP_var, results_nsim_Bay_var -# file = "simulation_data.RData") -``` From 3663146f1c41d6ba02bef15d325556af8c6e2505 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Mon, 29 Jul 2024 11:24:55 +0200 Subject: [PATCH 36/39] minor --- _pkgdown.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index eb73929..61b49a1 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,4 +13,4 @@ articles: contents: - analysis_normal - Simulation_Example - - Comparison_vignette/Comparison_vignette + - Comparison_vignette From 9c8dc1b904e0ccc64afbc6146060f9f35d8c0ce7 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Mon, 29 Jul 2024 12:20:49 +0200 Subject: [PATCH 37/39] minor --- vignettes/Comparison_vignette.qmd | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd index 495be07..8f55771 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -1,21 +1,19 @@ --- -title: "Vignette BayesianMCPMod" -date: today +title: "Simulation Example of Bayesian MCPMod and MCPMod" format: html: fig-height: 3.5 self-contained: true toc: true number-sections: true - #bibliography: references.bib + code-summary: setup code-fold: true + message: false + warning: false vignette: > %\VignetteIndexEntry{Simulation Example of Bayesian MCPMod and MCPMod} %\VignetteEncoding{UTF-8} %\VignetteEngine{quarto::html} -editor: - markdown: - wrap: 72 --- ```{r} From b968fad2e129ce2faa174030d067c8bdff93d900 Mon Sep 17 00:00:00 2001 From: Xyarz Date: Tue, 30 Jul 2024 10:11:59 +0200 Subject: [PATCH 38/39] adjusted lib calls in vignette --- vignettes/Comparison_vignette.qmd | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/vignettes/Comparison_vignette.qmd b/vignettes/Comparison_vignette.qmd index 8f55771..6cf6b0d 100644 --- a/vignettes/Comparison_vignette.qmd +++ b/vignettes/Comparison_vignette.qmd @@ -16,6 +16,22 @@ vignette: > %\VignetteEngine{quarto::html} --- +```{r setup, include=FALSE, eval=TRUE, message=FALSE, warning=FALSE} +library(BayesianMCPMod) +library(RBesT) +library(clinDR) +library(dplyr) +library(tibble) +library(reactable) +library(DoseFinding) +library(MCPModPack) +library(kableExtra) +library(data.table) +library(doFuture) +library(doRNG) +``` + + ```{r} #| code-summary: setup #| code-fold: true From 5e4bf58edd6ce3d28e1a45e62cf9a4aa4556c27f Mon Sep 17 00:00:00 2001 From: Xyarz Date: Tue, 30 Jul 2024 10:37:56 +0200 Subject: [PATCH 39/39] adjusted DESCRIPTION dependencies --- DESCRIPTION | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index d4971e9..a35c81f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,6 +47,11 @@ Suggests: dplyr, knitr, rmarkdown, + MCPModPack, + data.table, + doFuture, + doRNG, + kableExtra, spelling, testthat (>= 3.0.0) VignetteBuilder: quarto