version 2.7.0

cran · Jan 26, 2021 · 0f10684 · 0f10684
1 parent 26d42c5
commit 0f10684
Show file tree

Hide file tree

Showing 28 changed files with 926 additions and 762 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: qgcomp
 Title: Quantile G-Computation
-Version: 2.6.0
-Date: 2020-10-05
+Version: 2.7.0
+Date: 2021-01-26
 Authors@R: 
     person(given = "Alexander",
            family = "Keil",
@@ -28,8 +28,8 @@ VignetteBuilder: knitr
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 NeedsCompilation: no
-Packaged: 2020-10-06 03:25:09 UTC; akeil
+Packaged: 2021-01-26 21:42:07 UTC; akeil
 Repository: CRAN
-Date/Publication: 2020-10-06 05:10:02 UTC
+Date/Publication: 2021-01-26 22:10:02 UTC
diff --git a/MD5 b/MD5
@@ -1,24 +1,25 @@
-77544de3b2e5db684df16e644b4df8bc *DESCRIPTION
+69e2064a9a1aa1f21f5c24ae29cfdd5e *DESCRIPTION
 84cfd7afdfaf6a86e953d429dddb8dca *NAMESPACE
-45ede6d4ffab08f651237255cd6d3ce2 *NEWS.md
-bd65ae04eaddbff826818b016740ad59 *R/base.R
-db31fdb478884194f78f2fc455c09ec0 *R/base_bounds.R
+d4091406613b4f1146907b6c4bdbc46d *NEWS.md
+f2a673c9be33f1ecc5fc2b8736749572 *R/base.R
+9372dbbc49338806864f5d06514b0016 *R/base_bounds.R
 ad02dc8706a119714c07e79b625cc3c5 *R/base_experimental.R
-f414ec14495a3b8df7e9e705e87bbc94 *R/base_extensions.R
+0864472a76fb326a0384aebcf5debb6e *R/base_extensions.R
 c1fc00b490ed96a4e381f4a88241bfad *R/base_generics.R
-073737b1f01edef3c71d67bf92359aab *R/base_hurdle.R
-9bb6de5059755722eb49457697664c39 *R/base_plots.R
-e76c6adc70d555a05744aa1e2c31f77b *R/base_samplesplits.R
-7eaa466123110f688eff1b32f16f9658 *R/base_surv.R
-51841a23985125a3600ddf1db06c26a1 *R/base_zi.R
+ed31a35608b842941c223d4e0d5b027d *R/base_hurdle.R
+48dcec918baba27637817e8e9c157e7e *R/base_plots.R
+4d9f271892061cbab9d6d7984ea3f66b *R/base_samplesplits.R
+79e16649c8fc5250912bf7b794f98f68 *R/base_surv.R
+5c7ce181c690a7077e25372cd43b5d24 *R/base_zi.R
 c1010c23e7a3ff99d466b057d7a03ea7 *R/data.R
 a47a929109324ae002786cec00593cbd *R/utility.R
-721255bb9872bf538d2c7aa5399cb181 *README.md
-f56192ecbbc72f687edd64504f3fc022 *build/vignette.rds
+4b9250c190a0be743ccc53b6535898f9 *README.md
+cc39b8f0f4f849f87f442e4003561109 *build/vignette.rds
 c52baf72a0ded2860f1fc7bcc0a44587 *data/metals.RData
-243107595af80126cbf287ba757bfea0 *inst/doc/qgcomp-vignette.R
-aedcc5140ee9632df27b6754668d67ba *inst/doc/qgcomp-vignette.Rmd
-af16f1853f95826ad4ad0f8198765074 *inst/doc/qgcomp-vignette.html
+e6772176b351eb4fe4de51434d6c5fd9 *inst/doc/qgcomp-vignette.R
+0ecd4e9ef1d9cf5fccf4ba3510030be7 *inst/doc/qgcomp-vignette.Rmd
+f07d53203250d5a80f24ea2615c10f84 *inst/doc/qgcomp-vignette.html
+dcba3c6855f754b7494b841d285e3197 *inst/fig/fighex.png
 a728173c2b39a9a95c900810feca0c26 *inst/fig/res1.png
 f5abbe8dad3f100e9ac096bef10a618d *inst/fig/res2.png
 d0a2f6a4f4da4c846dfe72d0fb11d4a7 *inst/fig/res4.png
@@ -30,17 +31,17 @@ e94c09896dff60f5396441413a0a2e19 *man/checknames.Rd
 8e8229ff4022716ab2f581007b4b8ab1 *man/hurdlemsm.fit.Rd
 e8ce60028517f93774d710b3f1304b7e *man/hurdlemsm.fit.control.Rd
 fe4d3e1f0eb95fff9501963f9c7f9b9a *man/metals.Rd
-d461cd4790e44f088abb07db1f02d68e *man/mice.impute.leftcenslognorm.Rd
+246ed51a262b533facebbba4f18b0894 *man/mice.impute.leftcenslognorm.Rd
 d00e920bfd6bb988c6e9ab09b1d53d4b *man/modelbound.boot.Rd
 6592fb86e4a042cce8d81e7a0450b18b *man/msm.fit.Rd
 e03bf2686ec795d743c27e2eb16979e4 *man/msm.predict.Rd
 8b5311cbcbae84859be0253c49a22657 *man/plot.qgcompfit.Rd
 818889016c0bde3ce45be33273c74134 *man/pointwisebound.boot.Rd
-9f96080e90aae63ba53d156b8e4fa935 *man/pointwisebound.noboot.Rd
+5da7cbe503e128a334550e9fd5567fb5 *man/pointwisebound.noboot.Rd
 be9635de94dc97e73cd42e4fe0bee060 *man/predict.qgcompfit.Rd
 16e6bf82624318b907d18d714d6fa418 *man/print.qgcompfit.Rd
 962bafb313e364d995bcf5bdec95cde5 *man/qgcomp.Rd
-9439937297523a2a3cf5a240f9be3644 *man/qgcomp.boot.Rd
+df656252c8dc4678030263d4490f93b9 *man/qgcomp.boot.Rd
 f643c4b9deece81d37b45bd068e51911 *man/qgcomp.cox.boot.Rd
 1e252c99b0270454f0da900ab76d0b90 *man/qgcomp.cox.noboot.Rd
 fa41baa40dfb14e82a36159f8e2d1ce7 *man/qgcomp.hurdle.boot.Rd
@@ -61,17 +62,12 @@ fb7e649e05de6cc54a94061cf824942a *man/zimsm.fit.control.Rd
 46b7ca06ffffdd438e7c24c41f30672d *tests/test_basics.R
 a6bc13cc3aa8d0966b0cafd67623d4f5 *tests/test_bayesqgcomp.R
 3adbce145f25a6436905f10c97898295 *tests/test_boot_ints.R
-9f5d67e51fb65c40ce728a447442b06f *tests/test_boot_vs_noboot.R
 74219b40d4fb44b4eb414e9d0f45b018 *tests/test_bootchooser.R
-bced748b8fc63ad4727e5a7df7f1d087 *tests/test_cox_msmtest.R
 2adc75ff8664eea0314992fd19ebff78 *tests/test_factor.R
-622145432f94a057f9cc7f3eaa5343e0 *tests/test_id.R
-180b44b92bae444d073170d3d9a0135d *tests/test_mice.R
+3ecea9330c4be292acaed8d39ae81c87 *tests/test_id.R
+5e757e8b3ebaa84f6f0dc3b3f78ebb38 *tests/test_mice.R
 20abdeb552c2efed1352526d2baf8c88 *tests/test_numeric.R
 1132ffeaf05f6fe7b409e9049f826bf2 *tests/test_poisson.R
 34309c92ce57d4598adf623550be8cb5 *tests/test_splits.R
-ef516dd3082add10409abee3f85e2cd5 *tests/test_utilities.R
 055d4f8d4b83a240f614fb268ffb5dbe *tests/test_weights.R
-c99603137354757648123d1829750968 *tests/test_zi.R
-1a2b72ebb6e147c668dc7279dcc4f734 *tests/test_zzzplots.R
-aedcc5140ee9632df27b6754668d67ba *vignettes/qgcomp-vignette.Rmd
+0ecd4e9ef1d9cf5fccf4ba3510030be7 *vignettes/qgcomp-vignette.Rmd
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,15 @@
+# qgcomp v2.7.0
+## Major changes
+- None
+
+## Minor changes
+- Changed underlying parallel code to adapt to deprecations from future package
+- Documentation improvements
+- Enabled by-observation limit of detection/right censoring point for mice.impute.leftcensorlognorm
+
+## Bug fixes
+- None
+
 # qgcomp v2.6.0
 ## Major changes
 - Added `cox.survcurve.boot` function to estimate survival curves from a qgcomp.cox.boot fit

diff --git a/R/base.R b/R/base.R
@@ -195,7 +195,8 @@ quantize <- function (data, expnms, q=4, breaks=NULL) {
     if(length(expnms)==1){
       data[, expnms] <- qt(1)
     }else{
-      data[, expnms] <- sapply(seq_len(length(expnms)), qt)
+      #data[, expnms] <- sapply(seq_len(length(expnms)), qt)
+      data[, expnms] <- vapply(seq_len(length(expnms)), qt, rep(0.0, nrow(data)))
     }
     return(list(data=data, breaks=e$retbr))
 }
@@ -307,7 +308,7 @@ msm.fit <- function(f,
 
     if(is.null(id)) {
       id <- "id__"
-      qdata$id__ <- 1:dim(qdata)[1]
+      qdata$id__ <- seq_len(dim(qdata)[1])
     }
     # conditional outcome regression fit
     nidx = which(!(names(qdata) %in% id))
@@ -324,7 +325,7 @@ msm.fit <- function(f,
     ### 
     # get predictions (set exposure to 0,1,...,q-1)
     if(is.null(intvals)){
-      intvals <- (1:length(table(qdata[expnms[1]]))) - 1
+      intvals <- (seq_len(length(table(qdata[expnms[1]])))) - 1
     }
     predit <- function(idx, newdata){
       #newdata <- qdata
@@ -339,7 +340,7 @@ msm.fit <- function(f,
                                             replace = TRUE
       )))
       names(newids) <- id
-      newdata <- merge(qdata,newids, by=id, all.x=FALSE, all.y=TRUE)[1:MCsize,]
+      newdata <- merge(qdata,newids, by=id, all.x=FALSE, all.y=TRUE)[seq_len(MCsize),]
     }
     predmat = lapply(intvals, predit, newdata=newdata)
     # fit MSM using g-computation estimates of expected outcomes under joint 
@@ -505,7 +506,7 @@ qgcomp.noboot <- function(f,
     if(is.null(id)) {
       # not yet implemented
       id = "id__"
-      qdata$id__ = 1:dim(qdata)[1]
+      qdata$id__ = seq_len(dim(qdata)[1])
     }
 
   if(!bayes) fit <- glm(newform, data = qdata,
@@ -759,7 +760,7 @@ qgcomp.boot <- function(f,
   #'
   #' # weighted model
   #' N=5000
-  #' dat4 <- data.frame(id=1:N, x1=runif(N), x2=runif(N), z=runif(N))
+  #' dat4 <- data.frame(id=seq_len(N), x1=runif(N), x2=runif(N), z=runif(N))
   #' dat4$y <- with(dat4, rnorm(N, x1*z + z, 1))
   #' dat4$w=runif(N) + dat4$z*5
   #' qdata = quantize(dat4, expnms = c("x1", "x2"), q=4)$data
@@ -827,22 +828,22 @@ qgcomp.boot <- function(f,
       } else{
         nvals <- q
       }
-      intvals <- (1:nvals)-1
+      intvals <- (seq_len(nvals))-1
     } else {
       # if( is.null(breaks) & is.null(q)) # also includes NA
       qdata <- data
       # if no transformation is made (no quantiles, no breaks given)
       # then draw distribution values from quantiles of all the exposures
       # pooled together
-      # TODO: allow user specification of this
+      # : allow user specification of this
       nvals = length(table(unlist(data[,expnms])))
       if(nvals < 10){
         message("\nNote: using all possible values of exposure as the 
               intervention values\n")
         p = length(expnms)
         intvals <- as.numeric(names(table(unlist(data[,expnms]))))
 
-        br <- lapply(1:p, function(x) c(-1e16, intvals[2:nvals]-1e-16, 1e16))
+        br <- lapply(seq_len(p), function(x) c(-1e16, intvals[2:nvals]-1e-16, 1e16))
       }else{
     message("\nNote: using quantiles of all exposures combined in order to set 
           proposed intervention values for overall effect (25th, 50th, 75th %ile)
@@ -853,7 +854,7 @@ qgcomp.boot <- function(f,
     }
     if(is.null(id)) {
       id <- "id__"
-      qdata$id__ <- 1:dim(qdata)[1]
+      qdata$id__ <- seq_len(dim(qdata)[1])
     }
     ###
     msmfit <- msm.fit(newform, qdata, intvals, expnms, rr, main=TRUE,degree=degree, id=id, 
@@ -891,29 +892,31 @@ qgcomp.boot <- function(f,
     }
     set.seed(seed)
     if(parallel){
-      Sys.setenv(R_FUTURE_SUPPORTSMULTICORE_UNSTABLE="quiet")
-      future::plan(strategy = future::multiprocess)
-      bootsamps <- future.apply::future_sapply(X=1:B, FUN=psi.only,f=f, qdata=qdata, intvals=intvals, 
+      #Sys.setenv(R_FUTURE_SUPPORTSMULTICORE_UNSTABLE="quiet")
+      future::plan(strategy = future::multisession)
+      bootsamps <- future.apply::future_lapply(X=seq_len(B), FUN=psi.only,f=f, qdata=qdata, intvals=intvals, 
                           expnms=expnms, rr=rr, degree=degree, nids=nids, id=id,
                           weights=qdata$weights,MCsize=MCsize,
+                          future.seed=TRUE,
                           ...)
 
-      future::plan(future::sequential)
+      future::plan(strategy = future::transparent)
     }else{
-      bootsamps <- sapply(X=1:B, FUN=psi.only,f=f, qdata=qdata, intvals=intvals, 
+      bootsamps <- lapply(X=seq_len(B), FUN=psi.only,f=f, qdata=qdata, intvals=intvals, 
                           expnms=expnms, rr=rr, degree=degree, nids=nids, id=id,
                           weights=weights, MCsize=MCsize,
                           ...)
 
     }
+    bootsamps = do.call("cbind", bootsamps)
     # these are the linear predictors
-    hats = t(bootsamps[-c(1:(degree+1)),])
+    hats = t(bootsamps[-c(seq_len(degree+1)),])
     # covariance of the linear predictors
     cov.yhat = cov(hats)
-    bootsamps = bootsamps[1:(degree+1),]
+    bootsamps = bootsamps[seq_len(degree+1),]
     seb <- apply(bootsamps, 1, sd)
     covmat <- cov(t(bootsamps))
-    colnames(covmat) <- rownames(covmat) <- names(estb) <- c("(intercept)", paste0("psi", 1:(nrow(bootsamps)-1)))
+    colnames(covmat) <- rownames(covmat) <- names(estb) <- c("(intercept)", paste0("psi", seq_len(nrow(bootsamps)-1)))
 
     tstat <- estb / seb
     df <- nobs - length(attr(terms(f, data = data), "term.labels")) - 1 - degree # df based on obs - gcomp terms - msm terms
@@ -1051,7 +1054,7 @@ qgcomp <- function(f,data=data,family=gaussian(),rr=TRUE,...){
       stop("'family' not recognized")
     }
   }
-  if(!(family$family %in% c("binomial")) & rr) {
+  if(!(family$family == "binomial") & rr) {
     #warning("'rr=TRUE' is for bimomial family only, setting rr=FALSE")
     rr = FALSE
   }