more tests for modelling

NAMESPACE

@@ -158,8 +158,8 @@ export(separate_factors)
 export(separate_hierarchy)
 export(setup_analysis)
 export(sim_lfq_data)
+export(sim_lfq_data_2Factor_config)
 export(sim_lfq_data_peptide_config)
-export(sim_lfq_data_protein_2Factor_config)
 export(sim_lfq_data_protein_config)
 export(spread_response_by_IsotopeLabel)
 export(squeezeVarRob)

R/ContrastsSimpleImpute.R

@@ -40,7 +40,7 @@
 #' print(p)
 #' dev.off()
 #'
-#' dd <- prolfqua::sim_lfq_data_protein_2Factor_config(Nprot = 100,weight_missing = 0.1)
+#' dd <- prolfqua::sim_lfq_data_2Factor_config(Nprot = 100,weight_missing = 0.1)
 #'
 #' Contrasts <- c("c1" = "TreatmentA - TreatmentB",
 #'                "C2" = "BackgroundX- BackgroundZ",

R/simulate_LFQ_data.R

@@ -217,19 +217,22 @@ sim_lfq_data_protein_config <- function(Nprot = 10, with_missing = TRUE, weight_
 #' @param seed seed for reproducibility, if NULL no seed is set.
 #' @export
 #' @examples
-#' undebug(sim_lfq_data_protein_2Factor_config)
-#' x <- sim_lfq_data_protein_2Factor_config()
+#' x <- sim_lfq_data_2Factor_config(PEPTIDE= FALSE)
+#' dim(x$data)
 #' stopifnot("data.frame" %in% class(x$data))
 #' stopifnot("AnalysisConfiguration" %in% class(x$config))
-#'
-sim_lfq_data_protein_2Factor_config <- function(Nprot = 10,
+#' x <- sim_lfq_data_2Factor_config(PEPTIDE = TRUE)
+#' dim(x$data)
+sim_lfq_data_2Factor_config <- function(Nprot = 10,
                                                 with_missing = TRUE,
                                                 weight_missing = 0.2,
-                                                seed = 1234){
+                                                PEPTIDE = FALSE,
+                                                seed = 1234
+                                                ){
   if (!is.null(seed)) {
     set.seed(seed)
   }
-  res <- sim_lfq_data(Nprot = Nprot, PEPTIDE = FALSE,
+  res <- sim_lfq_data(Nprot = Nprot, PEPTIDE = PEPTIDE,
                       fc = list(A = c(D = -2,  U = 2, N = 0), B = c(D = 1, U = -4), C = c(D = -1, U = -4)),
                       prop = list(A = c(D = 10, U = 10), B = c(D = 5, U = 20), C = c(D = 15, U = 25)))
   res <- res |> mutate(Treatment = case_when(group %in% c("Ctrl", "A") ~ "A", TRUE ~ "B"))
@@ -246,7 +249,11 @@ sim_lfq_data_protein_2Factor_config <- function(Nprot = 10,
   atable$factors["Treatment"] = "Treatment"
   atable$factors["Background"] = "Background"
   atable$factorDepth <- 2
+
   atable$hierarchy[["protein_Id"]] = c("proteinID", "idtype2")
+  if (PEPTIDE) {
+    atable$hierarchy[["peptpide_Id"]] = c("peptideID")
+  }
   atable$set_response("abundance")
 
   config <- AnalysisConfiguration$new(atable)

R/tidyMS_R6_Modelling.R

@@ -1,3 +1,39 @@
+#' build dataframe with models for testing
+#' @family modelling
+#' @export
+#' @keywords internal
+#' @example
+#' mod <- build_models(model = " ~ Treatment * Background", weight_missing = 1)
+#' stopifnot(dim(mod$modelDF) == c(10,9))
+#'
+build_models <- function(model = c("factors", "interaction"), Nprot = 10, with_missing = TRUE, weight_missing = 1) {
+  model <- match.arg(model)
+  model <- if (model == "factors") {
+    "~ Treatment + Background"
+  } else {
+    "~ Treatment * Background"
+  }
+  istar <- prolfqua::sim_lfq_data_2Factor_config(Nprot = Nprot, with_missing = with_missing, weight_missing = weight_missing)
+  istar <- prolfqua::LFQData$new(istar$data,istar$config)
+  modelFunction <- strategy_lm(paste0(istar$response(), model))
+  mod <- build_model(
+    istar,
+    modelFunction)
+  return(mod)
+}
+
+#' make interaction model for examples
+#' @family modelling
+#' @export
+#' @keywords internal
+#' @example path.R
+#' m <- make_model()
+make_model <- function(model = c("factors", "interaction")){
+  mod <- build_models(model = model, Nprot = 1, with_missing = FALSE)
+  return(mod$modelDF$linear_model[[1]])
+}
+
+
 # Creating models from configuration ----
 
 .ehandler = function(e){
@@ -15,9 +51,17 @@
 #' @family modelling
 #' @examples
 #'
-#' tmp <- strategy_lmer("Intensity ~ condition + (1|peptide_Id)", model_name = "random_example")
-#' tmp$model_fun(get_formula = TRUE)
-#' tmp$isSingular
+#' istar <- prolfqua::sim_lfq_data_peptide_config(Nprot = 10, with_missing = FALSE)
+#' istar <- prolfqua::LFQData$new(istar$data,istar$config)
+#' istar$data <- istar$data |> dplyr::group_by(protein_Id) |>
+#' dplyr::mutate(abundanceC = abundance - mean(abundance)) |> dplyr::ungroup()
+#' istar$factors()
+#' modelFunction <- strategy_lmer("abundanceC ~ group_ + (1|peptide_Id) ", model_name = "random_example")
+#' mod <- build_model(
+#'  istar,
+#'  modelFunction)
+#' sum(mod$modelDF$exists_lmer)
+#' sum(mod$modelDF$isSingular, na.rm=TRUE)
 #'
 strategy_lmer <- function(modelstr,
                           model_name = "Model",
@@ -60,6 +104,8 @@ strategy_lmer <- function(modelstr,
 #' @family modelling
 #' @return list with model function, contrast computation function etc.
 #' @examples
+#'
+#'
 #' tmp <- strategy_lm("Intensity ~ condition", model_name = "parallel design")
 #' tmp$model_fun(get_formula = TRUE)
 #' tmp$isSingular
@@ -556,40 +602,6 @@ linfct_from_model <- function(m, as_list = TRUE){
   }
 }
 
-#' build dataframe with models for testing
-#' @family modelling
-#' @export
-#' @keywords internal
-#' @example
-#' mod <- build_models(model = " ~ Treatment * Background", weight_missing = 1)
-#' stopifnot(dim(mod$modelDF) == c(10,9))
-#'
-build_models <- function(model = c("factors", "interaction"), Nprot = 10, with_missing = TRUE, weight_missing = 1) {
-  model <- match.arg(model)
-  model <- if (model == "factors") {
-     "~ Treatment + Background"
-  } else {
-    "~ Treatment * Background"
-  }
-  istar <- prolfqua::sim_lfq_data_protein_2Factor_config(Nprot = Nprot, with_missing = with_missing, weight_missing = weight_missing)
-  istar <- prolfqua::LFQData$new(istar$data,istar$config)
-  modelFunction <- strategy_lm(paste0(istar$response(), model))
-  mod <- build_model(
-    istar,
-    modelFunction)
-  return(mod)
-}
-
-#' make interaction model for examples
-#' @family modelling
-#' @export
-#' @keywords internal
-#' @example path.R
-#' m <- make_model()
-make_model <- function(model = c("factors", "interaction")){
-  mod <- build_models(model = model, Nprot = 1, with_missing = FALSE)
-  return(mod$modelDF$linear_model[[1]])
-}
 
 
 

R/tidyMS_missigness_V2.R

@@ -15,7 +15,7 @@
 #' bb <- mh$get_contrast_estimates(Contrasts)
 #' mh$get_contrasts(Contrasts)
 #'
-#' dd <- prolfqua::sim_lfq_data_protein_2Factor_config(Nprot = 100,weight_missing = 0.1)
+#' dd <- prolfqua::sim_lfq_data_2Factor_config(Nprot = 100,weight_missing = 0.1)
 #'
 #' Contrasts <- c("c1" = "TreatmentA - TreatmentB",
 #'                "C2" = "BackgroundX- BackgroundZ",

R/tidyMS_stats.R

@@ -162,7 +162,7 @@ poolvar <- function(res1, config,  method = c("V1","V2")){
 #'
 #' res1 <- summarize_stats(data, config)
 #'
-#' res2 <- prolfqua::sim_lfq_data_protein_2Factor_config()
+#' res2 <- prolfqua::sim_lfq_data_2Factor_config()
 #' res2$config$table$factorDepth <- 2
 #' stats <- summarize_stats(res2$data, res2$config)
 #' stats <- prolfqua::make_interaction_column(stats, columns = res2$config$table$factor_keys_depth(), sep = ":")
@@ -210,7 +210,7 @@ summarize_stats <- function(pdata, config, factor_key = config$table$factor_keys
 #' @export
 #' @examples
 #' # example code
-#' res2 <- prolfqua::sim_lfq_data_protein_2Factor_config()
+#' res2 <- prolfqua::sim_lfq_data_2Factor_config()
 #' xx <- summarize_stats_factors(res2$data, res2$config)
 #' stopifnot(nrow(xx) == 80)
 #'
@@ -251,7 +251,7 @@ summarize_stats_factors <- function(pdata, config){
 #' res1 <- summarize_stats_all(bb$data, bb$config)
 #'
 #' stopifnot((res1 |> dplyr::filter(group_ == "All") |> nrow()) == (res1 |> nrow()))
-#' res2 <- prolfqua::sim_lfq_data_protein_2Factor_config()
+#' res2 <- prolfqua::sim_lfq_data_2Factor_config()
 #' resSt <- summarize_stats_all(res2$data, res2$config)
 summarize_stats_all <- function(pdata, config) {
   summarize_stats(pdata, config, factor_key = NULL)