version 1.2.2

cran · Feb 4, 2019 · 77f8f11 · 77f8f11
1 parent 46f142b
commit 77f8f11
Show file tree

Hide file tree

Showing 27 changed files with 1,202 additions and 2,641 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,24 +1,24 @@
 Package: multistateutils
 Type: Package
 Title: Utility Functions for Parametric Multi-State Models
-Version: 1.2.0
-Date: 2018-07-18
+Version: 1.2.2
+Date: 2019-02-03
 Author: Stuart Lacy
 Maintainer: Stuart Lacy <stuart.lacy@gmail.com>
 Description: Provides functions for working with multi-state modelling, 
     such as efficient simulation routines for estimating transition probabilities and length of stay.
     It is designed as an extension to multi-state modelling capabilities provided with the 'flexsurv' 
     package (see Jackson (2016) <doi:10.18637/jss.v070.i08>).
-License: GPL (>= 2)
-Imports: Rcpp (>= 0.12.10), data.table, dplyr, magrittr, networkD3,
-        survival, tidyr
-Suggests: flexsurv, mstate, microbenchmark, rmarkdown, knitr, testthat,
-        covr
+License: GPL (>= 3)
+Imports: data.table, dplyr, magrittr, networkD3, tidyr, webshot
+Suggests: covr, knitr, flexsurv, mstate, microbenchmark, rmarkdown,
+        testthat
 URL: https://github.com/stulacy/multistateutils
+BugReports: https://github.com/stulacy/multistateutils/issues
 LinkingTo: Rcpp
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.1
 VignetteBuilder: knitr
 NeedsCompilation: yes
-Packaged: 2018-07-18 22:40:30 UTC; stuart
+Packaged: 2019-02-03 22:34:45 UTC; stuart
 Repository: CRAN
-Date/Publication: 2018-07-21 09:30:03 UTC
+Date/Publication: 2019-02-04 08:30:11 UTC
diff --git a/MD5 b/MD5
@@ -1,44 +1,44 @@
-c49aaabc61ddcc2790baeda09467a04a *DESCRIPTION
+e6f30b513bb0a362d91fbdd6a7f1c4e6 *DESCRIPTION
 a1ae93d2c87fcc5f98452956facfdedf *NAMESPACE
-f66a5161548a938dc0587e52c57fcc7f *NEWS.md
+ad0555e1573e283fb9a54d398bac1870 *NEWS.md
 0a91d61ac2ba351a6ca6a640bea450a8 *R/RcppExports.R
-b32305a294091279503eac4f3d45ffc0 *R/cohort.R
-b5f4d8da8e39388a1dee92a6506e5e0c *R/length_of_stay.R
-455a3885611a03425561dd13b2003f16 *R/msprep2.R
+b1dbcdf5b70b84232533a3cfe8cf0ec2 *R/cohort.R
+5795f711de63e297c77b4b61e5d1fcc7 *R/length_of_stay.R
+3a50addd2e64e90239e5d1e6eebfec87 *R/msprep2.R
 ac7e40966b058f5596304f9b7e3516ca *R/multistateutils.R
 1f182e54f53c05a90a759b5e3c3e599a *R/run_simulation.R
 aa5c6bd41802ac1354513df6612de673 *R/statepathways.R
-e9dea7dc7e4bb92b67df7ef8d7b57136 *R/transition_probabilities.R
-23a6733a4dfb9396acaaf699b9a7b304 *R/utils.R
-4972408a7dec1623c9d00b2945f0f894 *README.md
+438b1342adbd6fc74092e2dd0b8d0499 *R/transition_probabilities.R
+ef88f74fe85ac74eec6bd37ddb2116b2 *R/utils.R
+725ec67436f98afd433693db94193e00 *README.md
 d41d8cd98f00b204e9800998ecf8427e *TODO
-5faf7c8e874e9d70d6487082bbab9f66 *build/vignette.rds
-9cc66fdfa47f4d84d5135a5ce319b0e6 *inst/doc/Examples.R
-628a7f7f8c321930c4f88dd110ea6235 *inst/doc/Examples.Rmd
-85a682a270d16c40833a39a3d28d29c7 *inst/doc/Examples.html
-024243645f25370493c9dd12c8bf3462 *man/cohort_simulation.Rd
-ad9613459ac80e38923cc5c2bc0ffbf7 *man/des-package.Rd
-26a8ad6f17a6b3e6460196bf065ee839 *man/length_of_stay.Rd
-8e44b822072ad501963e4493bc2673cc *man/msprep2.Rd
+2f05c1bf3d22113ebb6c9fcf010bb011 *build/vignette.rds
+26f953065122cd33ff110e10fdecf17b *inst/doc/Examples.R
+c28411b84a26af651d53480d3a39082b *inst/doc/Examples.Rmd
+8a615a4fd2ebfa52236d77aa5c18fc18 *inst/doc/Examples.html
+6b3f2cc5910bce7dfe286c5e106ddebb *man/cohort_simulation.Rd
+7db3576cf60e4e65a16117f021608430 *man/length_of_stay.Rd
+1ff74eeb09e7d3d6d1713dd83e3af696 *man/msprep2.Rd
 9e0ca400531a052050b92d9af7090f71 *man/multistateutils.Rd
-d0da921ccf2b76c3efe9d4574c2a6daa *man/plot_predicted_pathway.Rd
-b26a1f62e58b6ad983451db700f7d54d *man/predict_transitions.Rd
+a5727825046d69ecd638dfc32e12ec8b *man/plot_predicted_pathway.Rd
+27b90cf9061911ba15390514271257d4 *man/predict_transitions.Rd
 e3d3cb360fbfdb3c6974e14eb5f09870 *src/Makevars
 dafd74bc0ab6201ca5841bf709777eb4 *src/RcppExports.cpp
 7f3211520255214525d5f3b6031fe81d *src/des.cpp
 4f41451269f1eb10e8cf4589745c3b14 *src/event.cpp
 d9fe25cf905c2e202d85e1aeb727cfa1 *src/event.h
-650690aa8c5e5105d7980d4669067975 *src/simulation.cpp
+437adecc034a16fe7ab7735343e89a27 *src/simulation.cpp
 b06773afbb4393b539af4ccff2a68535 *src/simulation.h
-a1d9f6f2b63935121ffc8929fdac3320 *src/state.cpp
+493d4d4ec65764b7e5f02d5ea8e6e124 *src/state.cpp
 3b941394ca173084866651d88b048c39 *src/state.h
-af1dda94310ec07de93d3bcf46329686 *src/transitions.cpp
+d3989e9b9945dffc0cca614a00812188 *src/transitions.cpp
 969b36a01a2764a25d14d2e4a6201db8 *src/transitions.h
 7be2d05a7fdfd755745a8731b41b415a *tests/testthat.R
-a3f67a9ba2fdab67b01c5260835df546 *tests/testthat/test_cohort.R
-7bda022caecbcbf6a7557a8eb621eece *tests/testthat/test_lengthofstay.R
+69c11e70e491552b605f7d5874aef893 *tests/testthat/test_cohort.R
+d6381e6929a139f71170c5202ad5cfdf *tests/testthat/test_lengthofstay.R
 deb2f87b0b3b6fc268f091f9720ec019 *tests/testthat/test_msprep2.R
-6357f20861695d214c2e316ac0780483 *tests/testthat/test_transitionprobs.R
+e080ddbcb09e99211ed92e745b4e110b *tests/testthat/test_transitionprobs.R
 c2bd43e35bae9820cfb0df47dbc5b8ff *tests/testthat/test_utils.R
-628a7f7f8c321930c4f88dd110ea6235 *vignettes/Examples.Rmd
+c28411b84a26af651d53480d3a39082b *vignettes/Examples.Rmd
 dced1ef2ff01ec54d457df7ede8e6cda *vignettes/state_pathway.png
+73731be9e5634faf2854c0a8d1f3eb94 *vignettes/treatmentpathways.png
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,13 @@
+# multistateutils 1.2.2
+
+  - Fix for changes in data.table 1.12.1
+
+# multistateutils 1.2.1
+
+  - Added more examples
+  - Cleaned up build process
+  - Added GPL-3 licence and contributing information
+
 # multistateutils 1.2.0
 
   - Added `cohort_simulation` function to run discrete event simulation over populations

diff --git a/R/cohort.R b/R/cohort.R
@@ -12,27 +12,47 @@
 #' @param time_limit The maximum time to run the simulation for. If not provided then
 #'   the simulation runs until all the individuals have obtained a sink state.
 #' @return A data frame with state entry times for each individual.
+#' @examples
+#' library(multistateutils)
+#' library(mstate)
+#' library(flexsurv)
+#'
+#' # Convert data to long
+#' data(ebmt3)
+#' tmat <- trans.illdeath()
+#' long <- msprep(time=c(NA, 'prtime', 'rfstime'),
+#'                status=c(NA, 'prstat', 'rfsstat'),
+#'                data=ebmt3,
+#'                trans=tmat,
+#'                keep=c('age', 'dissub'))
+#'
+#' # Fit parametric models
+#' models <- lapply(1:3, function(i) {
+#'     flexsurvreg(Surv(time, status) ~ age + dissub, data=long, dist='weibull')
+#' })
+#'
+#' sim <- cohort_simulation(models, ebmt3, tmat)
 #' @export
 cohort_simulation <- function(models, newdata, trans_mat, start_time=0, start_state=1,
                               time_limit=NULL,
                               tcovs=NULL, M=1e3, ci=FALSE, ci_margin=0.95,
                               agelimit=FALSE, agecol='age', agescale=365.25) {
-    
+
     # Required by CRAN checks
     state <- NULL
     id <- NULL
     time <- NULL
-    
+
     if (ncol(trans_mat) != nrow(trans_mat)) {
         stop(paste0("Error: trans_mat has differing number of rows and columns (",
                     nrow(trans_mat), " and ",
                     ncol(trans_mat), ")."))
     }
 
     N <- nrow(newdata)
-    
+
     validate_oldage(agelimit, agecol, newdata)
-    
+
     newdata <- clean_newdata(newdata, models, agelimit, agecol)
 
     if (length(start_time) == 1)
@@ -55,7 +75,7 @@ cohort_simulation <- function(models, newdata, trans_mat, start_time=0, start_st
             stop("Error: time_limit must be a positive number.")
         if (time_limit <= 0)
             stop("Error: time_limit must be a positive number.")
-        
+
         incident_before_timelimit <- start_time <= time_limit
         newdata <- newdata[incident_before_timelimit, ]
         start_time <- start_time[incident_before_timelimit]
@@ -64,10 +84,10 @@ cohort_simulation <- function(models, newdata, trans_mat, start_time=0, start_st
 
     occupancy <- state_occupancy(models, trans_mat, newdata, tcovs, start_time,
                                  start_state, ci, M, agelimit, agecol, agescale)
-    
+
     if (!is.null(time_limit))
         occupancy <- occupancy[time <= time_limit]
-    
+
     # Add covariates
     clean <- data.table::as.data.table(newdata)[occupancy, on='id']
     setcolorder(clean, c('id', setdiff(names(clean), 'id')))

diff --git a/R/length_of_stay.R b/R/length_of_stay.R
@@ -17,31 +17,31 @@ calculate_los <- function(occupancy, start_state_names, times, ci, start_time=0)
     state <- NULL
     time <- NULL
     duration <- NULL
-    
+
     keys <- c('individual', 'id')
     los_keys <- c('individual', 'state')
     if (ci) {
-        keys <- c('simulation', keys) 
+        keys <- c('simulation', keys)
         los_keys <- c('simulation', los_keys)
     }
-    
+
     los <- data.table::rbindlist(lapply(stats::setNames(times, times), function(t) {
         data.table::rbindlist(lapply(stats::setNames(start_state_names, start_state_names), function(s) {
             # Filter to people in this starting state and remove state entries
             # that are after t
-            this_state <- merge(occupancy[state == s & time == start_time, keys, with=F], 
-                                occupancy[time <= t], 
+            this_state <- merge(occupancy[state == s & time == start_time, keys, with=F],
+                                occupancy[time <= t],
                                 on=keys)
-            
+
             # Add dummy state which replicates last known state at t and add back into main table
             early_exit <- copy(this_state[this_state[, .I[which.max(time)], by=keys]$V1][time < t])
             early_exit[ , time:= t ]
             full <- rbindlist(list(this_state, early_exit))[order(time)]
-            
+
             # Obtain time differences between each state transition
-            time_spent <- full[, .(state=get_state_entries(state), duration=diff(time)), 
+            time_spent <- full[, .(state=get_state_entries(state), duration=diff(time)),
                                by=keys]
-            
+
             # Sum up time spent in each state in case of multiple entries to same state
             time_spent[, duration := sum(duration), by=c(keys, 'state')]
             num_in_starting_state <- length(unique(time_spent$id))
@@ -54,40 +54,40 @@ calculate_los <- function(occupancy, start_state_names, times, ci, start_time=0)
 
 #' Estimates length of stay
 #'
-#' Estimates length of stay in each state of an individual's passage 
+#' Estimates length of stay in each state of an individual's passage
 #' through a multi-state model
 #' by discrete event simulation.
 #'
 #' @inheritParams predict_transitions
 #' @param start_state Starting state. Either number or character name in \code{trans_mat}.
 #' @param times Times at which to estimate length of stay.
 #' @return A data frame containing length of stay estimates.
-#' 
-#' @examples 
-#' 
+#'
+#' @examples
+#'
 #' library(multistateutils)
 #' library(mstate)
 #' library(flexsurv)
-#' 
+#'
 #' # Convert data to long
 #' data(ebmt3)
 #' tmat <- trans.illdeath()
-#' long <- msprep(time=c(NA, 'prtime', 'rfstime'), 
-#'                status=c(NA, 'prstat', 'rfsstat'), 
-#'                data=ebmt3, 
-#'                trans=tmat, 
+#' long <- msprep(time=c(NA, 'prtime', 'rfstime'),
+#'                status=c(NA, 'prstat', 'rfsstat'),
+#'                data=ebmt3,
+#'                trans=tmat,
 #'                keep=c('age', 'dissub'))
-#'                
+#'
 #' # Fit parametric models
 #' models <- lapply(1:3, function(i) {
 #'     flexsurvreg(Surv(time, status) ~ age + dissub, data=long, dist='weibull')
 #' })
-#' 
+#'
 #' # New individual to estimate transition probabilities for
 #' newdata <- data.frame(age="20-40", dissub="AML")
-#' 
+#'
 #' # Estimate length of stay in each state after a year, given starting in state 1
-#' length_of_stay(models, 
+#' length_of_stay(models,
 #'                newdata=newdata,
 #'                tmat, times=365.25,
 #'                start=1)
@@ -99,7 +99,7 @@ length_of_stay <- function(models, newdata, trans_mat, times, start_state=1,
                            tcovs=NULL, N=1e5, M=1e3, ci=FALSE,
                            ci_margin=0.95,
                            agelimit=FALSE, agecol='age', agescale=365.25) {
-    
+
     # Required by CRAN checks
     state <- NULL
     id <- NULL
@@ -109,35 +109,35 @@ length_of_stay <- function(models, newdata, trans_mat, times, start_state=1,
                     nrow(trans_mat), " and ",
                     ncol(trans_mat), ")."))
     }
-    
+
     if (!is.numeric(times) || any(times <= 0))
         stop("Error: times argument must be positive numeric.")
-    
+
     start_state <- validate_starting_state(start_state, trans_mat)
     validate_oldage(agelimit, agecol, newdata)
 
-    newdata_ext <- newdata[rep(seq(nrow(newdata)), each=N), ]
+    newdata_ext <- dplyr::slice(newdata, rep(seq(nrow(newdata)), each=N))
     start_states <- obtain_individual_starting_states(trans_mat, nrow(newdata), N)
     initial_times <- rep(0, nrow(newdata_ext))
-    
+
     # Calculate state occupancies
-    occupancy <- state_occupancy(models, trans_mat, newdata_ext, tcovs, initial_times, 
+    occupancy <- state_occupancy(models, trans_mat, newdata_ext, tcovs, initial_times,
                                  start_states, ci, M, agelimit, agecol, agescale)
-    
+
     # As with calculate_transition_probabilities, I'm making the assumption that all states
-    # are visited. This is useful as it means that don't need to worry about redefining 
+    # are visited. This is useful as it means that don't need to worry about redefining
     # the death_oldage state in every function
     state_names <- levels(occupancy$state)
     nstates <- length(state_names)
     start_state_names <- state_names[start_state]
-    
+
     # Add in key for individual
     individual_key <- data.table::data.table(id=seq(nrow(newdata_ext))-1,
                                              individual=rep(seq(nrow(newdata)), each=N)-1)
     occupancy <- individual_key[occupancy, on='id']
-    
+
     los <- calculate_los(occupancy, start_state_names, times, ci)
-    
+
     keys <- c('t', 'start_state', 'individual')
     form <- stats::as.formula(paste(paste(keys, collapse='+'), 'state', sep='~'))
     if (ci) {
@@ -149,28 +149,28 @@ length_of_stay <- function(models, newdata, trans_mat, times, start_state=1,
         ci_tail <- (1 - ci_margin) / 2
         ci_upper <- 1 - ci_tail
         ci_lower <- ci_tail
-        
+
         # Calculate summary values across simulations
-        los <- los[, .(los=mean(los), 
+        los <- los[, .(los=mean(los),
                            upper=stats::quantile(los, ci_upper),
-                           lower=stats::quantile(los, ci_lower)), 
+                           lower=stats::quantile(los, ci_lower)),
                        by=keys_with_state]
-        
+
         # Form wide tables with the estimate and CIs
         los_wide_mean <- dcast(los, form, value.var='los')
         los[, state := sprintf("%s_%0.1f", state, ci_upper*100)]
         los_wide_upper <- dcast(los, form, value.var='upper')
         los[, state := gsub("_[0-9\\.]+$", sprintf("_%0.1f", ci_lower*100), state)]
         los_wide_lower <- dcast(los, form, value.var='lower')
-        
+
         # Combine into one
-        los_wide <- merge(merge(los_wide_mean, los_wide_lower, by=keys), 
-                          los_wide_upper, 
+        los_wide <- merge(merge(los_wide_mean, los_wide_lower, by=keys),
+                          los_wide_upper,
                           by=keys)
     } else {
         los_wide <- dcast(los, form, value.var='los')
     }
-    
+
     # Set starting state in right level order and reorder the target state columns
     los_wide[, start_state := factor(start_state, levels=state_names)]
     end_state_names <- colnames(los_wide)[seq(length(keys)+1, ncol(los_wide))]
@@ -182,7 +182,7 @@ length_of_stay <- function(models, newdata, trans_mat, times, start_state=1,
                                         state_names))
     los_wide[, t := as.numeric(t)]
     setorder(los_wide, 't', 'start_state', 'individual')
-    
+
     # Add in columns for each covariate name to replace the single 'individual' column
     newd_key <- data.table::as.data.table(clean_newdata(newdata, models, agelimit, agecol))
     clean <- newd_key[los_wide, on=c('id'='individual')]