updates for jss pub

DESCRIPTION

@@ -14,7 +14,8 @@ Description: Provides functions for fitting and validation of models for subgrou
     identification and personalized medicine / precision medicine under the general subgroup
     identification framework of Chen et al. (2017) <doi:10.1111/biom.12676>.
     This package is intended for use for both randomized controlled trials and
-    observational studies.
+    observational studies and is described in detail in Huling and Yu (2021) 
+    <doi:10.18637/jss.v098.i05>.
 URL: https://jaredhuling.github.io/personalized/,
      https://arxiv.org/abs/1809.07905
 BugReports: https://github.com/jaredhuling/personalized/issues

R/augmentation_utils.R

@@ -53,7 +53,7 @@
 #'                                         nfolds.crossfit = 10,
 #'                                         cv.glmnet.args = list(type.measure = "auc",
 #'                                                               nfolds = 5))
-#'
+#' \dontrun{
 #' subgrp.model <- fit.subgroup(x = x, y = y,
 #'                              trt = trt01,
 #'                              propensity.func = prop.func,
@@ -62,6 +62,7 @@
 #'                              nfolds = 10)    # option for cv.glmnet (for ITR estimation)
 #'
 #' summary(subgrp.model)
+#' }
 #'
 #' @importFrom stats model.matrix
 #' @export
@@ -75,6 +76,7 @@ create.augmentation.function <- function(family, crossfit = TRUE, nfolds.crossfi
         tm <- "mse"
     }
 
+
     nfolds.crossfit <- as.integer(nfolds.crossfit[1])
     stopifnot(nfolds.crossfit > 1)
 
@@ -246,12 +248,27 @@ glmnet_aug_kfold_crossfit <- function(x, y, trt, wts = NULL,
         wts <- rep(1, NROW(x))
     }
 
+    unique.trts <- attr(trt, "unique.trts")
+    if (is.null(unique.trts))
+    {
+        if (is.factor(trt))
+        {
+            # drop any unused levels of trt
+            trt         <- droplevels(trt)
+            unique.trts <- levels(trt)
+        } else
+        {
+            unique.trts <- sort(unique(trt))
+        }
+    }
+    n.trts      <- length(unique.trts)
+
     if (interactions)
     {
         ## full model for nonzeroness
         df_all <- data.frame(x, trt = trt)
-        df_1   <- data.frame(x, trt = 1)
-        df_0   <- data.frame(x, trt = -1)
+        df_1   <- data.frame(x, trt = unique.trts[2])
+        df_0   <- data.frame(x, trt = unique.trts[1])
 
         mm_all <- model.matrix(~x*trt-1, data = df_all)
         mm_1   <- model.matrix(~x*trt-1, data = df_1)
@@ -290,7 +307,18 @@ glmnet_aug_kfold_crossfit <- function(x, y, trt, wts = NULL,
                 pred1_zerr <- unname(drop(predict(glmfit_zero_main, newx = mm_1[which,,drop=FALSE], s = "lambda.min", type = predtype)))
                 pred0_zerr <- unname(drop(predict(glmfit_zero_main, newx = mm_0[which,,drop=FALSE], s = "lambda.min", type = predtype)))
 
-                predvec[which] <- 0.5 * (pred1_zerr + pred0_zerr)
+                preds_cur <- rep(0, sum(which))
+                for (tt in 1:length(unique.trts))
+                {
+                    df_cur_trt    <- data.frame(x, trt = unique.trts[tt])
+                    mm_cur_trt    <- model.matrix(~x*trt-1, data = df_cur_trt)
+                    preds_cur <- preds_cur + unname(drop(predict(glmfit_zero_main,
+                                                                 newx = mm_cur_trt[which,,drop=FALSE],
+                                                                 s = "lambda.min", type = predtype)))
+                }
+                preds_cur <- preds_cur / length(unique.trts)
+
+                predvec[which] <- preds_cur
             } else
             {
                 ## get predictions for trt = 1 & -1

R/fit_subgroup.R

@@ -232,7 +232,10 @@
 #' results from fitted models, and \code{\link[personalized]{print.subgroup_fitted}}
 #' for arguments for printing options for \code{fit.subgroup()}.
 #' from \code{fit.subgroup}.
-#' @references Chen, S., Tian, L., Cai, T. and Yu, M. (2017), A general statistical framework for subgroup identification
+#' @references Huling. J.D. and Yu, M. (2021), Subgroup Identification Using the personalized Package.
+#' Journal of Statistical Software 98(5), 1-60. doi:10.18637/jss.v098.i05
+#'
+#' Chen, S., Tian, L., Cai, T. and Yu, M. (2017), A general statistical framework for subgroup identification
 #' and comparative treatment scoring. Biometrics. doi:10.1111/biom.12676 \url{http://onlinelibrary.wiley.com/doi/10.1111/biom.12676/abstract}
 #'
 #' Xu, Y., Yu, M., Zhao, Y. Q., Li, Q., Wang, S., & Shao, J. (2015),
@@ -869,6 +872,8 @@ fit.subgroup <- function(x,
         }
     }
 
+    attr(trt, "unique.trts") <- unique.trts
+
 
     extra.args <- NULL
     # check to make sure arguments of augment.func are correct

R/validate_subgroup.R

@@ -76,6 +76,8 @@
 #' \item{iterations}{Number of replications used in the validation process}
 #' \item{nobs}{Number of observations in \code{x} provided to \code{\link[personalized]{fit.subgroup}}}
 #' \item{nvars}{Number of variables in \code{x} provided to \code{\link[personalized]{fit.subgroup}}}
+#' @references Huling. J.D. and Yu, M. (2021), Subgroup Identification Using the personalized Package.
+#' Journal of Statistical Software 98(5), 1-60. doi:10.18637/jss.v098.i05
 #' @importFrom stats predict sd
 #' @import foreach
 #' @examples

cran-comments.md

@@ -1,8 +1,9 @@
-## New version for 'personalized' -- 0.2.5
+## New version for 'personalized' -- 0.2.6
 
 * Various small improvements/bug fixes
-* Added a vignette for multi-category treatments
-* Added augmentation/propensity function utilities
+* Added changes to reflect the incoming JSS publication related to this package
+* The DOI in the CITATION is for a new JSS publication that will be registered after
+publication on CRAN.
 
 ## Test environments
 

inst/CITATION

@@ -1,17 +1,22 @@
 citHeader("To cite personalized in publications use:")
 
-citEntry(,
-  entry        = "Unpublished",
-  author       = "Jared D. Huling and Menggang Yu",
-  title        = "Subgroup Identification Using the personalized Package",
-  year         = "2018",
-  note         = "submitted",
-  url          = "https://arxiv.org/abs/1809.07905",
-  textVersion  = paste("Huling, J.D., Yu, M. (2018) ",
-      "Subgroup Identification Using the personalized Package, ",
-      "URL: https://arxiv.org/abs/1809.07905.")
+bibentry(bibtype = "Article",
+  title        = "Subgroup Identification Using the {personalized} Package",
+  author       = c(person(given = c("Jared", "D."),
+                          family = "Huling",
+                          email = "[email protected]"),
+                   person(given = "Menggang",
+                          family = "Yu",
+                          email = "[email protected]")),
+  journal      = "Journal of Statistical Software",
+  year         = "2021",
+  volume       = "98",
+  number       = "5",
+  pages        = "1--60",
+  doi          = "10.18637/jss.v098.i05"
 )
 
+
 citEntry(,
   entry        = "Article",
   author       = "Shuai Chen and Lu Tian and Tianxi Cai and Menggang Yu",