...

Author: livio

.Rbuildignore

@@ -0,0 +1 @@
+(^\.github/.+$)|(^README.+$)

DESCRIPTION

@@ -1,11 +1,11 @@
-Package: jointest
-Version: 1.2.0
-Date: 2022-09-15
-Title: Multivariate testing trought joint sign-flip scores [Hemerik, Goeman and Finos (2020)].
-Author: Livio Finos
-Maintainer: Livio Finos <livio.finos@unipd.it>
-Description: runs resampling-based tests jointly (e.i. sign-flip score tests [Hemerik, Goeman and Finos (2020)] to allow for multivariate testing -- e.g. weak and strong control of the Familywise Error Rate or True Discovery Proportion.
-Imports: flipscores, methods 
-Encoding: UTF-8
-License: GPL-2
-RoxygenNote: 7.1.2
+Package: jointest
+Version: 1.2.0
+Date: 2022-09-15
+Title: Multivariate testing trought joint sign-flip scores [Hemerik, Goeman and Finos (2020)].
+Author: Livio Finos
+Maintainer: Livio Finos <livio.finos@unipd.it>
+Description: runs resampling-based tests jointly (e.i. sign-flip score tests [Hemerik, Goeman and Finos (2020)] to allow for multivariate testing -- e.g. weak and strong control of the Familywise Error Rate or True Discovery Proportion.
+Imports: flipscores, ggplot2, methods, flip 
+Encoding: UTF-8
+License: GPL-2
+RoxygenNote: 7.2.3

NAMESPACE

@@ -7,3 +7,8 @@ export(join_flipscores)
 export(p.adjust.fwer)
 import(flipscores)
 import(ggplot2)
+importFrom(flip,flip.adjust)
+importFrom(stats,median)
+importFrom(stats,qnorm)
+importFrom(stats,quantile)
+importFrom(stats,update)

R/combine.R

@@ -1,9 +1,14 @@
 #' (nonparametric) combination of jointest object 
-#' @param combined a) NULL = combines all coeffs with the same names along models, 
-#' b) a vector of characters = it gives a combination for each stats with these names 
-#' c) a list of arrays = each array has two columns reporting model (first column) 
+#' @param mods object of class \code{jointest} (it can be a list of glm or flipscores converted in a \code{jointest} object using \code{as.jointest})
+#' @param comb_funct  Combining function to be used. Several functions are implemented: "mean", "median", "Fisher", "Liptak", (equal to) "Stoufer", "Tippet", (equal to) "minp", "maxT" (the default). 
+#' Alternativelly it can be a custom function that has a matrix as input. The function return a vector of length equal to the number of rows of the input matrix. 
+#' @param combined a) if \code{NULL} it combines all coefficients with the same names along models, 
+#' b) if a vector of characters, it gives a combination for each stats with these names 
+#' c) if a list of arrays, each array has two columns reporting model (first column) 
 #' and name of the coefficient to be combined.
+#' @param tail direction of the alternative hypothesis. It can be "two.sided" (or 0, the default), "less" (or -1) or "greater" (or +1)
 #' @export
+#' 
 combine <- function (mods, comb_funct = "maxT", combined = NULL, tail = 0) 
 {
   names(mods) = .set_mods_names(mods)
@@ -29,10 +34,10 @@ combine <- function (mods, comb_funct = "maxT", combined = NULL, tail = 0)
     uniq_nm = unique(unlist(combined))
   }
   Tspace = .get_all_Tspace(mods)
-  res = lapply(1:length(combined), jointest:::.npc2jointest, 
+  res = lapply(1:length(combined), .npc2jointest, 
                Tspace = Tspace, combined = combined, tail = tail, comb_funct = comb_funct)
   names(res) = names(combined)
-  class(res) <- c("jointest", class(res))
+  class(res) <- unique(c("jointest", class(res)))
   res
 }
 
@@ -41,7 +46,7 @@ combine <- function (mods, comb_funct = "maxT", combined = NULL, tail = 0)
   comb_name = names(combined)[id]
   if (is.null(comb_name)) 
     comb_name = "Combined"
-  Tspace = jointest:::npc(Tspace[, combined[[id]]], comb_funct = comb_funct, 
+  Tspace = npc(Tspace[, combined[[id]]], comb_funct = comb_funct, 
                           tail = tail)
   colnames(Tspace) = comb_name
   summary_table = data.frame(Coeff = comb_name, Stat = comb_funct, 

R/facilities.R

@@ -45,39 +45,39 @@ make_models<-function (mod, max_cat = 3, var_exclude = NULL, data_new = NULL,
 }
 
 #########################
-multiverse_boostrap<-function (mods, data, var_interest, B = 500, verbatim = TRUE) 
-{
-  n_data <- dim(data)[1]
-  yvar <- all.vars(formula(mods[[1]]))[1]
-  vars <- all.vars(formula(mods[[1]]))[-1]
-  nvar <- length(vars)
-  num_comb <- length(mods)
-  pboot <- matrix(NA, B, num_comb)
-  eboot <- matrix(NA, B, num_comb)
-  pval <- rep(NA, num_comb)
-  eval <- rep(NA, num_comb)
-  pos <- which(vars == var_interest)
-  for (k in 1:num_comb) {
-    formula <- formula(mods[[k]])
-    m1 <- mods[[k]]
-    pval[k] <- coef(summary(m1))[pos + 1, 4]
-    eval[k] <- coef(m1)[pos + 1]
-    data$ytemp <- data[, yvar] - coef(m1)[pos + 1] * (data[, 
-                                                           var_interest])
-    temp <- "ytemp ~ "
-    for (j in 1:nvar) temp <- paste(temp, paste("+", 
-                                                all.vars(formula(mods[[k]]))[-1][j]))
-    formulak <- formula(temp)
-    set.seed(1)
-    bt <- boot::boot(data, function(d, i) coef(summary(update(mods[[k]], 
-                                                              data = d[i, ], formula = formulak)))[pos + 1, c(1, 
-                                                                                                              4)], R = B, stype = "i")
-    eboot[, k] <- bt$t[, 1]
-    pboot[, k] <- bt$t[, 2]
-    if (verbatim) 
-      show(paste("model", k))
-  }
-  list(pval = pval, eval = eval, pboot = pboot, eboot = eboot, 
-       models = mods)
-}
-
+# multiverse_boostrap<-function (mods, data, var_interest, B = 500, verbatim = TRUE) 
+# {
+#   n_data <- dim(data)[1]
+#   yvar <- all.vars(formula(mods[[1]]))[1]
+#   vars <- all.vars(formula(mods[[1]]))[-1]
+#   nvar <- length(vars)
+#   num_comb <- length(mods)
+#   pboot <- matrix(NA, B, num_comb)
+#   eboot <- matrix(NA, B, num_comb)
+#   pval <- rep(NA, num_comb)
+#   eval <- rep(NA, num_comb)
+#   pos <- which(vars == var_interest)
+#   for (k in 1:num_comb) {
+#     formula <- formula(mods[[k]])
+#     m1 <- mods[[k]]
+#     pval[k] <- coef(summary(m1))[pos + 1, 4]
+#     eval[k] <- coef(m1)[pos + 1]
+#     data$ytemp <- data[, yvar] - coef(m1)[pos + 1] * (data[, 
+#                                                            var_interest])
+#     temp <- "ytemp ~ "
+#     for (j in 1:nvar) temp <- paste(temp, paste("+", 
+#                                                 all.vars(formula(mods[[k]]))[-1][j]))
+#     formulak <- formula(temp)
+#     set.seed(1)
+#     bt <- boot::boot(data, function(d, i) coef(summary(update(mods[[k]], 
+#                                                               data = d[i, ], formula = formulak)))[pos + 1, c(1, 
+#                                                                                                               4)], R = B, stype = "i")
+#     eboot[, k] <- bt$t[, 1]
+#     pboot[, k] <- bt$t[, 2]
+#     if (verbatim) 
+#       show(paste("model", k))
+#   }
+#   list(pval = pval, eval = eval, pboot = pboot, eboot = eboot, 
+#        models = mods)
+# }
+# 

R/join_flipscores.R

@@ -1,7 +1,13 @@
 #'jointest for flipscores objects
-#'@param tested_coeff is a list of the same length of \code{mods}, each element of the list being a vector of  
+#'@param mods list of \code{glm}s (or list of any other object that can be evaluated by flipscores) 
+#'@param tested_coeffs is a list of the same length of \code{mods}, each element of the list being a vector of  
 #'of names of tested coefficients. Alternatively, it can be a vector of names of tested coefficients, in this case, the tested coefficients are attributed to all models (when present). 
 #'As a last option, it can be \code{NULL}, if so, all coefficients are tested.
+#'@param n_flips = 5000
+#'@param score_type any valid type for \code{flipscores}, \code{"standardized"} is the default. see \code{\link[flipscores]{flipscores}} for more datails 
+#'@param statistics "t" is the only method implemented (yet). Any other value will not modify the Score (a different statistic will only affect the multivariate inference, not the univariate one).
+#'@param seed \code{NULL} by default. Use a number if you wanto to ensure replicability of the results
+#'@param ... any other further parameter.
 #'@export
 #'
 #'@examples
@@ -59,10 +65,13 @@ join_flipscores <- function (mods, tested_coeffs = NULL, n_flips = 5000, score_t
           colnames(tt) = colnames(temp$Tspace)
           temp$Tspace = tt
         }
+      temp$summary_table=.get_summary_table_from_flipscores(temp)
       temp
     })
-  
-  names(modflips) = names(mods)
-  class(modflips) <- c("jointest", class(modflips))
+  if(is.null(names(mods))){
+    names(modflips)=paste0("mod",1:length(modflips))
+  } else
+    names(modflips) = names(mods)
+  class(modflips) <- unique(c("jointest", class(modflips)))
   modflips
 }

R/jointest_package.R

@@ -31,4 +31,8 @@
 #'
 #' @author Livio Finos
 #' @name jointest-package
+#' @importFrom stats median
+#' @importFrom stats qnorm
+#' @importFrom stats quantile
+#' @importFrom stats update
 NULL