├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── rhub.yaml │ └── test-coverage.yaml ├── .gitignore ├── CRAN-SUBMISSION ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── S.R ├── baseHaz.R ├── bootSE.R ├── confint.mjoint.R ├── convMonitor.R ├── dynLong.R ├── dynSurv.R ├── epileptic.qol.R ├── fitted.mjoint.R ├── fixef.mjoint.R ├── formula.mjoint.R ├── generics.R ├── getVarCov.mjoint.R ├── heart.valve.R ├── hessian.R ├── initsLong.R ├── initsSurv.R ├── joineRML.R ├── logLik.mjoint.R ├── logpb.R ├── mjoint.R ├── mjoint.object.R ├── mvlme.R ├── pbc2.R ├── plot.dynLong.R ├── plot.dynSurv.R ├── plot.mjoint.R ├── plot.ranef.mjoint.R ├── plotConvergence.R ├── print.bootSE.R ├── print.dynLong.R ├── print.dynSurv.R ├── print.mjoint.R ├── print.summary.mjoint.R ├── process_newdata.R ├── ranef.mjoint.R ├── renal.R ├── residuals.mjoint.R ├── sampleData.R ├── sigma.mjoint.R ├── simData.R ├── stepEM.R ├── summary.mjoint.R ├── thetaDraw.R ├── tidiers.R └── vcov.mjoint.R ├── README.Rmd ├── README.md ├── codecov.yml ├── cran-comments.md ├── data-raw ├── qol │ ├── .Rapp.history │ ├── epileptic.qol.Rdata │ ├── prepare_data.R │ └── qol.csv └── renal │ ├── .Rapp.history │ ├── gfr_raw.csv │ ├── haem_raw.csv │ ├── prepare_data.R │ ├── prot_raw.csv │ └── renal.Rdata ├── data ├── epileptic.qol.rda ├── heart.valve.rda ├── pbc2.rda └── renal.rda ├── inst ├── CITATION └── image │ └── hex │ └── hex.R ├── joineRML.Rproj ├── man ├── .gitignore ├── baseHaz.Rd ├── bootSE.Rd ├── confint.mjoint.Rd ├── dynLong.Rd ├── dynSurv.Rd ├── epileptic.qol.Rd ├── figures │ └── hex.png ├── fitted.mjoint.Rd ├── fixef.mjoint.Rd ├── formula.mjoint.Rd ├── getVarCov.mjoint.Rd ├── heart.valve.Rd ├── joineRML-package.Rd ├── joineRML.Rd ├── logLik.mjoint.Rd ├── mjoint.Rd ├── mjoint.object.Rd ├── mjoint_tidiers.Rd ├── pbc2.Rd ├── plot.dynLong.Rd ├── plot.dynSurv.Rd ├── plot.mjoint.Rd ├── plot.ranef.mjoint.Rd ├── plotConvergence.Rd ├── ranef.mjoint.Rd ├── reexports.Rd ├── renal.Rd ├── residuals.mjoint.Rd ├── sampleData.Rd ├── sigma.mjoint.Rd ├── simData.Rd ├── summary.mjoint.Rd └── vcov.mjoint.Rd ├── revdep ├── README.md ├── cran.md ├── failures.md └── problems.md ├── src ├── .gitignore ├── Makevars ├── Makevars.win ├── RcppExports.cpp ├── expW.cpp ├── gammaUpdate.cpp ├── gammaUpdate_approx.cpp ├── lambdaUpdate.cpp └── mvnorm.cpp ├── tests ├── testthat.R └── testthat │ ├── Rplots.pdf │ ├── test-#59.R │ ├── test-ancillary.R │ ├── test-boot.R │ ├── test-inputs.R │ ├── test-models.R │ └── test-tidy.R └── vignettes ├── joineRML-tidy.Rmd ├── joineRML.Rmd ├── technical.Rnw └── technical.bib /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.png$ 5 | ^\.travis\.yml$ 6 | ^cran-comments\.md$ 7 | ^appveyor\.yml$ 8 | ^codecov\.yml$ 9 | inst/image 10 | ^data-raw$ 11 | ^doc$ 12 | ^Meta$ 13 | ^CRAN-RELEASE$ 14 | ^vignettes/joineRML-tidy_cache$ 15 | ^vignettes/joineRML_cache$ 16 | ^testing\.R$ 17 | ^\.github$ 18 | ^CRAN-SUBMISSION$ 19 | revdep 20 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: R-CMD-check.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: macos-latest, r: 'release'} 23 | - {os: windows-latest, r: 'release'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | 28 | env: 29 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 30 | R_KEEP_PKG_SOURCE: yes 31 | 32 | steps: 33 | - uses: actions/checkout@v4 34 | 35 | - uses: actions/checkout@v4 36 | - uses: r-lib/actions/setup-tinytex@v2 37 | - run: tlmgr --version 38 | 39 | - name: Install additional LaTeX packages 40 | run: | 41 | tlmgr update --self 42 | tlmgr install ae amsmath amsfonts grfext setspace enumitem hyperref biblatex 43 | tlmgr list --only-installed 44 | 45 | - uses: r-lib/actions/setup-pandoc@v2 46 | 47 | - uses: r-lib/actions/setup-r@v2 48 | with: 49 | r-version: ${{ matrix.config.r }} 50 | http-user-agent: ${{ matrix.config.http-user-agent }} 51 | use-public-rspm: true 52 | 53 | - uses: r-lib/actions/setup-r-dependencies@v2 54 | with: 55 | extra-packages: any::rcmdcheck 56 | needs: check 57 | 58 | - uses: r-lib/actions/check-r-package@v2 59 | with: 60 | upload-snapshots: true 61 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/actions/setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: r-hub/actions/checkout@v1 55 | - uses: r-hub/actions/platform-info@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | - uses: r-hub/actions/setup-deps@v1 60 | with: 61 | token: ${{ secrets.RHUB_TOKEN }} 62 | job-config: ${{ matrix.config.job-config }} 63 | - uses: r-hub/actions/run-check@v1 64 | with: 65 | token: ${{ secrets.RHUB_TOKEN }} 66 | job-config: ${{ matrix.config.job-config }} 67 | 68 | other-platforms: 69 | needs: setup 70 | if: ${{ needs.setup.outputs.platforms != '[]' }} 71 | runs-on: ${{ matrix.config.os }} 72 | name: ${{ matrix.config.label }} 73 | strategy: 74 | fail-fast: false 75 | matrix: 76 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 77 | 78 | steps: 79 | - uses: r-hub/actions/checkout@v1 80 | - uses: r-hub/actions/setup-r@v1 81 | with: 82 | job-config: ${{ matrix.config.job-config }} 83 | token: ${{ secrets.RHUB_TOKEN }} 84 | - uses: r-hub/actions/platform-info@v1 85 | with: 86 | token: ${{ secrets.RHUB_TOKEN }} 87 | job-config: ${{ matrix.config.job-config }} 88 | - uses: r-hub/actions/setup-deps@v1 89 | with: 90 | job-config: ${{ matrix.config.job-config }} 91 | token: ${{ secrets.RHUB_TOKEN }} 92 | - uses: r-hub/actions/run-check@v1 93 | with: 94 | job-config: ${{ matrix.config.job-config }} 95 | token: ${{ secrets.RHUB_TOKEN }} 96 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # 3 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 4 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 5 | on: 6 | push: 7 | branches: [main, master] 8 | pull_request: 9 | branches: [main, master] 10 | 11 | name: test-coverage 12 | 13 | jobs: 14 | test-coverage: 15 | runs-on: ubuntu-18.04 16 | env: 17 | RSPM: https://packagemanager.rstudio.com/cran/__linux__/bionic/latest 18 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 19 | 20 | steps: 21 | - uses: actions/checkout@v2 22 | 23 | - uses: r-lib/actions/setup-r@v1 24 | with: 25 | use-public-rspm: true 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v1 28 | with: 29 | extra-packages: covr 30 | 31 | - name: Test coverage 32 | run: covr::codecov() 33 | shell: Rscript {0} 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | # Session Data files 5 | .RData 6 | # Example code in package build process 7 | *-Ex.R 8 | # Output files from R CMD build 9 | /*.tar.gz 10 | # Output files from R CMD check 11 | /*.Rcheck/ 12 | # RStudio files 13 | .Rproj.user/ 14 | .Rproj 15 | .RData 16 | .Ruserdata 17 | # Produced vignettes 18 | vignettes/*.html 19 | vignettes/*.pdf 20 | vignettes/*.R 21 | inst/doc 22 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 23 | .httr-oauth 24 | # knitr and R markdown default cache directories 25 | /*_cache/ 26 | /cache/ 27 | # Temporary files created by R markdown 28 | *.utf8.md 29 | *.knit.md 30 | # Silence build of pkgdown update 31 | docs/*. 32 | # macOS files 33 | .DS_Store 34 | doc 35 | Meta 36 | vignettes/joineRML_cache/ 37 | vignettes/joineRML-tidy_cache/ 38 | .gitconfig 39 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.4.7 2 | Date: 2025-02-04 15:50:07 UTC 3 | SHA: 06ddf4c329c71fd33a8e625473bac3b38bd1ea8b 4 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: joineRML 2 | Type: Package 3 | Title: Joint Modelling of Multivariate Longitudinal Data and Time-to-Event 4 | Outcomes 5 | Version: 0.4.7 6 | Authors@R: c( 7 | person("Graeme L.", "Hickey", email = "graemeleehickey@gmail.com", 8 | role = c("cre", "aut"), 9 | comment = c(ORCID = "0000-0002-4989-0054")), 10 | person("Pete", "Philipson", email = "peter.philipson1@newcastle.ac.uk", 11 | role = "aut", 12 | comment = c(ORCID = "0000-0001-7846-0208")), 13 | person("Andrea", "Jorgensen", email = "aljorgen@liverpool.ac.uk", 14 | role = "ctb", 15 | comment = c(ORCID = "0000-0002-6977-9337")), 16 | person("Ruwanthi", "Kolamunnage-Dona", email = "kdrr@liverpool.ac.uk", 17 | role = "aut", 18 | comment = c(ORCID = "0000-0003-3886-6208")), 19 | person("Paula", "Williamson", email = "p.r.williamson@liverpool.ac.uk", 20 | role = "ctb", 21 | comment = c(ORCID = "0000-0001-9802-6636")), 22 | person("Dimitris", "Rizopoulos", email = "d.rizopoulos@erasmusmc.nl", 23 | role = c("ctb", "dtc"), 24 | comment = "data/renal.rda, R/hessian.R, R/vcov.R"), 25 | person("Alessandro", "Gasparini", email = "alessandro.gasparini@ki.se", 26 | role = "aut", 27 | comment = c(ORCID = "0000-0002-8319-7624")), 28 | person("Medical Research Council", role = "fnd", 29 | comment = "Grant number: MR/M013227/1") 30 | ) 31 | Encoding: UTF-8 32 | Description: Fits the joint model proposed by Henderson and colleagues (2000) 33 | , but extended to the case of multiple 34 | continuous longitudinal measures. The time-to-event data is modelled using a 35 | Cox proportional hazards regression model with time-varying covariates. The 36 | multiple longitudinal outcomes are modelled using a multivariate version of the 37 | Laird and Ware linear mixed model. The association is captured by a multivariate 38 | latent Gaussian process. The model is estimated using a Monte Carlo Expectation 39 | Maximization algorithm. This project was funded by the Medical Research Council 40 | (Grant number MR/M013227/1). 41 | License: GPL-3 | file LICENSE 42 | URL: https://github.com/graemeleehickey/joineRML 43 | BugReports: https://github.com/graemeleehickey/joineRML/issues 44 | LazyData: true 45 | Depends: 46 | R (>= 3.6.0), 47 | nlme, 48 | survival 49 | Imports: 50 | cobs, 51 | doParallel, 52 | foreach, 53 | generics, 54 | ggplot2, 55 | graphics, 56 | lme4 (>= 1.1-8), 57 | MASS, 58 | Matrix, 59 | mvtnorm, 60 | parallel, 61 | randtoolbox, 62 | Rcpp (>= 0.12.7), 63 | RcppArmadillo, 64 | stats, 65 | tibble, 66 | utils 67 | LinkingTo: 68 | Rcpp, 69 | RcppArmadillo 70 | RoxygenNote: 7.3.2 71 | Suggests: 72 | bindrcpp, 73 | dplyr, 74 | JM, 75 | joineR, 76 | knitr, 77 | rmarkdown, 78 | testthat 79 | VignetteBuilder: 80 | knitr 81 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(augment,mjoint) 4 | S3method(confint,mjoint) 5 | S3method(fitted,mjoint) 6 | S3method(fixef,mjoint) 7 | S3method(formula,mjoint) 8 | S3method(getVarCov,mjoint) 9 | S3method(glance,mjoint) 10 | S3method(logLik,mjoint) 11 | S3method(plot,dynLong) 12 | S3method(plot,dynSurv) 13 | S3method(plot,mjoint) 14 | S3method(plot,ranef.mjoint) 15 | S3method(print,bootSE) 16 | S3method(print,dynLong) 17 | S3method(print,dynSurv) 18 | S3method(print,mjoint) 19 | S3method(print,summary.mjoint) 20 | S3method(ranef,mjoint) 21 | S3method(residuals,mjoint) 22 | S3method(sigma,mjoint) 23 | S3method(summary,mjoint) 24 | S3method(tidy,mjoint) 25 | S3method(vcov,mjoint) 26 | export(augment) 27 | export(baseHaz) 28 | export(bootSE) 29 | export(dynLong) 30 | export(dynSurv) 31 | export(glance) 32 | export(mjoint) 33 | export(plotConvergence) 34 | export(sampleData) 35 | export(simData) 36 | export(tidy) 37 | import(foreach) 38 | import(ggplot2) 39 | import(graphics) 40 | import(stats) 41 | import(survival) 42 | importFrom(MASS,ginv) 43 | importFrom(MASS,mvrnorm) 44 | importFrom(Matrix,nearPD) 45 | importFrom(Rcpp,evalCpp) 46 | importFrom(RcppArmadillo,armadillo_reset_cores) 47 | importFrom(RcppArmadillo,armadillo_throttle_cores) 48 | importFrom(cobs,cobs) 49 | importFrom(doParallel,registerDoParallel) 50 | importFrom(generics,augment) 51 | importFrom(generics,glance) 52 | importFrom(generics,tidy) 53 | importFrom(graphics,par) 54 | importFrom(graphics,plot) 55 | importFrom(lme4,ranef) 56 | importFrom(mvtnorm,dmvnorm) 57 | importFrom(mvtnorm,rmvnorm) 58 | importFrom(mvtnorm,rmvt) 59 | importFrom(nlme,fixef) 60 | importFrom(nlme,getVarCov) 61 | importFrom(parallel,detectCores) 62 | importFrom(parallel,makeCluster) 63 | importFrom(parallel,stopCluster) 64 | importFrom(randtoolbox,halton) 65 | importFrom(randtoolbox,sobol) 66 | importFrom(stats,sigma) 67 | importFrom(utils,as.relistable) 68 | importFrom(utils,relist) 69 | importFrom(utils,stack) 70 | useDynLib(joineRML, .registration = TRUE) 71 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #' @keywords internal 5 | expWArma <- function(iz_, b_, gam, h_) { 6 | .Call(`_joineRML_expWArma`, iz_, b_, gam, h_) 7 | } 8 | 9 | #' @keywords internal 10 | gammaUpdate <- function(b_, z_, w_, pb_, haz, v_, h_, K, q, nev, jcount) { 11 | .Call(`_joineRML_gammaUpdate`, b_, z_, w_, pb_, haz, v_, h_, K, q, nev, jcount) 12 | } 13 | 14 | #' @keywords internal 15 | hazHat <- function(w_, pb_, nev) { 16 | .Call(`_joineRML_hazHat`, w_, pb_, nev) 17 | } 18 | 19 | #' @keywords internal 20 | gammaUpdate_approx <- function(b_, z_, w_, pb_, haz, v_, h_, K, q, nev) { 21 | .Call(`_joineRML_gammaUpdate_approx`, b_, z_, w_, pb_, haz, v_, h_, K, q, nev) 22 | } 23 | 24 | #' @keywords internal 25 | lambdaUpdate <- function(b_, imat_, zt_, pb_, v_, gam, gam_vec, q, nev, h_) { 26 | .Call(`_joineRML_lambdaUpdate`, b_, imat_, zt_, pb_, v_, gam, gam_vec, q, nev, h_) 27 | } 28 | 29 | #' @keywords internal 30 | mvrnormArma <- function(n, mu, sigma) { 31 | .Call(`_joineRML_mvrnormArma`, n, mu, sigma) 32 | } 33 | 34 | #' @keywords internal 35 | bSim <- function(n, Mean_, Sigma_) { 36 | .Call(`_joineRML_bSim`, n, Mean_, Sigma_) 37 | } 38 | 39 | -------------------------------------------------------------------------------- /R/S.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | S <- function(b, theta, data) { 3 | 4 | # NB: landmarking time recorded in 'data' 5 | 6 | r <- data$r 7 | q <- data$q 8 | v <- data$v 9 | Z.fail <- data$Z.fail 10 | IW.fail <- data$IW.fail 11 | tj.ind <- data$tj.ind 12 | 13 | gamma <- theta$gamma 14 | haz <- theta$haz 15 | 16 | if (length(b) != sum(r)) { 17 | stop("Incorrect length of b") 18 | } 19 | 20 | # Expanded gamma_y (repeated for each random effect term) 21 | if (q > 0) { 22 | gamma.scale <- diag(rep(gamma[-(1:q)], r), ncol = sum(r)) 23 | } else { 24 | gamma.scale <- diag(rep(gamma, r), ncol = sum(r)) 25 | } 26 | 27 | IZ <- t(IW.fail %*% Z.fail) 28 | W2 <- t(b) %*% gamma.scale %*% IZ 29 | if (q > 0) { 30 | W2 <- W2 + as.numeric(t(v) %*% gamma[1:q]) 31 | } 32 | W2 <- as.vector(W2) 33 | if (tj.ind > 0) { 34 | H <- sum(haz[1:tj.ind] * exp(W2)) 35 | } else { 36 | H <- 0 37 | } 38 | 39 | return(exp(-H)) 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/baseHaz.R: -------------------------------------------------------------------------------- 1 | #' The baseline hazard estimate of an \code{mjoint} object 2 | #' 3 | #' @description This function returns the (baseline) hazard increment from a 4 | #' fitted \code{mjoint} object. In addition, it can report either the 5 | #' \emph{uncentered} or the more ubiquitous \emph{centered} version. 6 | #' 7 | #' @inheritParams confint.mjoint 8 | #' @param centered logical: should the baseline hazard be for the mean-centered 9 | #' covariates model or not? Default is \code{centered=TRUE}. See 10 | #' \strong{Details}. 11 | #' @param se logical: should standard errors be approximated for the hazard 12 | #' increments? Default is \code{se=FALSE}. 13 | #' 14 | #' @details When covariates are included in the time-to-event sub-model, 15 | #' \code{\link{mjoint}} automatically centers them about their respective 16 | #' means. This also applies to non-continuous covariates, which are first 17 | #' coded using a dummy-transformation for the design matrix and subsequently 18 | #' centered. The reason for the mean-centering is to improve numerical 19 | #' stability, as the survival function involves exponential terms. Extracting 20 | #' the baseline hazard increments from \code{\link{mjoint.object}} returns the 21 | #' Breslow hazard estimate (Lin, 2007) that corresponds to this mean-centered 22 | #' model. This is the same as is done in the R \code{survival} package when 23 | #' using \code{\link[survival]{coxph.detail}} (Therneau and Grambsch, 2000). 24 | #' If the user wants to access the baseline hazard estimate for the model in 25 | #' which no mean-centering is applied, then they can use this function, which 26 | #' scales the mean-centered baseline hazard by 27 | #' 28 | #' \deqn{\exp\{-\bar{w}^\top \gamma_v\},} 29 | #' 30 | #' where \eqn{\bar{w}} is a vector of the means from the time-to-event 31 | #' sub-model design matrix. 32 | #' 33 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 34 | #' @keywords methods survival 35 | #' @seealso \code{\link{mjoint}} and \code{\link[stats]{coef}}. 36 | #' 37 | #' @references 38 | #' 39 | #' Therneau TM, Grambsch PM. \emph{Modeling Survival Data: Extending the Cox 40 | #' Model.} New Jersey: Springer-Verlag; 2000. 41 | #' 42 | #' Lin DY. On the Breslow estimator. \emph{Lifetime Data Anal.} 2007; 43 | #' \strong{13(4)}: 471-480. 44 | #' 45 | #' @return A \code{data.frame} with two columns: the unique failure times and 46 | #' the estimate baseline hazard. If \code{se=TRUE}, then a third column is 47 | #' appended with the corresponding standard errors (for the centred case). 48 | #' @export 49 | #' 50 | #' @examples 51 | #' 52 | #' \dontrun{ 53 | #' # Fit a joint model with bivariate longitudinal outcomes 54 | #' 55 | #' data(heart.valve) 56 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 57 | #' 58 | #' fit2 <- mjoint( 59 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 60 | #' "lvmi" = log.lvmi ~ time + sex), 61 | #' formLongRandom = list("grad" = ~ 1 | num, 62 | #' "lvmi" = ~ time | num), 63 | #' formSurv = Surv(fuyrs, status) ~ age, 64 | #' data = list(hvd, hvd), 65 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 66 | #' timeVar = "time", 67 | #' verbose = TRUE) 68 | #' baseHaz(fit2, centered = FALSE) 69 | #' } 70 | baseHaz <- function(object, centered = TRUE, se = FALSE) { 71 | 72 | if (!inherits(object, "mjoint")) { 73 | stop("Use only with 'mjoint' model objects.\n") 74 | } 75 | 76 | times <- object$dmats$t$tj 77 | haz <- object$coefficients$haz 78 | q <- object$dims$q 79 | nev <- object$dmats$t$nev 80 | 81 | if ((q == 0) && centered) { 82 | warning("No covariates in model to centre.\n") 83 | } 84 | 85 | if ((q > 0) && !centered) { 86 | xcenter <- object$dmats$t$xcenter 87 | gamma.v <- object$coefficients$gamma[1:q] 88 | haz <- haz * exp(-sum(xcenter * gamma.v)) 89 | } 90 | 91 | out <- data.frame("time" = times, "haz" = haz) 92 | 93 | if (se) { 94 | if (!centered) { 95 | stop("Can only estimate standard errors for the centered case.\n") 96 | } 97 | out$se <- 1 / sqrt(nev / (haz^2)) 98 | } 99 | 100 | return(out) 101 | 102 | } 103 | -------------------------------------------------------------------------------- /R/convMonitor.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | convMonitor <- function(theta, theta.new, log.lik, log.lik.new, con, verbose) { 3 | 4 | # Absolute parameter change 5 | absdelta.pars <- sapply(c("D", "beta", "sigma2", "gamma"), function(i) { 6 | theta[[i]] - theta.new[[i]] 7 | }) 8 | max.absdelta.pars <- max(abs(unlist(absdelta.pars))) 9 | cond1 <- (max.absdelta.pars < con$tol0) 10 | 11 | # Relative parameter change 12 | reldelta.pars <- sapply(c("D", "beta", "sigma2", "gamma"), function(i) { 13 | abs(theta[[i]] - theta.new[[i]]) / (abs(theta[[i]]) + con$tol1) 14 | }) 15 | max.reldelta.pars <- max(unlist(reldelta.pars)) 16 | cond2 <- (max.reldelta.pars < con$tol2) 17 | 18 | # Either parameter change satisfied 19 | cond3 <- (cond1 || cond2) 20 | 21 | # SAS criteria 22 | mag <- (abs(unlist(theta[-which(names(theta) == "haz")])) > con$rav) 23 | sasdelta <- function() { 24 | d1 <- unlist(absdelta.pars) < con$tol0 # abs 25 | d2 <- unlist(reldelta.pars) < con$tol2 # rel 26 | all(d1[!mag]) & all(d2[mag]) 27 | } 28 | cond4 <- sasdelta() 29 | 30 | # Absolute parameter change (excl. large terms): for reporting only 31 | max.absdelta.pars2 <- ifelse(any(!mag), max(unlist(absdelta.pars)[!mag]), NA) 32 | 33 | # Relative parameter change (excl. near-zero terms): for reporting only 34 | max.reldelta.pars2 <- ifelse(any(mag), max(unlist(reldelta.pars)[mag]), NA) 35 | 36 | # Log-likelihood: for reporting only 37 | rel.ll <- (log.lik.new - log.lik) / abs(log.lik + con$tol1) 38 | 39 | # Choose convergence criterion to use 40 | if (con$convCrit == "abs") { 41 | conv <- cond1 42 | } else if (con$convCrit == "rel") { 43 | conv <- cond2 44 | } else if (con$convCrit == "either") { 45 | conv <- cond3 46 | } else if (con$convCrit == "sas") { 47 | conv <- cond4 48 | } 49 | 50 | # Monitoring messages 51 | if (verbose) { 52 | cat(paste("Maximum absolute parameter change =", 53 | round(max.absdelta.pars, 6), "for", 54 | names(which.max(abs(unlist(absdelta.pars)))), "\n")) 55 | if (any(!mag)) { 56 | cat(paste(" ---> for parameters <", con$rav, "=", 57 | round(max.absdelta.pars2, 6), "for", 58 | names(which.max(abs(unlist(absdelta.pars)[!mag]))), "\n")) 59 | } 60 | cat(paste("Maximum relative parameter change =", 61 | round(max.reldelta.pars, 6), "for", 62 | names(which.max(abs(unlist(reldelta.pars)))), "\n")) 63 | if (any(mag)) { 64 | cat(paste(" ---> for parameters >=", con$rav, "=", 65 | round(max.reldelta.pars2, 6), "for", 66 | names(which.max(unlist(reldelta.pars)[mag])), "\n")) 67 | } 68 | cat(paste("Relative change in log-likelihood =", round(rel.ll, 6), "\n")) 69 | cat(paste("Converged:", conv, "\n\n")) 70 | } 71 | 72 | return(list("conv" = conv, 73 | "max.reldelta.pars" = max.reldelta.pars, 74 | "rel.ll" = rel.ll)) 75 | 76 | } 77 | -------------------------------------------------------------------------------- /R/epileptic.qol.R: -------------------------------------------------------------------------------- 1 | #' Quality of life data following epilepsy drug treatment 2 | #' 3 | #' @description The SANAD (Standard and New Antiepileptic Drugs) study (Marson 4 | #' et al., 2007) is a randomised control trial of standard and new 5 | #' antiepileptic drugs, comparing effects on longer term clinical outcomes. 6 | #' Quality of life (QoL) data were collected by mail at baseline, 3 months, 7 | #' and at 1 and 2 years using validated measures. This data is a subset of the 8 | #' trial for 544 patients randomised to one of 2 drugs: carbamazepine and 9 | #' lamotrigine. 10 | #' 11 | #' @usage data(epileptic.qol) 12 | #' @format A data frame with 1853 observations on the following 9 variables: 13 | #' \describe{ 14 | #' 15 | #' \item{\code{id}}{patients identifier; in total there are 544 patients.} 16 | #' 17 | #' \item{\code{with.time}}{number of days between registration and the earlier 18 | #' of treatment failure or study analysis time.} 19 | #' 20 | #' \item{\code{trt}}{a factor with levels \code{CBZ} and \code{LTG} denoting 21 | #' carbamazepine and lamotrigine, respectively.} 22 | #' 23 | #' \item{\code{with.status}}{the reason for treatment failure. Coded as 24 | #' \code{0=}censored; \code{1=}unacceptable adverse effects; 25 | #' \code{2=}inadequate seizure control.} 26 | #' 27 | #' \item{\code{time}}{the time the quality of life measures were recorded 28 | #' (days). The first measurement for each subject is the baseline measurement, 29 | #' however there was variability between the time taken to return the 30 | #' questionnaires; hence the reason this is non-zero. Similarly, the second, 31 | #' third, and fourth follow-up times, which were scheduled for 3-months, 32 | #' 1-year, and 2-years, respectively, also had variability in completion 33 | #' times.} 34 | #' 35 | #' \item{\code{anxiety}}{a continuous measure of anxiety, as defined according 36 | #' to the NEWQOL (Newly Diagnosed Epilepsy Quality of Life) assessment. Higher 37 | #' scores are indicative of worse QoL.} 38 | #' 39 | #' \item{\code{depress}}{a continuous measure of depression, as defined 40 | #' according to the NEWQOL (Newly Diagnosed Epilepsy Quality of Life) 41 | #' assessment. Higher scores are indicative of worse QoL.} 42 | #' 43 | #' \item{\code{aep}}{a continuous measure of the Liverpool Adverse Events 44 | #' Profile (AEP), as defined according to the NEWQOL (Newly Diagnosed Epilepsy 45 | #' Quality of Life) assessment. Higher scores are indicative of worse QoL.} 46 | #' 47 | #' \item{\code{with.status2}}{a binary indicator of composite treatment 48 | #' failure (for any reason), coded \code{status2=1}, or right-censoring 49 | #' \code{status2=0}.} 50 | #' 51 | #' } 52 | #' @keywords datasets 53 | #' @seealso \code{\link{pbc2}}, \code{\link{heart.valve}}, \code{\link{renal}}. 54 | #' @source SANAD Trial: University of Liverpool. See Jacoby et al. (2015). 55 | #' 56 | #' @references 57 | #' 58 | #' Jacoby A, Sudell M, Tudur Smith C, et al. Quality-of-life outcomes of 59 | #' initiating treatment with standard and newer antiepileptic drugs in adults 60 | #' with new-onset epilepsy: Findings from the SANAD trial. \emph{Epilepsia}. 61 | #' 2015; \strong{56(3)}: 460-472. 62 | #' 63 | #' Marson AG, Appleton R, Baker GA, et al. A randomised controlled trial 64 | #' examining longer-term outcomes of standard versus new antiepileptic drugs. 65 | #' The SANAD Trial. \emph{Health Technology Assessment}. 2007; \strong{11(37)}. 66 | #' 67 | #' Marson AG, Al-Kharusi AM, Alwaidh M, et al. The SANAD study of effectiveness 68 | #' of carbamazepine, gabapentin, lamotrigine, oxcarbazepine, or topiramate for 69 | #' treatment of partial epilepsy: an unblinded randomised controlled trial. 70 | #' \emph{Lancet}. 2007; \strong{365}: 2007-2013. 71 | #' 72 | #' Abetz L, Jacoby A, Baker GA, et al. Patient-based assessments of quality of 73 | #' life in newly diagnosed epilepsy patients: validation of the NEWQOL. 74 | #' \emph{Epilepsia}. 2000; \strong{41}: 1119-1128. 75 | "epileptic.qol" 76 | -------------------------------------------------------------------------------- /R/fitted.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract \code{mjoint} fitted values 2 | #' 3 | #' @description The fitted values at level \emph{i} are obtained by adding 4 | #' together the population fitted values (based only on the fixed effects 5 | #' estimates) and the estimated contributions of the random effects. 6 | #' 7 | #' @inheritParams confint.mjoint 8 | #' @param level an optional integer giving the level of grouping to be used in 9 | #' extracting the fitted values from object. Level values increase from outermost 10 | #' to innermost grouping, with level 0 corresponding to the population 11 | #' fitted values and level 1 corresponding to subject-specific fitted values Defaults 12 | #' to level 0. 13 | #' 14 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 15 | #' @keywords methods 16 | #' @seealso \code{\link{mjoint}}, \code{\link{residuals.mjoint}} 17 | #' 18 | #' @references 19 | #' 20 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 21 | #' Springer Verlag; 2000. 22 | #' 23 | #' @return A \code{list} of length \emph{K} with each element a vector of 24 | #' fitted values for the \emph{k}-th longitudinal outcome. 25 | #' @export 26 | fitted.mjoint <- function(object, level = 0, ...) { 27 | 28 | if (!inherits(object, "mjoint")) { 29 | stop("Use only with 'mjoint' model objects.\n") 30 | } 31 | 32 | dmats <- object$dmats 33 | if (is.null(dmats)) { 34 | stop("Need post fit statistics to calculate fitted values 35 | Re-run the model with 'pfs = TRUE'") 36 | } 37 | 38 | beta <- object$coefficients$beta 39 | Eb <- as.data.frame(object$Eb) 40 | 41 | p <- object$dims$p 42 | r <- object$dims$r 43 | K <- object$dims$K 44 | nik <- object$dmats$l$nik 45 | 46 | Y <- object$dmats$l$yi 47 | X <- object$dmats$l$Xi 48 | Z <- object$dmats$l$Zi 49 | 50 | Xbeta <- lapply(X, function(x) { 51 | x %*% beta 52 | }) 53 | Eb.list <- lapply(rownames(Eb), function(x) { 54 | Eb[x, ] 55 | }) 56 | Zb <- mapply(function(b, z) { 57 | z %*% t(b) 58 | }, 59 | b = Eb.list, z = Z) 60 | 61 | if (level == 0) { 62 | ri <- Xbeta 63 | } else if (level == 1) { 64 | ri <- mapply(function(y, yhat, z) { 65 | yhat + z 66 | }, 67 | yhat = Xbeta, z = Zb) 68 | } else { 69 | stop(paste("Unknown level selected:", level)) 70 | } 71 | 72 | fvals <- list() 73 | index <- lapply(nik, function(n) { 74 | c(0, cumsum(n)) 75 | }) 76 | for (k in 1:K) { 77 | fvals[[k]] <- mapply(function(x, i) { 78 | x[(i[k] + 1):(i[k + 1])] 79 | }, 80 | x = ri, i = index) 81 | } 82 | fvals <- lapply(fvals, unlist) 83 | if (!is.null(object$formLongFixed)) { 84 | names(fvals) <- names(object$formLongFixed) 85 | } 86 | 87 | return(fvals) 88 | 89 | } 90 | -------------------------------------------------------------------------------- /R/fixef.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract fixed effects estimates from an \code{mjoint} object 2 | #' 3 | #' @description Extract fixed effects estimates from an \code{mjoint} object. 4 | #' 5 | #' @inheritParams confint.mjoint 6 | #' @param process character string: if \code{process='Longitudinal'} the fixed 7 | #' effects coefficients from the (multivariate) longitudinal sub-model are 8 | #' returned. Else, if \code{process='Event'}, the coefficients from the 9 | #' time-to-event sub-model are returned. 10 | #' 11 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 12 | #' @keywords methods 13 | #' @seealso \code{\link[nlme]{fixef}} for the generic method description, and 14 | #' \code{\link{ranef.mjoint}}. 15 | #' 16 | #' @references 17 | #' 18 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 19 | #' Springer Verlag; 2000. 20 | #' 21 | #' Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 22 | #' measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 23 | #' 24 | #' @return A named vector of length equal to the number of sub-model 25 | #' coefficients estimated. 26 | #' @importFrom nlme fixef 27 | #' @export 28 | #' 29 | #' @examples 30 | #' \dontrun{ 31 | #' # Fit a classical univariate joint model with a single longitudinal outcome 32 | #' # and a single time-to-event outcome 33 | #' 34 | #' data(heart.valve) 35 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 36 | #' 37 | #' set.seed(1) 38 | #' fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 39 | #' formLongRandom = ~ time | num, 40 | #' formSurv = Surv(fuyrs, status) ~ age, 41 | #' data = hvd, 42 | #' timeVar = "time", 43 | #' control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 44 | #' 45 | #' fixef(fit1, process = "Longitudinal") 46 | #' fixef(fit1, process = "Event") 47 | #' } 48 | #' 49 | #' \dontrun{ 50 | #' # Fit a joint model with bivariate longitudinal outcomes 51 | #' 52 | #' data(heart.valve) 53 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 54 | #' 55 | #' fit2 <- mjoint( 56 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 57 | #' "lvmi" = log.lvmi ~ time + sex), 58 | #' formLongRandom = list("grad" = ~ 1 | num, 59 | #' "lvmi" = ~ time | num), 60 | #' formSurv = Surv(fuyrs, status) ~ age, 61 | #' data = list(hvd, hvd), 62 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 63 | #' timeVar = "time", 64 | #' verbose = TRUE) 65 | #' 66 | #' fixef(fit2, process = "Longitudinal") 67 | #' fixef(fit2, process = "Event") 68 | #' } 69 | fixef.mjoint <- function(object, process = c("Longitudinal", "Event"), ...) { 70 | 71 | if (!inherits(object, "mjoint")) { 72 | stop("Use only with 'mjoint' model objects.\n") 73 | } 74 | 75 | process <- match.arg(process) 76 | if (process == "Longitudinal") { 77 | object$coefficients$beta 78 | } else { 79 | object$coefficients$gamma 80 | } 81 | 82 | } 83 | -------------------------------------------------------------------------------- /R/formula.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract model formulae from an \code{mjoint} object 2 | #' 3 | #' @description Extract model formulae from an \code{mjoint} object. 4 | #' 5 | #' @inheritParams confint.mjoint 6 | #' @param x an object inheriting from class \code{mjoint} for a joint model of 7 | #' time-to-event and multivariate longitudinal data. 8 | #' @param process character string: if \code{process='Longitudinal'} a fixed 9 | #' effects formula from the (multivariate) longitudinal sub-model is returned 10 | #' for the \code{k}-th outcome. Else, if \code{process='Event'}, the 11 | #' time-to-event model formula is returned. 12 | #' @param k integer: a number between 1 and \emph{K} (the total number of 13 | #' longitudinal outcomes) that specifies the longitudinal outcome of interest. 14 | #' 15 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 16 | #' @keywords methods 17 | #' @seealso \code{\link[stats]{formula}} for the generic method description, and 18 | #' \code{\link{ranef.mjoint}}. 19 | #' 20 | #' @references 21 | #' 22 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 23 | #' Springer Verlag; 2000. 24 | #' 25 | #' Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 26 | #' measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 27 | #' 28 | #' @return An object of class "formula" which contains a symbolic model formula 29 | #' for the separate sub-model fixed effect terms only. 30 | #' @export 31 | formula.mjoint <- function(x, process = c("Longitudinal", "Event"), k = 1, ...) { 32 | 33 | if (!inherits(x, "mjoint")) { 34 | stop("Use only with 'mjoint' model objects.\n") 35 | } 36 | 37 | K <- x$dims$K 38 | process <- match.arg(process) 39 | 40 | formOut <- NULL 41 | 42 | if (process == "Longitudinal") { 43 | if (is.null(k) || is.na(k)) { 44 | stop("Must specify a longitudinal outcome.") 45 | } 46 | if (k > K) { 47 | stop("Incompatible with dimensions of the joint model.") 48 | } 49 | formOut <- x$formLongFixed[[k]] 50 | } else { 51 | formOut <- x$formSurv 52 | } 53 | 54 | class(formOut) <- "formula" 55 | formOut 56 | 57 | } 58 | -------------------------------------------------------------------------------- /R/generics.R: -------------------------------------------------------------------------------- 1 | #' @importFrom generics augment 2 | #' @export 3 | generics::augment 4 | 5 | #' @importFrom generics glance 6 | #' @export 7 | generics::glance 8 | 9 | #' @importFrom generics tidy 10 | #' @export 11 | generics::tidy 12 | -------------------------------------------------------------------------------- /R/getVarCov.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract variance-covariance matrix of random effects from an \code{mjoint} 2 | #' object 3 | #' 4 | #' @description Extract variance-covariance matrix of random effects from an 5 | #' \code{mjoint} object. 6 | #' 7 | #' @param obj an object inheriting from class \code{mjoint} for a joint model of 8 | #' time-to-event and multivariate longitudinal data. 9 | #' @inheritParams confint.mjoint 10 | #' 11 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 12 | #' @keywords methods 13 | #' @seealso \code{\link[nlme]{getVarCov}} for the generic method description. 14 | #' 15 | #' @references 16 | #' 17 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 18 | #' Springer Verlag; 2000. 19 | #' 20 | #' @return A variance-covariance matrix. 21 | #' @importFrom nlme getVarCov 22 | #' @export 23 | #' 24 | #' @examples 25 | #' \dontrun{ 26 | #' # Fit a joint model with bivariate longitudinal outcomes 27 | #' 28 | #' data(heart.valve) 29 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 30 | #' 31 | #' fit2 <- mjoint( 32 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 33 | #' "lvmi" = log.lvmi ~ time + sex), 34 | #' formLongRandom = list("grad" = ~ 1 | num, 35 | #' "lvmi" = ~ time | num), 36 | #' formSurv = Surv(fuyrs, status) ~ age, 37 | #' data = list(hvd, hvd), 38 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 39 | #' timeVar = "time", 40 | #' verbose = TRUE) 41 | #' 42 | #' getVarCov(fit2) 43 | #' } 44 | getVarCov.mjoint <- function(obj, ...) { 45 | 46 | if (!inherits(obj, "mjoint")) { 47 | stop("Use only with 'mjoint' model objects.\n") 48 | } 49 | 50 | out <- obj$coefficients$D 51 | attr(out, "group.levels") <- obj$id 52 | 53 | class(out) <- c("random.effects", "VarCov") 54 | out 55 | 56 | } 57 | -------------------------------------------------------------------------------- /R/heart.valve.R: -------------------------------------------------------------------------------- 1 | #' Aortic valve replacement surgery data 2 | #' 3 | #' @description This is longitudinal data on an observational study on detecting 4 | #' effects of different heart valves, differing on type of tissue, implanted 5 | #' in the aortic position. The data consists of longitudinal measurements on 6 | #' three different heart function outcomes, after surgery occurred. There are 7 | #' several baseline covariates available, and also survival data. 8 | #' 9 | #' @usage data(heart.valve) 10 | #' @format This is a data frame in the unbalanced format, that is, with one row 11 | #' per observation. The data consists in columns for patient identification, 12 | #' time of measurements, longitudinal multiple longitudinal measurements, 13 | #' baseline covariates, and survival data. The column names are identified as 14 | #' follows: \describe{ 15 | #' 16 | #' \item{\code{num}}{number for patient identification.} 17 | #' 18 | #' \item{\code{sex}}{gender of patient (\code{0=}Male and \code{1=}Female).} 19 | #' 20 | #' \item{\code{age}}{age of patient at day of surgery (years).} 21 | #' 22 | #' \item{\code{time}}{observed time point, with surgery date as the time 23 | #' origin (years).} 24 | #' 25 | #' \item{\code{fuyrs}}{maximum follow up time, with surgery date as the time 26 | #' origin (years).} 27 | #' 28 | #' \item{\code{status}}{censoring indicator (\code{1=}died and \code{0=}lost 29 | #' at follow up).} 30 | #' 31 | #' \item{\code{grad}}{valve gradient at follow-up visit.} 32 | #' 33 | #' \item{\code{log.grad}}{natural log transformation of \code{grad}.} 34 | #' 35 | #' \item{\code{lvmi}}{left ventricular mass index (standardised) at follow-up 36 | #' visit.} 37 | #' 38 | #' \item{\code{log.lvmi}}{natural log transformation of \code{lvmi}.} 39 | #' 40 | #' \item{\code{ef}}{ejection fraction at follow-up visit.} 41 | #' 42 | #' \item{\code{bsa}}{preoperative body surface area.} 43 | #' 44 | #' \item{\code{lvh}}{preoperative left ventricular hypertrophy.} 45 | #' 46 | #' \item{\code{prenyha}}{preoperative New York Heart Association (NYHA) 47 | #' classification (\code{1=}I/II and \code{3=}III/IV).} 48 | #' 49 | #' \item{\code{redo}}{previous cardiac surgery.} 50 | #' 51 | #' \item{\code{size}}{size of the valve (millimeters).} 52 | #' 53 | #' \item{\code{con.cabg}}{concomitant coronary artery bypass graft.} 54 | #' 55 | #' \item{\code{creat}}{preoperative serum creatinine (\eqn{\mu}mol/mL).} 56 | #' 57 | #' \item{\code{dm}}{preoperative diabetes.} 58 | #' 59 | #' \item{\code{acei}}{preoperative use of ace inhibitor.} 60 | #' 61 | #' \item{\code{lv}}{preoperative left ventricular ejection fraction (LVEF) 62 | #' (\code{1=}good, \code{2=}moderate, and \code{3=}poor).} 63 | #' 64 | #' \item{\code{emergenc}}{operative urgency (\code{0=}elective, \code{1 = 65 | #' }urgent, and \code{3=}emergency).} 66 | #' 67 | #' \item{\code{hc}}{preoperative high cholesterol (\code{0=}absent, \code{1 68 | #' =}present treated, and \code{2=}present untreated).} 69 | #' 70 | #' \item{\code{sten.reg.mix}}{aortic valve haemodynamics (\code{1=}stenosis, 71 | #' \code{2=}regurgitation, \code{3=}mixed).} 72 | #' 73 | #' \item{\code{hs}}{implanted aortic prosthesis type (\code{1=}homograft and 74 | #' \code{0=}stentless porcine tissue).} 75 | #' 76 | #' } 77 | #' @keywords datasets 78 | #' @seealso \code{\link{pbc2}}, \code{\link{renal}}, 79 | #' \code{\link{epileptic.qol}}. 80 | #' @references 81 | #' 82 | #' Lim E, Ali A, Theodorou P, Sousa I, Ashrafian H, Chamageorgakis T, Duncan M, 83 | #' Diggle P, Pepper J. A longitudinal study of the profile and predictors of 84 | #' left ventricular mass regression after stentless aortic valve replacement. 85 | #' \emph{Ann Thorac Surg.} 2008; \strong{85(6)}: 2026-2029. 86 | "heart.valve" 87 | -------------------------------------------------------------------------------- /R/hessian.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | hessian <- function(theta, l, t, z, m) { 3 | 4 | # MLE parameter estimates from EM algorithm 5 | D <- theta$D 6 | beta <- theta$beta 7 | sigma2 <- theta$sigma2 8 | haz <- theta$haz 9 | gamma <- theta$gamma 10 | 11 | # Multivariate longitudinal data 12 | yi <- l$yi 13 | Xi <- l$Xi 14 | Zi <- l$Zi 15 | Zit <- l$Zit 16 | nik <- l$nik 17 | yik <- l$yik 18 | Xik.list <- l$Xik.list 19 | Zik.list <- l$Zik.list 20 | p <- l$p # vector of fixed effect dims 21 | r <- l$r # vector of random effect dims 22 | K <- l$K # number of longitudinal markers 23 | n <- l$n # number of subjects 24 | nk <- l$nk # vector of number of observations per outcome 25 | 26 | # Time-to-event data 27 | V <- t$V 28 | survdat2 <- t$survdat2 29 | survdat2.list <- t$survdat2.list 30 | q <- t$q 31 | nev <- t$nev 32 | nev.uniq <- t$nev.uniq 33 | 34 | # Covariate data for W(u, b) 35 | Zi.fail <- z$Zi.fail 36 | Zit.fail <- z$Zit.fail 37 | IW.fail <- z$IW.fail 38 | 39 | # MCEM calculations 40 | Sigmai.inv <- m$Sigmai.inv 41 | Eb <- m$Eb 42 | EbbT <- m$EbbT 43 | bi.y <- m$bi.y 44 | expvstargam <- m$expvstargam 45 | pb.yt <- m$pb.yt 46 | haz.hat <- m$haz.hat 47 | 48 | #***************************************************** 49 | # Complete data score components 50 | #***************************************************** 51 | 52 | # beta 53 | 54 | sbeta <- mapply(function(x, sinv, y, z, b) { 55 | (t(x) %*% sinv) %*% (y - x %*% beta - z %*% b) 56 | }, 57 | x = Xi, sinv = Sigmai.inv, y = yi, z = Zi, b = Eb, 58 | SIMPLIFY = TRUE) 59 | 60 | rownames(sbeta) <- names(beta) 61 | 62 | #----------------------------------------------------- 63 | 64 | # D 65 | 66 | Dinv <- solve(D) 67 | 68 | D.inds <- which(lower.tri(D, diag = TRUE), arr.ind = TRUE) 69 | dimnames(D.inds) <- NULL 70 | 71 | delta.D <- lapply(1:nrow(D.inds), function(x, ind) { 72 | mat <- matrix(0, nrow = nrow(D), ncol = ncol(D)) 73 | ii <- ind[x, , drop = FALSE] 74 | mat[ii[1], ii[2]] <- mat[ii[2], ii[1]] <- 1 75 | mat 76 | }, ind = D.inds[, 2:1, drop = FALSE]) 77 | 78 | term1 <- sapply(delta.D, function(d) { 79 | -0.5 * sum(diag(Dinv %*% d)) 80 | }) 81 | 82 | sDi <- function(i) { 83 | mapply(function(b, pb) { 84 | out <- 0.5 * crossprod(b, b * pb) %*% (Dinv %*% delta.D[[i]] %*% Dinv) / nrow(b) 85 | term1[i] + sum(diag(out)) 86 | }, 87 | b = bi.y, pb = pb.yt, 88 | SIMPLIFY = TRUE) 89 | } 90 | 91 | sD <- sapply(1:nrow(D.inds), sDi) 92 | sD <- t(sD) 93 | rownames(sD) <- paste0("D", D.inds[, 1], ",", D.inds[, 2]) 94 | 95 | #----------------------------------------------------- 96 | 97 | # gamma 98 | 99 | sgamma <- gammaUpdate_approx(bi.y, Zit.fail, expvstargam, pb.yt, haz.hat, 100 | V, survdat2.list, K, q, nev.uniq)$scorei 101 | 102 | rownames(sgamma) <- names(gamma) 103 | 104 | #----------------------------------------------------- 105 | 106 | # sigma2 107 | 108 | beta.inds <- cumsum(c(0, p)) 109 | b.inds <- cumsum(c(0, r)) 110 | 111 | ssigma2 <- matrix(nrow = K, ncol = n) 112 | for (k in 1:K) { 113 | beta.k <- beta[(beta.inds[k] + 1):(beta.inds[k + 1])] 114 | ssigma2[k, ] <- mapply(function(y, x, z, b, b2, nik) { 115 | b.k <- b[(b.inds[k] + 1):(b.inds[k + 1])] 116 | bbT.k <- b2[(b.inds[k] + 1):(b.inds[k + 1]), (b.inds[k] + 1):(b.inds[k + 1])] 117 | residFixed <- (y - x %*% beta.k) 118 | resids <- t(residFixed) %*% (residFixed - 2*(z %*% b.k)) + sum(diag(crossprod(z) %*% bbT.k)) 119 | (-0.5 * nik[k] / sigma2[k]) + (0.5 * resids / sigma2[k]^2) 120 | }, 121 | y = yik[[k]], x = Xik.list[[k]], z = Zik.list[[k]], b = Eb, b2 = EbbT, nik = nik) 122 | } 123 | 124 | rownames(ssigma2) <- paste0("sigma2_", 1:K) 125 | 126 | #----------------------------------------------------- 127 | 128 | si <- rbind(sD, sbeta, ssigma2, sgamma) 129 | 130 | H <- matrix(0, nrow(si), nrow(si)) 131 | for (j in 1:ncol(si)) { 132 | H <- H + tcrossprod(si[, j]) 133 | } 134 | # Although RHS term = 0 in theory, in practice with MC integration 135 | # not all terms are vanishingly small, so we add it in 136 | H <- H - (rowSums(si) %*% t(rowSums(si))) / ncol(si) 137 | rownames(H) <- colnames(H) <- rownames(si) 138 | 139 | return(H) 140 | 141 | } 142 | -------------------------------------------------------------------------------- /R/initsLong.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | initsLong <- function(lfit, inits, l, z, K, p, r, tol.em, verbose) { 3 | 4 | D <- Matrix::bdiag(lapply(lfit, function(u) matrix(nlme::getVarCov(u), 5 | dim(nlme::getVarCov(u))))) 6 | D <- as.matrix(D) 7 | D.names <- c() 8 | for (k in 1:K) { 9 | D.names.k <- paste0(rownames(nlme::getVarCov(lfit[[k]])), "_", k) 10 | D.names <- c(D.names, D.names.k) 11 | } 12 | rownames(D) <- colnames(D) <- D.names 13 | 14 | beta <- do.call("c", lapply(lfit, fixef)) 15 | names(beta) <- paste0(names(beta), "_", rep(1:K, p)) 16 | 17 | sigma2 <- unlist(lapply(lfit, function(u) u$sigma))^2 18 | 19 | if ((K > 1) && !all(c("beta", "D", "sigma2") %in% names(inits))) { 20 | message("Running multivariate LMM EM algorithm to establish initial parameters...") 21 | out <- mvlme(thetaLong = list("beta" = beta, "D" = D, "sigma2" = sigma2), 22 | l = l, z = z, tol.em = tol.em, verbose = verbose) 23 | message("Finished multivariate LMM EM algorithm...") 24 | } else { 25 | out <- list("D" = D, "beta" = beta, "sigma2" = sigma2) 26 | } 27 | 28 | # over-ride with user-specified inits 29 | if ("beta" %in% names(inits)) { 30 | if (length(inits$beta) != sum(p)) { 31 | stop("Dimension of beta inits does not match model.") 32 | } 33 | beta <- inits$beta 34 | names(beta) <- names(out[["beta"]]) 35 | out[["beta"]] <- beta 36 | } 37 | if ("D" %in% names(inits)) { 38 | if (nrow(inits$D) != sum(r)) { 39 | stop("Dimension of D inits does not match model.") 40 | } 41 | is.posdef <- all(eigen(inits$D)$values > 0) 42 | if (is.posdef) { 43 | D <- inits$D 44 | rownames(D) <- colnames(D) <- rownames(out[["D"]]) 45 | out[["D"]] <- D 46 | } else { 47 | warning("Initial parameter matrix D is non positive definite: falling back to automated value") 48 | } 49 | } 50 | if ("sigma2" %in% names(inits)) { 51 | sigma2 <- inits$sigma2 52 | if (length(sigma2) != K) { 53 | stop("Dimension of sigma2 inits does not match model.") 54 | } 55 | names(sigma2) <- paste0("sigma2_", 1:K) 56 | out[["sigma2"]] <- sigma2 57 | } 58 | 59 | return(out) 60 | 61 | } 62 | -------------------------------------------------------------------------------- /R/initsSurv.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | initsSurv_balanced <- function(data, lfit, survdat2, formSurv, id, timeVar, K, q) { 3 | 4 | W <- matrix(nrow = nrow(data[[1]]), ncol = K) 5 | for (k in 1:K) { 6 | XbetaZb <- predict(lfit[[k]], level = 1) 7 | Xbeta <- predict(lfit[[k]], level = 0) 8 | W[, k] <- XbetaZb - Xbeta 9 | } 10 | colnames(W) <- paste0("gamma_", 1:K) 11 | 12 | dataAG <- by(data[[1]], data[[1]][ , id], FUN = function(u) { 13 | id.col <- u[ , id] 14 | T <- survdat2[survdat2$id == id.col[1], "T"] + 1e-06 15 | start <- u[ , timeVar[k]] 16 | stop <- c(u[, timeVar[k]][-1], T) 17 | status <- rep(0, length(id.col)) 18 | status[length(id.col)] <- survdat2[survdat2$id == id.col[1], "delta"] 19 | if (q > 0) { 20 | X <- survdat2[survdat2$id == id.col[1], 2:(q + 1), drop = FALSE] 21 | X <- X[rep(1, length(id.col)), ] 22 | if (q == 1) { 23 | X <- matrix(X, ncol = 1) 24 | } 25 | colnames(X) <- names(survdat2)[2:(q + 1)] 26 | } 27 | if (q > 0) { 28 | data.frame("id" = id.col, start, stop, status, X) 29 | } else { 30 | data.frame("id" = id.col, start, stop, status) 31 | } 32 | }) 33 | dataAG <- do.call("rbind", dataAG) 34 | dataAG <- cbind(dataAG, W) 35 | 36 | formK <- paste0("gamma_", 1:K, collapse = " + ") 37 | if (q > 0) { 38 | formX <- paste0(names(survdat2)[2:(q + 1)], collapse = " + ") 39 | formS <- paste("Surv(start, stop, status) ~ ", formX, "+", formK) 40 | } else { 41 | formS <- paste("Surv(start, stop, status) ~", formK) 42 | } 43 | fitAG <- survival::coxph(as.formula(formS), data = dataAG) 44 | 45 | gamma <- coef(fitAG) 46 | haz <- survival::coxph.detail(fitAG)$hazard 47 | 48 | return(list("gamma" = gamma, "haz" = haz)) 49 | 50 | } 51 | 52 | 53 | #' @keywords internal 54 | initsSurv_unbalanced <- function(sfit, K, q) { 55 | 56 | # Internal function for generating initial parameters for the survival 57 | # sub-model when the data are *unbalanced*, i.e. longitudinal outcomes can be 58 | # measured at different times and frequencies within a patient 59 | 60 | # hazard 61 | if (q > 0) { 62 | haz <- survival::coxph.detail(sfit)$hazard 63 | } else { 64 | sfit.start <- survival::survfit(sfit) 65 | haz <- with(sfit.start, n.event / n.risk) 66 | haz <- haz[sfit.start$n.event > 0] 67 | } 68 | 69 | # gamma 70 | if (q > 0) { 71 | gamma.v <- coef(sfit) 72 | } else { 73 | gamma.v <- NULL 74 | } 75 | gamma.y <- rep(0, K) 76 | names(gamma.y) <- paste0(rep("gamma", K), "_", 1:K) 77 | gamma <- c(gamma.v, gamma.y) 78 | 79 | return(list("gamma" = gamma, "haz" = haz)) 80 | 81 | } 82 | 83 | 84 | #' @keywords internal 85 | initsSurv <- function(data, lfit, sfit, survdat2, formSurv, id, timeVar, K, q, 86 | balanced, inits) { 87 | 88 | # Internal function for generating initial parameters for the survival 89 | # sub-model when the data are *unbalanced*, i.e. longitudinal outcomes can be 90 | # measured at different times and frequencies within a patient 91 | 92 | if (balanced & !("gamma" %in% names(inits))) { 93 | inits.surv <- initsSurv_balanced( 94 | data = data, lfit = lfit, survdat2 = survdat2, formSurv = formSurv, 95 | id = id, timeVar = timeVar, K = K, q = q) 96 | } else { 97 | if (!("gamma" %in% names(inits))) { 98 | message("Data are unbalanced... using sub-optimal initial parameters for gamma") 99 | } 100 | inits.surv <- initsSurv_unbalanced(sfit = sfit, K = K, q = q) 101 | } 102 | 103 | # over-ride with user-specified inits 104 | if ("gamma" %in% names(inits)) { 105 | gamma <- inits$gamma 106 | if (length(gamma) != (q + K)) { 107 | stop("Dimension of gamma inits does not match model.") 108 | } 109 | names(gamma) <- names(inits.surv[["gamma"]]) 110 | inits.surv[["gamma"]] <- gamma 111 | } 112 | if ("haz" %in% names(inits)) { 113 | inits.surv[["haz"]] <- inits$haz 114 | } 115 | 116 | return(inits.surv) 117 | 118 | } 119 | -------------------------------------------------------------------------------- /R/joineRML.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | #' @name joineRML 4 | #' @title joineRML 5 | #' 6 | #' @description joineRML is an extension of the joineR package for fitting joint 7 | #' models of time-to-event data and multivariate longitudinal data. The model 8 | #' fitted in joineRML is an extension of the Wulfsohn and Tsiatis (1997) and 9 | #' Henderson et al. (2000) models, which is comprised on 10 | #' \eqn{(K+1)}-sub-models: a Cox proportional hazards regression model (Cox, 11 | #' 1972) and a \emph{K}-variate linear mixed-effects model - a direct 12 | #' extension of the Laird and Ware (1982) regression model. The model is 13 | #' fitted using a Monte Carlo Expectation-Maximization (MCEM) algorithm, which 14 | #' closely follows the methodology presented by Lin et al. (2002). 15 | #' 16 | #' @useDynLib joineRML, .registration = TRUE 17 | #' @importFrom Rcpp evalCpp 18 | #' @importFrom RcppArmadillo armadillo_throttle_cores armadillo_reset_cores 19 | #' 20 | #' @references 21 | #' Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 22 | #' measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 23 | #' 24 | #' Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 25 | #' measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 26 | #' 465-480. 27 | #' 28 | #' Cox DR. Regression models and life-tables. \emph{J R Stat Soc Ser B Stat 29 | #' Methodol.} 1972; \strong{34(2)}: 187-220. 30 | #' 31 | #' Laird NM, Ware JH. Random-effects models for longitudinal data. 32 | #' \emph{Biometrics.} 1982; \strong{38(4)}: 963-974. 33 | NULL -------------------------------------------------------------------------------- /R/logLik.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract log-likelihood from an \code{mjoint} object 2 | #' 3 | #' @description Extract log-likelihood from an \code{mjoint} object. 4 | #' 5 | #' @inheritParams confint.mjoint 6 | #' 7 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 8 | #' @keywords methods 9 | #' @seealso \code{\link[stats]{logLik}} for the generic method description. 10 | #' 11 | #' @references 12 | #' 13 | #' Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 14 | #' measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 15 | #' 465-480. 16 | #' 17 | #' @return Returns an object of class \code{logLik}. This is a number with two 18 | #' attributes: \code{df} (degrees of freedom), giving the number of parameters 19 | #' in the model, and \code{nobs}, the number of observations used in 20 | #' estimation. 21 | #' @export 22 | #' 23 | #' @examples 24 | #' \dontrun{ 25 | #' # Fit a joint model with bivariate longitudinal outcomes 26 | #' 27 | #' data(heart.valve) 28 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 29 | #' fit2 <- mjoint( 30 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 31 | #' "lvmi" = log.lvmi ~ time + sex), 32 | #' formLongRandom = list("grad" = ~ 1 | num, 33 | #' "lvmi" = ~ time | num), 34 | #' formSurv = Surv(fuyrs, status) ~ age, 35 | #' data = list(hvd, hvd), 36 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 37 | #' timeVar = "time", 38 | #' verbose = TRUE) 39 | #' 40 | #' logLik(fit2) 41 | #' } 42 | logLik.mjoint <- function(object, ...) { 43 | 44 | if (!inherits(object, "mjoint")) { 45 | stop("Use only with 'mjoint' model objects.\n") 46 | } 47 | 48 | out <- object$log.lik 49 | attr(out, "df") <- with(object$dims, sum(p) + q + 2*K + (sum(r) * (sum(r) + 1)) / 2) 50 | attr(out, "nobs") <- sum(object$dims$nk) 51 | 52 | class(out) <- "logLik" 53 | out 54 | 55 | } 56 | -------------------------------------------------------------------------------- /R/logpb.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @importFrom mvtnorm dmvnorm 3 | logpb <- function(b, theta, data) { 4 | 5 | r <- data$r 6 | q <- data$q 7 | K <- data$K 8 | nk <- data$nk 9 | y <- data$y 10 | X <- data$X 11 | Z <- data$Z 12 | v <- data$v 13 | Z.fail <- data$Z.fail 14 | IW.fail <- data$IW.fail 15 | tj.ind <- data$tj.ind 16 | 17 | beta <- theta$beta 18 | gamma <- theta$gamma 19 | sigma2 <- theta$sigma2 20 | haz <- theta$haz 21 | D <- theta$D 22 | if (sum(r) == 1) { 23 | D <- as.matrix(D) 24 | } 25 | 26 | if (length(b) != sum(r)) { 27 | stop("Incorrect length of b") 28 | } 29 | 30 | # Expanded gamma_y (repeated for each random effect term) 31 | if (q > 0) { 32 | gamma.scale <- diag(rep(gamma[-(1:q)], r), ncol = sum(r)) 33 | } else { 34 | gamma.scale <- diag(rep(gamma, r), ncol = sum(r)) 35 | } 36 | 37 | # f(b | theta) 38 | pb <- mvtnorm::dmvnorm(b, mean = rep(0, sum(r)), sigma = D, log = TRUE) 39 | 40 | # f(y | b, theta) 41 | XbetaZb <- as.vector((X %*% beta) + (Z %*% b)) 42 | Sigma <- diag(x = rep(sigma2, nk), ncol = sum(nk)) 43 | py.b <- mvtnorm::dmvnorm(y, mean = XbetaZb, sigma = Sigma, log = TRUE) 44 | 45 | # f(T > t | b, theta) 46 | IZ <- t(IW.fail %*% Z.fail) 47 | W2 <- t(b) %*% gamma.scale %*% IZ 48 | if (q > 0) { 49 | W2 <- W2 + as.numeric(t(v) %*% gamma[1:q]) 50 | } 51 | W2 <- as.vector(W2) 52 | if (tj.ind > 0) { 53 | pt.b <- -sum(haz[1:tj.ind] * exp(W2)) 54 | } else { 55 | pt.b <- 0 # obs times before failure time => survival prob = 1 56 | } 57 | 58 | out <- pt.b + py.b + pb 59 | return(out) 60 | 61 | } 62 | 63 | 64 | #' @keywords internal 65 | b_mode <- function(theta, data) { 66 | 67 | out <- optim(par = rep(0, sum(data$r)), 68 | fn = logpb, 69 | theta = theta, 70 | data = data, 71 | control = list(fnscale = -1), 72 | method = "BFGS", 73 | hessian = TRUE) 74 | 75 | return(out) 76 | 77 | } 78 | 79 | 80 | #' @keywords internal 81 | b_metropolis <- function(theta.samp, delta.prop, sigma.prop, b.curr, data.t) { 82 | 83 | accept <- 0 84 | 85 | # Draw b from proposal distribution 86 | b.prop <- mvtnorm::rmvt(n = 1, 87 | delta = delta.prop, 88 | sigma = sigma.prop, 89 | df = 4) 90 | b.prop <- as.vector(b.prop) 91 | 92 | # Metropolis-Hastings acceptance 93 | log.a1 <- logpb(b.prop, theta.samp, data.t) - logpb(b.curr, theta.samp, data.t) 94 | 95 | dens.curr <- mvtnorm::dmvt(x = b.curr, 96 | delta = delta.prop, 97 | sigma = sigma.prop, 98 | df = 4, 99 | log = TRUE) 100 | dens.prop <- mvtnorm::dmvt(x = b.prop, 101 | delta = delta.prop, 102 | sigma = sigma.prop, 103 | df = 4, 104 | log = TRUE) 105 | log.a2 <- dens.curr - dens.prop 106 | a <- min(exp(log.a1 - log.a2), 1) 107 | randu <- runif(1) 108 | if (randu <= a) { 109 | b.curr <- b.prop 110 | accept <- 1 111 | } 112 | 113 | 114 | out <- list("b.curr" = b.curr, "accept" = accept) 115 | return(out) 116 | 117 | } 118 | 119 | -------------------------------------------------------------------------------- /R/mvlme.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | mvlme <- function(thetaLong, l, z, tol.em, verbose) { 3 | 4 | # Multivariate longitudinal data 5 | yi <- l$yi 6 | Xi <- l$Xi 7 | XtX.inv <- l$XtX.inv 8 | Xtyi <- l$Xtyi 9 | XtZi <- l$XtZi 10 | Zi <- l$Zi 11 | Zit <- l$Zit 12 | nik <- l$nik 13 | yik <- l$yik 14 | Xik.list <- l$Xik.list 15 | Zik.list <- l$Zik.list 16 | n <- l$n # number of subjects 17 | p <- l$p # vector of fixed effect dims 18 | r <- l$r # vector of random effect dims 19 | K <- l$K # number of longitudinal markers 20 | nk <- l$nk # vector of number of observations per outcome 21 | 22 | delta <- 1 23 | while (delta > tol.em) { 24 | 25 | # Input parameter estimates 26 | D <- thetaLong$D 27 | beta <- thetaLong$beta 28 | sigma2 <- thetaLong$sigma2 29 | 30 | #***************************************************** 31 | # E-step 32 | #***************************************************** 33 | 34 | # Inverse-Sigma_i (error precision matrix; diagonal matrix) 35 | Sigmai.inv <- lapply(nik, function(i) { 36 | diag(x = rep(1 / sigma2, i), ncol = sum(i)) 37 | }) 38 | 39 | # MVN covariance matrix for [b | y] 40 | Dinv <- solve(D) 41 | Ai <- mapply(FUN = function(zt, s, z) { 42 | solve((zt %*% s %*% z) + Dinv) 43 | }, 44 | z = Zi, zt = Zit, s = Sigmai.inv, 45 | SIMPLIFY = FALSE) 46 | 47 | # MVN mean vector for [y | b] 48 | Eb <- mapply(function(a, z, s, y, X) { 49 | as.vector(a %*% (z %*% s %*% (y - X %*% beta))) 50 | }, 51 | a = Ai, z = Zit, s = Sigmai.inv, y = yi, X = Xi, 52 | SIMPLIFY = FALSE) 53 | 54 | # E[bb^T] 55 | EbbT <- mapply(function(v, e) { 56 | v + tcrossprod(e) 57 | }, 58 | v = Ai, e = Eb, 59 | SIMPLIFY = FALSE) 60 | 61 | #***************************************************** 62 | # M-step starts here 63 | #***************************************************** 64 | 65 | # D 66 | D.new <- Reduce("+", EbbT) / n 67 | rownames(D.new) <- colnames(D.new) <- rownames(D) 68 | 69 | #----------------------------------------------------- 70 | 71 | # beta 72 | rr <- mapply(function(x1, x2, b) { 73 | x1 - (x2 %*% b) 74 | }, 75 | x1 = Xtyi, x2 = XtZi, b = Eb) 76 | rr.sum <- rowSums(rr) 77 | 78 | beta.new <- as.vector(XtX.inv %*% rr.sum) 79 | names(beta.new) <- names(beta) 80 | 81 | #----------------------------------------------------- 82 | 83 | # sigma_k^2 84 | beta.inds <- cumsum(c(0, p)) 85 | b.inds <- cumsum(c(0, r)) 86 | sigma2.new <- vector(length = K) 87 | 88 | for (k in 1:K) { 89 | beta.k <- beta.new[(beta.inds[k] + 1):(beta.inds[k + 1])] 90 | SSq <- mapply(function(y, x, z, b, b2) { 91 | b.k <- b[(b.inds[k] + 1):(b.inds[k + 1])] 92 | bbT.k <- b2[(b.inds[k] + 1):(b.inds[k + 1]), (b.inds[k] + 1):(b.inds[k + 1])] 93 | residFixed <- (y - x %*% beta.k) 94 | t(residFixed) %*% (residFixed - 2*(z %*% b.k)) + sum(diag(crossprod(z) %*% bbT.k)) 95 | }, 96 | y = yik[[k]], x = Xik.list[[k]], z = Zik.list[[k]], b = Eb, b2 = EbbT) 97 | sigma2.new[k] <- sum(SSq) / nk[[k]] 98 | } 99 | 100 | names(sigma2.new) <- paste0("sigma2_", 1:K) 101 | 102 | 103 | #----------------------------------------------------- 104 | 105 | thetaLong.new <- list("D" = D.new, "beta" = beta.new, "sigma2" = sigma2.new) 106 | 107 | # Relative parameter change 108 | delta <- sapply(c("D", "beta", "sigma2"), function(i) { 109 | abs(thetaLong[[i]] - thetaLong.new[[i]]) / (abs(thetaLong[[i]]) + 1e-03) 110 | }) 111 | delta <- max(unlist(delta)) 112 | 113 | thetaLong <- thetaLong.new 114 | 115 | if (verbose) { 116 | print(thetaLong.new) 117 | } 118 | 119 | } 120 | 121 | return(thetaLong.new) 122 | 123 | } 124 | -------------------------------------------------------------------------------- /R/pbc2.R: -------------------------------------------------------------------------------- 1 | #' Mayo Clinic primary biliary cirrhosis data 2 | #' 3 | #' @description This data is from the Mayo Clinic trial in primary biliary 4 | #' cirrhosis (PBC) of the liver conducted between 1974 and 1984. A total of 5 | #' 424 PBC patients, referred to Mayo Clinic during that ten-year interval met 6 | #' eligibility criteria for the randomized placebo controlled trial of the 7 | #' drug D-penicillamine, but only the first 312 cases in the data set 8 | #' participated in the randomized trial. Therefore, the data here are for the 9 | #' 312 patients with largely complete data. 10 | #' 11 | #' @usage data(pbc2) 12 | #' @format A data frame with 1945 observations on the following 20 variables: 13 | #' \describe{ 14 | #' 15 | #' \item{\code{id}}{patients identifier; in total there are 312 patients.} 16 | #' 17 | #' \item{\code{years}}{number of years between registration and the earlier of 18 | #' death, transplantation, or study analysis time.} 19 | #' 20 | #' \item{\code{status}}{a factor with levels \code{alive}, \code{transplanted} 21 | #' and \code{dead}.} 22 | #' 23 | #' \item{\code{drug}}{a factor with levels \code{placebo} and 24 | #' \code{D-penicil}.} 25 | #' 26 | #' \item{\code{age}}{at registration in years.} 27 | #' 28 | #' \item{\code{sex}}{a factor with levels \code{male} and \code{female}.} 29 | #' 30 | #' \item{\code{year}}{number of years between enrollment and this visit date, 31 | #' remaining values on the line of data refer to this visit.} 32 | #' 33 | #' \item{\code{ascites}}{a factor with levels \code{No} and \code{Yes}.} 34 | #' 35 | #' \item{\code{hepatomegaly}}{a factor with levels \code{No} and \code{Yes}.} 36 | #' 37 | #' \item{\code{spiders}}{a factor with levels \code{No} and \code{Yes}.} 38 | #' 39 | #' \item{\code{edema}}{a factor with levels \code{No edema} (i.e. no edema and 40 | #' no diuretic therapy for edema), \code{edema no diuretics} (i.e. edema 41 | #' present without diuretics, or edema resolved by diuretics), and 42 | #' \code{edema despite diuretics} (i.e. edema despite diuretic therapy).} 43 | #' 44 | #' \item{\code{serBilir}}{serum bilirubin in mg/dl.} 45 | #' 46 | #' \item{\code{serChol}}{serum cholesterol in mg/dl.} 47 | #' 48 | #' \item{\code{albumin}}{albumin in mg/dl.} 49 | #' 50 | #' \item{\code{alkaline}}{alkaline phosphatase in U/liter.} 51 | #' 52 | #' \item{\code{SGOT}}{SGOT in U/ml.} 53 | #' 54 | #' \item{\code{platelets}}{platelets per cubic ml/1000.} 55 | #' 56 | #' \item{\code{prothrombin}}{prothrombin time in seconds.} 57 | #' 58 | #' \item{\code{histologic}}{histologic stage of disease.} 59 | #' 60 | #' \item{\code{status2}}{a numeric vector with the value 1 denoting if the 61 | #' patient was dead, and 0 if the patient was alive or transplanted.} 62 | #' 63 | #' } 64 | #' @keywords datasets 65 | #' @seealso \code{\link{heart.valve}}, \code{\link{renal}}, 66 | #' \code{\link{epileptic.qol}}. 67 | #' @source \code{\link[JM]{pbc2}} and \code{\link[survival]{pbc}}. 68 | #' @references 69 | #' 70 | #' Fleming T, Harrington D. \emph{Counting Processes and Survival Analysis}. 71 | #' 1991; New York: Wiley. 72 | #' 73 | #' Therneau T, Grambsch P. \emph{Modeling Survival Data: Extending the Cox 74 | #' Model}. 2000; New York: Springer-Verlag. 75 | "pbc2" 76 | -------------------------------------------------------------------------------- /R/plot.dynLong.R: -------------------------------------------------------------------------------- 1 | #' Plot a \code{dynLong} object 2 | #' 3 | #' @description Plots the conditional longitudinal expectations for a 4 | #' \emph{new} subject calculated using the \code{\link{dynLong}} function. 5 | #' 6 | #' @param x an object of class \code{dynLong} calculated by the 7 | #' \code{\link{dynLong}} function. 8 | #' @inheritParams plot.dynSurv 9 | #' @param ylab a character vector of the titles for the \emph{K} longitudinal 10 | #' outcomes y-axes: see \code{\link[graphics]{title}}. 11 | #' 12 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 13 | #' @keywords hplot 14 | #' @seealso \code{\link{dynLong}} 15 | #' 16 | #' @references 17 | #' 18 | #' Rizopoulos D. Dynamic predictions and prospective accuracy in joint models 19 | #' for longitudinal and time-to-event data. \emph{Biometrics}. 2011; 20 | #' \strong{67}: 819–829. 21 | #' 22 | #' @return A dynamic prediction plot. 23 | #' @import graphics 24 | #' @export 25 | #' 26 | #' @examples 27 | #' \dontrun{ 28 | #' # Fit a joint model with bivariate longitudinal outcomes 29 | #' 30 | #' data(heart.valve) 31 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 32 | #' 33 | #' fit2 <- mjoint( 34 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 35 | #' "lvmi" = log.lvmi ~ time + sex), 36 | #' formLongRandom = list("grad" = ~ 1 | num, 37 | #' "lvmi" = ~ time | num), 38 | #' formSurv = Surv(fuyrs, status) ~ age, 39 | #' data = list(hvd, hvd), 40 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 41 | #' timeVar = "time", 42 | #' verbose = TRUE) 43 | #' 44 | #' hvd2 <- droplevels(hvd[hvd$num == 1, ]) 45 | #' out <- dynLong(fit2, hvd2) 46 | #' plot(out, main = "Patient 1") 47 | #' } 48 | plot.dynLong <- function(x, main = NULL, xlab = NULL, ylab = NULL, 49 | grid = TRUE, estimator, ...) { 50 | 51 | if (!inherits(x, "dynLong")) { 52 | stop("Use only with 'dynLong' objects.\n") 53 | } 54 | 55 | # Extract information we need 56 | fit <- x$fit 57 | pred <- x$pred 58 | newdata <- x$newdata 59 | data.t <- x$data.t 60 | 61 | # Set-up the plotting grid 62 | old.par <- par(no.readonly = TRUE) 63 | K <- fit$dims$K 64 | par(mfrow = c(K, 1), mar = c(0, 4.5, 0, 2), oma = c(4, 0, 3, 0)) 65 | 66 | if (!is.null(ylab)) { 67 | if (length(ylab) != K) { 68 | stop("Number of longitudinal axes labels does not match number of outcomes.\n") 69 | } 70 | } 71 | 72 | # Fine control plotting arguments 73 | lwd <- 1 74 | cex <- 1 75 | if (!missing(...)) { 76 | dots <- list(...) 77 | if ("lwd" %in% names(dots)) { 78 | lwd <- dots[["lwd"]] 79 | } 80 | if ("cex" %in% names(dots)) { 81 | cex <- dots[["cex"]] 82 | } 83 | } 84 | 85 | ylimfun <- function(k) { 86 | if (x$type == "first-order") { 87 | ylim <- range(data.t$yk[[k]], pred[[k]][, 2]) 88 | } 89 | if (x$type == "simulated") { 90 | ylim <- range(data.t$yk[[k]], min(pred[[k]]$lower), max(pred[[k]]$upper)) 91 | } 92 | return(ylim) 93 | } 94 | 95 | # Plot longitudinal markers (extrapolated) 96 | for (k in 1:K) { 97 | xpts <- pred[[k]]$time 98 | if (x$type == "first-order") { 99 | ypts <- pred[[k]]$y.pred 100 | } else if (x$type == "simulated") { 101 | if (missing(estimator) || estimator == "median") { 102 | ypts <- pred[[k]]$median 103 | } else if (estimator == "mean") { 104 | ypts <- pred[[k]]$mean 105 | } else { 106 | stop("estimator must be equal to 'mean' or 'median'\n") 107 | } 108 | } 109 | plot(xpts, ypts, 110 | type = "l", 111 | col = "red", 112 | xlim = c(0, data.t$tmax), 113 | ylim = ylimfun(k), 114 | ylab = ifelse(is.null(ylab), toString(formula(fit$lfit[[k]])[[2]]), 115 | ylab[[k]]), 116 | las = 1, 117 | xaxt = "n", 118 | lwd = lwd) 119 | if (x$type == "simulated") { # CIs for MC simulated predictions only 120 | polygon(x = c(xpts, rev(xpts)), 121 | y = c(pred[[k]]$lower, rev(pred[[k]]$upper)), 122 | col = "lightgrey", 123 | border = "lightgrey", 124 | lwd = 2) 125 | lines(xpts, ypts, col = "red", lwd = lwd) 126 | } 127 | if (k == K) { 128 | axis(1) 129 | } 130 | lines(x = data.t$tk[[k]], 131 | y = data.t$yk[[k]], 132 | col = "blue", 133 | lwd = lwd) 134 | points(x = data.t$tk[[k]], 135 | y = data.t$yk[[k]], 136 | pch = 8, 137 | #xpd = TRUE, 138 | col = "red", 139 | cex = cex) 140 | if (grid) { 141 | grid() 142 | } 143 | abline(v = data.t$tobs, col = "darkgrey", lty = "dotted", lwd = 3) 144 | } 145 | 146 | # Axis labels 147 | mtext(main, 3, 148 | line = 1, outer = TRUE, font = 2, cex = 1.3) 149 | mtext(ifelse(is.null(xlab), "Time", xlab), 1, 150 | line = 2.5, outer = TRUE) 151 | 152 | on.exit(par(old.par)) 153 | 154 | } 155 | -------------------------------------------------------------------------------- /R/plot.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Plot diagnostics from an \code{mjoint} object 2 | #' 3 | #' @description Plot diagnostics from an \code{mjoint} object. 4 | #' 5 | #' @param x an object inheriting from class \code{mjoint} for a joint model of 6 | #' time-to-event and multivariate longitudinal data. 7 | #' @param type currently the only option is \code{type='convergence'} for 8 | #' graphical examination of convergence over MCEM iteration. 9 | #' @param ... other parameters passed to \code{\link{plotConvergence}}. 10 | #' 11 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 12 | #' @keywords methods dplot 13 | #' @seealso \code{\link[graphics]{plot.default}}, \code{\link[graphics]{par}}, 14 | #' \code{\link[graphics]{abline}}. 15 | #' 16 | #' @export 17 | #' 18 | #' @examples 19 | #' \dontrun{ 20 | #' # Fit a classical univariate joint model with a single longitudinal outcome 21 | #' # and a single time-to-event outcome 22 | #' 23 | #' data(heart.valve) 24 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 25 | #' 26 | #' set.seed(1) 27 | #' fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 28 | #' formLongRandom = ~ time | num, 29 | #' formSurv = Surv(fuyrs, status) ~ age, 30 | #' data = hvd, 31 | #' timeVar = "time", 32 | #' control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 33 | #' 34 | #' plot(fit1, param = "beta") # LMM fixed effect parameters 35 | #' plot(fit1, param = "gamma") # event model parameters 36 | #' } 37 | #' 38 | #' \dontrun{ 39 | #' # Fit a joint model with bivariate longitudinal outcomes 40 | #' 41 | #' data(heart.valve) 42 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 43 | #' 44 | #' fit2 <- mjoint( 45 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 46 | #' "lvmi" = log.lvmi ~ time + sex), 47 | #' formLongRandom = list("grad" = ~ 1 | num, 48 | #' "lvmi" = ~ time | num), 49 | #' formSurv = Surv(fuyrs, status) ~ age, 50 | #' data = list(hvd, hvd), 51 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 52 | #' timeVar = "time", 53 | #' control = list(burnin = 50), 54 | #' verbose = TRUE) 55 | #' 56 | #' plot(fit2, type = "convergence", params = "gamma") 57 | #' } 58 | plot.mjoint <- function(x, type = "convergence", ...) { 59 | 60 | if (!inherits(x, "mjoint")) { 61 | stop("Use only with 'mjoint' model objects.\n") 62 | } 63 | 64 | if (type == "convergence") { 65 | plotConvergence(x, ...) 66 | } 67 | 68 | } 69 | -------------------------------------------------------------------------------- /R/plot.ranef.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Plot a \code{ranef.mjoint} object 2 | #' 3 | #' @description Displays a plot of the BLUPs and approximate 95\% prediction 4 | #' interval for each subject. 5 | #' 6 | #' @param x an object inheriting from class \code{ranef.mjoint}, representing 7 | #' the estimated random effects for the \code{mjoint} object from which it was 8 | #' produced. 9 | #' @inheritParams confint.mjoint 10 | #' 11 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 12 | #' @keywords methods 13 | #' @seealso \code{\link{ranef.mjoint}}. 14 | #' 15 | #' @references 16 | #' 17 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 18 | #' Springer Verlag; 2000. 19 | #' 20 | #' @return an object inheriting from class \code{ggplot}, which displays a 21 | #' trellis plot with a separate panel for each effect, showing a dotplot (with 22 | #' optional error bars indicating approximate 95\% prediction intervals if the 23 | #' argument \code{postVar=TRUE} is set in the call to 24 | #' \code{\link[nlme]{ranef}}) for each subject (by row). 25 | #' @import ggplot2 26 | #' @importFrom utils stack 27 | #' @export 28 | #' 29 | #' @examples 30 | #' \dontrun{ 31 | #' require(ggplot2) 32 | #' data(heart.valve) 33 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 34 | #' set.seed(1) 35 | #' 36 | #' fit1 <- mjoint(formLongFixed = log.lvmi ~ time, 37 | #' formLongRandom = ~ time | num, 38 | #' formSurv = Surv(fuyrs, status) ~ 1, 39 | #' data = hvd, 40 | #' timeVar = "time") 41 | #' 42 | #' plot(ranef(fit1, postVar = TRUE)) 43 | #' } 44 | plot.ranef.mjoint <- function(x, ...) { 45 | 46 | if (!inherits(x, "ranef.mjoint")) { 47 | stop("Use only with 'ranef.mjoint' objects.\n") 48 | } 49 | 50 | xstk <- utils::stack(x) 51 | xstk$subject <- rep(rownames(x), ncol(x)) 52 | 53 | ranef.vars <- attr(x, "postVar") 54 | if (!is.null(ranef.vars)) { 55 | if (is.array(ranef.vars)) { 56 | ses <- sqrt(apply(ranef.vars, 3, diag)) 57 | ses <- as.data.frame(t(ses)) 58 | ses <- utils::stack(ses) 59 | xstk$se <- ses$values 60 | } else { 61 | xstk$se <- sqrt(ranef.vars) 62 | } 63 | xstk$xmin <- with(xstk, values - 1.96 * se) 64 | xstk$xmax <- with(xstk, values + 1.96 * se) 65 | } 66 | 67 | p <- ggplot(aes(x = .data$values, y = .data$subject), data = xstk) + 68 | geom_point() + 69 | facet_grid(~ ind, scales = "free_x") 70 | 71 | if (!is.null(xstk$se)) { 72 | p <- p + geom_errorbarh(aes(xmin = .data$xmin, xmax = .data$xmax), 73 | height = 0) 74 | } 75 | 76 | return(p) 77 | 78 | } 79 | -------------------------------------------------------------------------------- /R/plotConvergence.R: -------------------------------------------------------------------------------- 1 | #' Plot convergence time series for parameter vectors from an \code{mjoint} 2 | #' object 3 | #' 4 | #' @description Plot convergence time series for parameter vectors from an 5 | #' \code{mjoint} object. 6 | #' 7 | #' @inheritParams confint.mjoint 8 | #' @param params a string indicating what parameters are to be shown. Options 9 | #' are \code{params='gamma'} for the time-to-event sub-model covariate 10 | #' coefficients, including the latent association parameters; 11 | #' \code{params='beta'} for the longitudinal sub-model fixed effects 12 | #' coefficients; \code{params='sigma2'} for the residual error variances from 13 | #' the longitudinal sub-model; \code{params='D'} for the lower triangular 14 | #' matrix of the variance-covariance matrix of random effects; 15 | #' \code{params='loglik'} for the log-likelihood. 16 | #' @param discard logical; if \code{TRUE} then the 'burn-in' phase iterations of 17 | #' the MCEM algorithm are discarded. Default is \code{discard=FALSE}. 18 | #' 19 | #' @references 20 | #' 21 | #' Wei GC, Tanner MA. A Monte Carlo implementation of the EM algorithm and the 22 | #' poor man's data augmentation algorithms. \emph{J Am Stat Assoc.} 1990; 23 | #' \strong{85(411)}: 699-704. 24 | #' 25 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 26 | #' @keywords methods dplot 27 | #' @seealso \code{\link{plot.mjoint}}, \code{\link[graphics]{plot.default}}, 28 | #' \code{\link[graphics]{par}}, \code{\link[graphics]{abline}}. 29 | #' 30 | #' @importFrom graphics par plot 31 | #' @export 32 | plotConvergence <- function(object, params = "gamma", discard = FALSE) { 33 | 34 | if (!isa(object, "mjoint")) { 35 | stop("Use only with 'mjoint' model objects.\n") 36 | } 37 | 38 | his <- object$history 39 | n.iters <- ncol(his) 40 | 41 | dims <- object$dims 42 | p <- sum(dims[["p"]]) 43 | q <- dims[["q"]] 44 | K <- dims[["K"]] 45 | r <- sum(dims[["r"]]) 46 | 47 | # NB: for rows indices of 'his', note number of parameters = 48 | # p (beta) 49 | # q + K (gamma) 50 | # K (sigma2) 51 | # r * (r + 1) / 2 (upper D matrix) 52 | inds <- c(0, cumsum(c(p, q + K, K, r * (r + 1) / 2))) 53 | 54 | if (n.iters == 1) { 55 | stop("No convergence history found.\n") 56 | } 57 | 58 | old.par <- par(no.readonly = TRUE) 59 | nc <- 1 60 | 61 | if (discard) { 62 | his <- his[, (object$control$burnin + 1):ncol(his), drop = FALSE] 63 | } 64 | 65 | #-------------------------------------------------------- 66 | 67 | # betas 68 | if (params == "beta") { 69 | if (p > 3) { 70 | nc <- ceiling(p / 3) 71 | } 72 | par(mfrow = c(nrow = min(p, 3), ncol = nc)) 73 | for (i in 1:p) { 74 | plot(his[(inds[1] + 1):(inds[2]), , drop = FALSE][i, ], type = "l", 75 | xlab = "Iteration", 76 | ylab = rownames(his[(inds[1] + 1):(inds[2]), , drop = FALSE])[i]) 77 | } 78 | } 79 | 80 | #-------------------------------------------------------- 81 | 82 | # gammas 83 | if (params == "gamma") { 84 | n.par <- q + K # must always be >= 1 85 | if (n.par > 3) { 86 | nc <- ceiling(n.par / 3) 87 | } 88 | par(mfrow = c(nrow = min(n.par, 3), ncol = nc)) 89 | for (i in 1:n.par) { 90 | plot(his[(inds[2] + 1):(inds[3]), , drop = FALSE][i, ], type = "l", 91 | xlab = "Iteration", 92 | ylab = rownames(his[(inds[2] + 1):(inds[3]), , drop = FALSE])[i]) 93 | } 94 | } 95 | 96 | #-------------------------------------------------------- 97 | 98 | # sigma2 99 | if (params == "sigma2") { 100 | if (K > 3) { 101 | nc <- ceiling(K / 3) 102 | } 103 | par(mfrow = c(nrow = min(K, 3), ncol = nc)) 104 | for (i in 1:K) { 105 | plot(his[(inds[3] + 1):(inds[4]), , drop = FALSE][i, ], type = "l", 106 | xlab = "Iteration", 107 | ylab = rownames(his[(inds[3] + 1):(inds[4]), , drop = FALSE])[i]) 108 | } 109 | } 110 | 111 | #-------------------------------------------------------- 112 | 113 | # D 114 | if (params == "D") { 115 | n.par <- r * (r + 1) / 2 # upper triangle only 116 | if (n.par > 3) { 117 | nc <- ceiling(n.par / 3) 118 | } 119 | par(mfrow = c(nrow = min(n.par, 3), ncol = nc)) 120 | for (i in 1:n.par) { 121 | plot(his[(inds[4] + 1):(inds[5]), , drop = FALSE][i, ], type = "l", 122 | xlab = "Iteration", 123 | ylab = rownames(his[(inds[4] + 1):(inds[5]), , drop = FALSE])[i]) 124 | } 125 | } 126 | 127 | #-------------------------------------------------------- 128 | 129 | # log-likelihood 130 | if (params == "loglik") { 131 | par(mfrow = c(1, 1)) 132 | ll <- na.omit(object$ll.hx) 133 | if (discard) { 134 | ll <- ll[(object$control$burnin + 1):length(ll)] 135 | } 136 | plot(ll, type = "l", 137 | xlab = "Iteration", 138 | ylab = "Log-likelihood") 139 | } 140 | 141 | on.exit(par(old.par)) 142 | 143 | } 144 | -------------------------------------------------------------------------------- /R/print.bootSE.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @export 3 | print.bootSE <- function(x, digits = max(4, getOption("digits") - 4), ...) { 4 | 5 | if (!inherits(x, "bootSE")) { 6 | stop("Use only with 'bootSE' objects.\n") 7 | } 8 | 9 | ci <- as.numeric(100*x$ci) 10 | if ((ci %% 1) == 0) { 11 | ci <- as.integer(ci) 12 | } 13 | 14 | cat("\nBootstrap SE estimates and percentile (", ci, "%) confidence intervals\n\n", 15 | sep = "") 16 | 17 | coefs.beta <- cbind("Value" = x$coefficients$beta, 18 | "Std.Err" = x$beta.se, 19 | "CI.lower" = x$beta.ci[1, ], 20 | "CI.upper" = x$beta.ci[2, ]) 21 | 22 | coefs.gamma <- cbind("Value" = x$coefficients$gamma, 23 | "Std.Err" = x$gamma.se, 24 | "CI.lower" = x$gamma.ci[1, ], 25 | "CI.upper" = x$gamma.ci[2, ]) 26 | 27 | coefs.sigma2 <- cbind("Value" = x$coefficients$sigma2, 28 | "Std.Err" = x$sigma2.se, 29 | "CI.lower" = x$sigma2.ci[1, ], 30 | "CI.upper" = x$sigma2.ci[2, ]) 31 | 32 | out <- rbind(coefs.beta, coefs.gamma, coefs.sigma2) 33 | out <- round(out, digits) 34 | out <- as.data.frame(out) 35 | pars <- rownames(out) 36 | submodel <- rep("", nrow(out)) 37 | submodel[1] <- "Longitudinal" 38 | submodel[nrow(out) - nrow(coefs.sigma2) + 1] <- "Residual SE" 39 | submodel[nrow(coefs.beta) + 1] <- "Time-to-event" 40 | out <- cbind(submodel, pars, out) 41 | colnames(out) <- c("", "Coefficient", "Estimate", "SE", 42 | paste0(ci, "% CI Lower"), paste0(ci, "% CI Upper")) 43 | rownames(out) <- NULL 44 | 45 | print(out, row.names = FALSE) 46 | cat("\nBootstrap computational time:", round(x$boot.time, 1), 47 | attr(x$boot.time, "units")) 48 | cat("\nBootstrap model convergence rate: ", 49 | round(100 * x$conv / x$nboot, 1), "%", sep = "") 50 | cat("\n") 51 | 52 | invisible(x) 53 | 54 | } 55 | -------------------------------------------------------------------------------- /R/print.dynLong.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @export 3 | print.dynLong <- function(x, digits = max(4, getOption("digits") - 4), ...) { 4 | 5 | if (!inherits(x, "dynLong")) { 6 | stop("Use only with 'dynLong' objects.\n") 7 | } 8 | 9 | out <- lapply(x$pred, round, digits = digits) 10 | print(out) 11 | 12 | if (x$type == "simulated") { 13 | cat(paste0("\nM-H acceptance rate: ", round(100 * x$accept, 1), "%")) 14 | } 15 | 16 | cat("\n") 17 | invisible(x) 18 | 19 | } 20 | -------------------------------------------------------------------------------- /R/print.dynSurv.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @export 3 | print.dynSurv <- function(x, digits = max(4, getOption("digits") - 4), ...) { 4 | 5 | if (!inherits(x, "dynSurv")) { 6 | stop("Use only with 'dynSurv' objects.\n") 7 | } 8 | 9 | if (!is.null(x$horizon)) { 10 | cat(paste0("Last follow-up time = ", round(x$data.t$tobs, digits), "\n")) 11 | cat(paste0(" Horizon time = ", round(x$horizon, digits), "\n\n")) 12 | } 13 | 14 | print(round(x$pred, digits = digits)) 15 | 16 | if (x$type == "simulated") { 17 | cat(paste0("\nM-H acceptance rate: ", round(100 * x$accept, 1), "%")) 18 | } 19 | 20 | cat("\n") 21 | invisible(x) 22 | 23 | } 24 | -------------------------------------------------------------------------------- /R/print.mjoint.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @export 3 | print.mjoint <- function(x, digits = max(4, getOption("digits") - 4), ...) { 4 | 5 | if (!inherits(x, "mjoint")) { 6 | stop("Use only with 'mjoint' model objects.\n") 7 | } 8 | 9 | K <- x$dims$K 10 | 11 | #***************************************************** 12 | # Call statements 13 | #***************************************************** 14 | 15 | cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), 16 | "\n\n", sep = "") 17 | 18 | #***************************************************** 19 | # Data descriptives 20 | #***************************************************** 21 | 22 | cat("Number of subjects:", x$dims$n, "\n") 23 | cat("Number of longitudinal outcomes: K =", x$dims$K, "\n") 24 | cat("Number of observations:\n") 25 | for (k in 1:K) { 26 | if(any(is.null(names(x$formLongFixed)))) { 27 | cat(" Outcome ", k, ": n = ", x$dims$nk[k], "\n", sep = "") 28 | } else { 29 | cat(" Outcome ", k, " (", names(x$formLongFixed)[k], "): n = ", x$dims$nk[k], 30 | "\n", sep = "") 31 | } 32 | } 33 | 34 | #***************************************************** 35 | # Model summaries 36 | #***************************************************** 37 | 38 | cat("\nJoint Model Summary:\n") 39 | if (K == 1) { 40 | cat("\nLongitudinal Process: Univariate linear mixed-effects model\n") 41 | } else { 42 | cat("\nLongitudinal Process: Multivariate linear mixed-effects model\n") 43 | } 44 | for (k in 1:K) { 45 | cat(" ", paste0(deparse(x$formLongFixed[[k]]), ", random = ", 46 | deparse(x$formLongRandom[[k]]), "\n")) 47 | } 48 | 49 | cat("Event Process: Cox proportional hazards model\n") 50 | cat(" ", paste(deparse(x$formSurv), sep = "\n", collapse = "\n"), "\n", sep = "") 51 | 52 | #***************************************************** 53 | # Variance components 54 | #***************************************************** 55 | 56 | cat("\nVariance Components:\n\n") 57 | 58 | # Random effects variance-covariance matrix 59 | print(getVarCov(x)) 60 | 61 | #***************************************************** 62 | # Model coefficients 63 | #***************************************************** 64 | 65 | cat("\nCoefficient Estimates:\n") 66 | 67 | print(coef(x)[c("beta", "gamma")]) 68 | 69 | cat("\n") 70 | invisible(x) 71 | 72 | } 73 | -------------------------------------------------------------------------------- /R/print.summary.mjoint.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @export 3 | print.summary.mjoint <- function(x, digits = max(4, getOption("digits") - 4), ...) { 4 | 5 | if (!inherits(x, "summary.mjoint")) { 6 | stop("Use only with 'summary.mjoint' objects.\n") 7 | } 8 | 9 | K <- x$dims$K 10 | 11 | #***************************************************** 12 | # Call statements 13 | #***************************************************** 14 | 15 | cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n", sep = "") 16 | 17 | #***************************************************** 18 | # Data descriptives 19 | #***************************************************** 20 | 21 | event.pc <- with(x$sfit, round(100 * nevent / n, 1)) 22 | 23 | cat("\nData Descriptives:\n") 24 | 25 | cat("\nEvent Process\n") 26 | cat(" Number of subjects:", x$dims$n, "\n") 27 | cat(" Number of events: ", x$sfit$nevent, " (", event.pc, "%)\n", sep = "") 28 | 29 | cat("\nLongitudinal Process\n") 30 | cat(" Number of longitudinal outcomes: K =", x$dims$K, "\n") 31 | cat(" Number of observations:\n") 32 | for (k in 1:K) { 33 | if(any(is.null(names(x$formLongFixed)))) { 34 | cat(" Outcome ", k, ": n = ", x$dims$nk[k], "\n", sep = "") 35 | } else { 36 | cat(" Outcome ", k, " (", names(x$formLongFixed)[k], "): n = ", x$dims$nk[k], 37 | "\n", sep = "") 38 | } 39 | } 40 | 41 | #***************************************************** 42 | # Model summaries 43 | #***************************************************** 44 | 45 | cat("\nJoint Model Summary:\n") 46 | if (K == 1) { 47 | cat("\nLongitudinal Process: Univariate linear mixed-effects model\n") 48 | } else { 49 | cat("\nLongitudinal Process: Multivariate linear mixed-effects model\n") 50 | } 51 | for (k in 1:K) { 52 | cat(" ", paste0(deparse(x$formLongFixed[[k]]), ", random = ", 53 | deparse(x$formLongRandom[[k]]), "\n")) 54 | } 55 | 56 | cat("Event Process: Cox proportional hazards model\n") 57 | cat(" ", paste(deparse(x$formSurv), sep = "\n", collapse = "\n"), "\n", sep = "") 58 | 59 | cat("Model fit statistics:\n") 60 | model.sum <- data.frame(log.Lik = x$logLik, AIC = x$AIC, BIC = x$BIC, row.names = "") 61 | print(model.sum) 62 | 63 | #***************************************************** 64 | # Variance components 65 | #***************************************************** 66 | 67 | cat("\nVariance Components:\n\n") 68 | 69 | # Random effects variance-covariance matrix 70 | print(x$D) 71 | 72 | sigma <- x$sigma 73 | cat("\nResidual standard errors(s):\n") 74 | print(sigma) 75 | 76 | #***************************************************** 77 | # Model coefficients 78 | #***************************************************** 79 | 80 | cat("\nCoefficient Estimates:\n") 81 | 82 | cat("\nLongitudinal sub-model:\n") 83 | out <- as.data.frame(round(x$"coefs.long", digits)) 84 | ind <- out$"p-value" == 0 85 | out$"p-value" <- sprintf(paste("%.", digits, "f", sep = ""), out$"p-value") 86 | out$"p-value"[ind] <- paste("<0.", paste(rep("0", digits - 1), collapse = ""), "1", sep = "") 87 | print(out) 88 | 89 | cat("\nTime-to-event sub-model:\n") 90 | out <- as.data.frame(round(x$"coefs.surv", digits)) 91 | ind <- out$"p-value" == 0 92 | out$"p-value" <- sprintf(paste("%.", digits, "f", sep = ""), out$"p-value") 93 | out$"p-value"[ind] <- paste("<0.", paste(rep("0", digits - 1), collapse = ""), "1", sep = "") 94 | print(out) 95 | 96 | #***************************************************** 97 | # Computational statistics 98 | #***************************************************** 99 | 100 | cat("\nAlgorithm Summary:\n") 101 | 102 | cat(" Total computational time:", round(x$comp.time[1], 1), 103 | attr(x$comp.time[1], "units"), "\n") 104 | cat(" EM algorithm computational time:", round(x$comp.time[2], 1), 105 | attr(x$comp.time[2], "units"), "\n") 106 | cat(" Convergence status:", ifelse(x$conv, "converged\n", "failed\n")) 107 | cat(" Convergence criterion:", x$control$convCrit, "\n") 108 | cat(" Final Monte Carlo sample size:", x$finalnMC, "\n") 109 | cat(" Standard errors calculated using method:", x$se.type) 110 | if (x$se.type == "boot") { 111 | cat("\n Number of bootstraps: B =", x$nboot, "\n") 112 | cat(" Bootstrap computational time:", round(x$boot.time, 1), 113 | attr(x$boot.time, "units")) 114 | } 115 | 116 | cat("\n") 117 | invisible(x) 118 | 119 | } 120 | -------------------------------------------------------------------------------- /R/process_newdata.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | process_newdata <- function(object, newdata, newSurvData = NULL, tobs = NULL) { 3 | 4 | if (!inherits(object, "mjoint")) { 5 | stop("Use only with 'mjoint' model objects.\n") 6 | } 7 | 8 | K <- object$dims$K 9 | r <- object$dims$r 10 | p <- object$dims$p 11 | q <- object$dims$q 12 | 13 | if (!isa(newdata, "list")) { 14 | balanced <- TRUE 15 | newdata <- list(newdata) 16 | if (K > 1) { 17 | for (k in 2:K) { 18 | newdata[[k]] <- newdata[[1]] 19 | } 20 | } 21 | } else { 22 | balanced <- (length(unique(newdata)) == 1) 23 | } 24 | if (length(newdata) != K) { 25 | stop(paste("The number of datasets expected is K =", K)) 26 | } 27 | 28 | #***************************************************** 29 | # Multivariate longitudinal data 30 | #***************************************************** 31 | 32 | Xk.new <- list() 33 | tk.new <- list() 34 | Zk.new <- list() 35 | yk.new <- list() 36 | ffk <- list() 37 | nk <- vector(length = K) 38 | 39 | for (k in 1:K) { 40 | termsX <- object$lfit[[k]]$terms 41 | origData <- model.frame(termsX, object$data[[k]]) 42 | xlev <- .getXlevels(termsX, origData) 43 | mfX.new <- model.frame(termsX, newdata[[k]], xlev = xlev) 44 | ffk[[k]] <- nlme::splitFormula(object$formLongRandom[[k]], "|")[[1]] 45 | 46 | Xk.new[[k]] <- model.matrix(termsX, mfX.new) 47 | tk.new[[k]] <- newdata[[k]][[object$timeVar[[k]]]] 48 | yk.new[[k]] <- model.response(mfX.new, "numeric") 49 | Zk.new[[k]] <- model.matrix(ffk[[k]], newdata[[k]]) 50 | nk[k] <- nrow(Xk.new[[k]]) 51 | } 52 | 53 | X.new <- as.matrix(Matrix::bdiag(Xk.new)) 54 | Z.new <- as.matrix(Matrix::bdiag(Zk.new)) 55 | y.new <- unlist(yk.new) 56 | 57 | #***************************************************** 58 | # Time-to-event data 59 | #***************************************************** 60 | 61 | if (q > 0) { 62 | termsT <- object$sfit$terms 63 | if (is.null(newSurvData)) { 64 | mfT.new <- model.frame(delete.response(termsT), newdata[[1]], 65 | xlev = object$sfit$xlevels) 66 | } else { 67 | mfT.new <- model.frame(delete.response(termsT), newSurvData, 68 | xlev = object$sfit$xlevels) 69 | } 70 | v.new <- model.matrix(delete.response(termsT), mfT.new)[1, -1] 71 | v.new <- v.new - object$dmats$t$xcenter 72 | } else { 73 | v.new <- NULL 74 | } 75 | 76 | survdat2 <- object$dmats$t$survdat2[object$dmats$t$survdat2$delta == 1, ] 77 | survdat2 <- survdat2[order(survdat2$T), ] 78 | tmax <- max(survdat2$T) 79 | 80 | if (is.null(tobs)) { 81 | tobs <- 0 82 | for (k in 1:K) { 83 | tobs <- max(tobs, max(newdata[[k]][, object$timeVar[k]])) 84 | } 85 | } else { 86 | if (tobs > tmax) { 87 | stop("Cannot extrapolate beyond final failure time") 88 | } 89 | } 90 | 91 | tj <- object$dmats$t$tj # if tj.ind = 0, deal with it elsewhere 92 | tj.ind <- sum(tj <= tobs) 93 | 94 | #***************************************************** 95 | # Z(t_j) for unique failure times t_j 96 | #***************************************************** 97 | 98 | Zdat.fail <- data.frame(tj[1:max(tj.ind, 1)]) 99 | Zk.fail <- list() 100 | 101 | for (k in 1:K) { 102 | names(Zdat.fail) <- object$timeVar[[k]] 103 | Zk.fail[[k]] <- model.matrix(ffk[[k]], Zdat.fail) 104 | } 105 | 106 | Z.fail <- as.matrix(Matrix::bdiag(Zk.fail)) 107 | IW.fail <- do.call("cbind", lapply(1:K, function(i) diag(max(tj.ind, 1)))) 108 | 109 | #***************************************************** 110 | # Output 111 | #***************************************************** 112 | 113 | out <- list( 114 | X = X.new, 115 | Xk = Xk.new, 116 | tk = tk.new, 117 | Z = Z.new, 118 | Zk = Zk.new, 119 | y = y.new, 120 | yk = yk.new, 121 | nk = nk, 122 | v = v.new, 123 | tobs = tobs, 124 | tmax = tmax, 125 | tj.ind = tj.ind, 126 | Z.fail = Z.fail, 127 | IW.fail = IW.fail, 128 | K = K, p = p, r = r, q = q 129 | ) 130 | 131 | return(out) 132 | 133 | } 134 | -------------------------------------------------------------------------------- /R/ranef.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract random effects estimates from an \code{mjoint} object 2 | #' 3 | #' @description Extract random effects estimates from an \code{mjoint} object. 4 | #' 5 | #' @inheritParams confint.mjoint 6 | #' @param postVar logical: if \code{TRUE} the variance of the posterior 7 | #' distribution is also returned. 8 | #' 9 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 10 | #' @keywords methods 11 | #' @seealso \code{\link[nlme]{ranef}} for the generic method description, and 12 | #' \code{\link{fixef.mjoint}}. To plot \code{ranef.mjoint} objects, see 13 | #' \code{\link{plot.ranef.mjoint}}. 14 | #' 15 | #' @references 16 | #' 17 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 18 | #' Springer Verlag; 2000. 19 | #' 20 | #' Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 21 | #' measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 22 | #' 23 | #' @return A \code{data.frame} (also of class \code{ranef.mjoint}) with rows 24 | #' denoting the individuals and columns the random effects (e.g., intercepts, 25 | #' slopes, etc.). If \code{postVar=TRUE}, the numeric matrix has an extra 26 | #' attribute, \code{postVar}. 27 | #' @importFrom lme4 ranef 28 | #' @export 29 | #' 30 | #' @examples 31 | #' \dontrun{ 32 | #' # Fit a joint model with bivariate longitudinal outcomes 33 | #' 34 | #' data(heart.valve) 35 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 36 | #' 37 | #' fit2 <- mjoint( 38 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 39 | #' "lvmi" = log.lvmi ~ time + sex), 40 | #' formLongRandom = list("grad" = ~ 1 | num, 41 | #' "lvmi" = ~ time | num), 42 | #' formSurv = Surv(fuyrs, status) ~ age, 43 | #' data = list(hvd, hvd), 44 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 45 | #' timeVar = "time", 46 | #' verbose = TRUE) 47 | #' 48 | #' ranef(fit2) 49 | #' } 50 | ranef.mjoint <- function(object, postVar = FALSE, ...) { 51 | 52 | if (!inherits(object, "mjoint")) { 53 | stop("Use only with 'mjoint' model objects.\n") 54 | } 55 | 56 | out <- object$Eb 57 | out <- as.data.frame(out) 58 | 59 | if (postVar) { 60 | attr(out, "postVar") <- object$Vb 61 | } 62 | 63 | class(out) <- c("ranef.mjoint", "data.frame") 64 | return(out) 65 | 66 | } 67 | -------------------------------------------------------------------------------- /R/renal.R: -------------------------------------------------------------------------------- 1 | #' Renal transplantation data 2 | #' 3 | #' @description This is a dataset on 407 patients suffering from chronic kidney 4 | #' disease who underwent a primary renal transplantation with a graft from a 5 | #' deceased or living donor in the University Hospital of the Catholic 6 | #' University of Leuven (Belgium) between 21 January 1983 and 16 August 2000. 7 | #' Chronic kidney (renal) disease is a progressive loss of renal function over 8 | #' a period of months or years through five stages. Each stage is a 9 | #' progression through an abnormally low and progressively worse glomerular 10 | #' filtration rate (GFR). The dataset records 3 repeated measures (2 11 | #' continuous and 1 binary), and an event time. 12 | #' 13 | #' @usage data(renal) 14 | #' @format This is a list with 4 data frames: \enumerate{ 15 | #' 16 | #' \item{\code{prot}: repeated measurement data for proteinuria (binary) that 17 | #' measures whether the kidneys succeed in sustaining the proteins in the 18 | #' blood and not discard them in the urine.} 19 | #' 20 | #' \item{\code{haem}: repeated measurement data for blood haematocrit level 21 | #' (continuous) that measures whether the kidneys produce adequate amounts of 22 | #' the hormone erythropoietin that regulates the red blood cell production.} 23 | #' 24 | #' \item{\code{gfr}: repeated measurement data for GFR (continuous) that 25 | #' measures the filtration rate of the kidneys.} 26 | #' 27 | #' \item{\code{surv}: time-to-event data for renal graft failure.} 28 | #' 29 | #' } 30 | #' 31 | #' \strong{All datasets} have the common data columns, which are in long 32 | #' format for the 3 longitudinal data data frames, and 1-per-subject for the 33 | #' time-to-event data frame: \describe{ 34 | #' 35 | #' \item{\code{id}}{number for patient identification.} 36 | #' 37 | #' \item{\code{age}}{age of patient at day of surgery (years).} 38 | #' 39 | #' \item{\code{weight}}{preoperative weight of patient (kg).} 40 | #' 41 | #' \item{\code{sex}}{gender of patient.} 42 | #' 43 | #' \item{\code{fuyears}}{maximum follow up time, with transplant date as the 44 | #' time origin (years).} 45 | #' 46 | #' \item{\code{failure}}{censoring indicator (\code{1=}graft failure and 47 | #' \code{0=}censored).} 48 | #' 49 | #' } 50 | #' 51 | #' \strong{The longitudinal datasets only} contain 2 further columns: 52 | #' \describe{ 53 | #' 54 | #' \item{\code{time}}{observed time point, with surgery date as the time 55 | #' origin (years).} 56 | #' 57 | #' \item{biomarker value}{a recorded measurement of the biomarker taken at 58 | #' time \code{time}. The 3 biomarkers (one per data frame) are: \itemize{ 59 | #' 60 | #' \item{\code{proteinuria}: recorded as binary indicator: present or 61 | #' not-present. Present in the \code{prot} data.} 62 | #' 63 | #' \item{\code{haematocrit}: recorded as percentage (\%) of the ratio of the 64 | #' volume of red blood cells to the total volume of blood. Present in the 65 | #' \code{haem} data.} 66 | #' 67 | #' \item{\code{gfr}: measured as ml/min/1.73\eqn{m^2}. Present in the 68 | #' \code{gfr} data.} 69 | #' 70 | #' }} 71 | #' 72 | #' } 73 | #' @keywords datasets 74 | #' @seealso \code{\link{pbc2}}, \code{\link{heart.valve}}, 75 | #' \code{\link{epileptic.qol}}. 76 | #' @source Dr Dimitris Rizopoulos (\email{d.rizopoulos@@erasmusmc.nl}). 77 | #' @references 78 | #' 79 | #' Rizopoulos D, Ghosh, P. A Bayesian semiparametric multivariate joint model 80 | #' for multiple longitudinal outcomes and a time-to-event. \emph{Stat Med.} 81 | #' 2011; \strong{30(12)}: 1366-80. 82 | "renal" 83 | -------------------------------------------------------------------------------- /R/residuals.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract \code{mjoint} residuals 2 | #' 3 | #' @description The residuals at level \emph{i} are obtained by subtracting the fitted 4 | #' levels at that level from the response vector. 5 | #' 6 | #' @inheritParams confint.mjoint 7 | #' @param level an optional integer giving the level of grouping to be used in 8 | #' extracting the residuals from object. Level values increase from outermost 9 | #' to innermost grouping, with level 0 corresponding to the population 10 | #' residuals and level 1 corresponding to subject-specific residuals. Defaults 11 | #' to \code{level=0}. 12 | #' 13 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 14 | #' @keywords methods 15 | #' @seealso \code{\link{mjoint}}, \code{\link{fitted.mjoint}} 16 | #' 17 | #' @references 18 | #' 19 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 20 | #' Springer Verlag; 2000. 21 | #' 22 | #' @return A \code{list} of length \emph{K} with each element a vector of 23 | #' residuals for the \emph{k}-th longitudinal outcome. 24 | #' @export 25 | residuals.mjoint <- function(object, level = 0, ...) { 26 | 27 | if (!inherits(object, "mjoint")) { 28 | stop("Use only with 'mjoint' model objects.\n") 29 | } 30 | 31 | dmats <- object$dmats 32 | if (is.null(dmats)) { 33 | stop("Need post fit statistics to calculate residuals. 34 | Re-run the model with 'pfs = TRUE'") 35 | } 36 | 37 | beta <- object$coefficients$beta 38 | Eb <- as.data.frame(object$Eb) 39 | 40 | p <- object$dims$p 41 | r <- object$dims$r 42 | K <- object$dims$K 43 | nik <- object$dmats$l$nik 44 | 45 | Y <- object$dmats$l$yi 46 | X <- object$dmats$l$Xi 47 | Z <- object$dmats$l$Zi 48 | 49 | Xbeta <- lapply(X, function(x) { 50 | x %*% beta 51 | }) 52 | Eb.list <- lapply(rownames(Eb), function(x) { 53 | Eb[x, ] 54 | }) 55 | Zb <- mapply(function(b, z) { 56 | z %*% t(b) 57 | }, 58 | b = Eb.list, z = Z) 59 | 60 | if (level == 0) { 61 | ri <- mapply(function(y, yhat) { 62 | y - yhat 63 | }, 64 | y = Y, yhat = Xbeta) 65 | } else if (level == 1) { 66 | ri <- mapply(function(y, yhat, z) { 67 | y - yhat - z 68 | }, 69 | y = Y, yhat = Xbeta, z = Zb) 70 | } else { 71 | stop(paste("Unknown level selected:", level)) 72 | } 73 | 74 | resids <- list() 75 | index <- lapply(nik, function(n) { 76 | c(0, cumsum(n)) 77 | }) 78 | for (k in 1:K) { 79 | resids[[k]] <- mapply(function(x, i) { 80 | x[(i[k] + 1):(i[k + 1])] 81 | }, 82 | x = ri, i = index) 83 | } 84 | resids <- lapply(resids, unlist) 85 | if (!is.null(object$formLongFixed)) { 86 | names(resids) <- names(object$formLongFixed) 87 | } 88 | 89 | return(resids) 90 | 91 | } 92 | -------------------------------------------------------------------------------- /R/sampleData.R: -------------------------------------------------------------------------------- 1 | #' Sample from an \code{mjoint} object 2 | #' 3 | #' @description Generic function used to sample a subset of data from an object 4 | #' of class \code{mjoint} with a specific number of subjects. 5 | #' 6 | #' @inheritParams confint.mjoint 7 | #' @param size number of subjects to include in the sampled subset. If 8 | #' \code{size=NULL} (default), then size is set equal to the number of 9 | #' subjects used to fit the \code{mjoint} model. 10 | #' @param replace use replacement when sampling subjects? Default is 11 | #' \code{TRUE}. If replacement is used, then the subjects are re-labelled from 12 | #' 1 to \code{size}. 13 | #' 14 | #' @details This function is primarily intended for internal use in the 15 | #' \code{\link{bootSE}} function in order to permit bootstrapping. However, it 16 | #' can be used for other purposes given a fitted \code{mjoint} object. 17 | #' 18 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 19 | #' @keywords methods datagen multivariate survival 20 | #' @seealso \code{\link{mjoint}}. 21 | #' 22 | #' @return A list of 2 data.frames: one recording the requisite longitudinal 23 | #' outcomes data, and the other recording the time-to-event data. 24 | #' @export 25 | #' 26 | #' @examples 27 | #' \dontrun{ 28 | #' # Fit a joint model with bivariate longitudinal outcomes 29 | #' 30 | #' data(heart.valve) 31 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 32 | #' 33 | #' fit2 <- mjoint( 34 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 35 | #' "lvmi" = log.lvmi ~ time + sex), 36 | #' formLongRandom = list("grad" = ~ 1 | num, 37 | #' "lvmi" = ~ time | num), 38 | #' formSurv = Surv(fuyrs, status) ~ age, 39 | #' data = list(hvd, hvd), 40 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 41 | #' timeVar = "time", 42 | #' verbose = TRUE) 43 | #' sampleData(fit2, size = 10) 44 | #' } 45 | sampleData <- function(object, size = NULL, replace = TRUE) { 46 | 47 | if (!inherits(object, "mjoint")) { 48 | stop("Use only with 'mjoint' model objects.\n") 49 | } 50 | 51 | # Extract from model fit 52 | data <- object$data 53 | survData <- object$survData 54 | id <- object$id 55 | id.labs <- unique(survData[ , id]) 56 | surv.time.lab <- all.vars(object$formSurv)[1] 57 | n <- length(id.labs) 58 | K <- object$dims$K 59 | size <- ifelse(is.null(size), n, size) 60 | 61 | if (!replace) { 62 | if (!is.null(size)) { 63 | if (size > n) { 64 | stop("Cannot select more subjects than in data without replacement") 65 | } 66 | } 67 | } 68 | 69 | # Random sample of subjects (with replacement) 70 | i <- sample(id.labs, size = size, replace = replace) 71 | 72 | # Longitudinal data 73 | longData.boot <- list() 74 | for (k in 1:K) { 75 | out <- lapply(i, function(u) data[[k]][data[[k]][, id] == u, ]) 76 | m <- do.call("c", lapply(out, nrow)) 77 | longData.boot[[k]] <- do.call("rbind", out) 78 | if (replace) { 79 | id.new <- rep(1:size, m) 80 | longData.boot[[k]][, id] <- id.new 81 | } 82 | } 83 | 84 | # Time-to-event data 85 | survData.boot <- survData[match(i, survData[ , id]), ] 86 | if (replace) { 87 | survData.boot[, id] <- 1:size 88 | } 89 | survData.boot[, surv.time.lab] <- survData.boot[, surv.time.lab] 90 | 91 | return(list(longData.boot = longData.boot, 92 | survData.boot = survData.boot)) 93 | 94 | } 95 | -------------------------------------------------------------------------------- /R/sigma.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract residual standard deviation(s) from an \code{mjoint} object 2 | #' 3 | #' @description Extract residual standard deviation(s) from an \code{mjoint} 4 | #' object. 5 | #' 6 | #' @inheritParams confint.mjoint 7 | #' 8 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 9 | #' @keywords methods 10 | #' @seealso \code{\link[lme4]{sigma}} in the \strong{lme4} package. 11 | #' 12 | #' @references 13 | #' 14 | #' Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 15 | #' Springer Verlag; 2000. 16 | #' 17 | #' @return a number (standard deviation) if \eqn{K = 1} (univariate model), or a 18 | #' vector if \eqn{K>1} (multivariate model). 19 | #' @importFrom stats sigma 20 | #' @export 21 | sigma.mjoint <- function(object, ...) { 22 | 23 | if (!inherits(object, "mjoint")) { 24 | stop("Use only with 'mjoint' model objects.\n") 25 | } 26 | 27 | sig <- sqrt(object$coef$sigma2) 28 | sig.names <- names(object$formLongFixed) 29 | if (is.null(sig.names)) { 30 | names(sig) <- paste0("sigma_", 1:length(sig)) 31 | } else { 32 | names(sig) <- sig.names 33 | } 34 | 35 | sig 36 | 37 | } 38 | -------------------------------------------------------------------------------- /R/summary.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Summary of an \code{mjoint} object 2 | #' 3 | #' @description This function provides a summary of an \code{mjoint} object. 4 | #' 5 | #' @inheritParams confint.mjoint 6 | #' 7 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 8 | #' @keywords methods 9 | #' @seealso \code{\link{mjoint}}, \code{\link{mjoint.object}}, and 10 | #' \code{\link[base]{summary}} for the generic method description. 11 | #' 12 | #' @references 13 | #' 14 | #' Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 15 | #' measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 16 | #' 17 | #' Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 18 | #' measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 19 | #' 465-480. 20 | #' 21 | #' Lin H, McCulloch CE, Mayne ST. Maximum likelihood estimation in the joint 22 | #' analysis of time-to-event and multiple longitudinal variables. \emph{Stat 23 | #' Med.} 2002; \strong{21}: 2369-2382. 24 | #' 25 | #' @return A list containing the coefficient matrices for the longitudinal and 26 | #' time-to-event sub-models; variance-covariance matrix for the random 27 | #' effects; residual error variances; log-likelihood of joint model; AIC and 28 | #' BIC statistics; and model fit objects. 29 | #' @export 30 | #' 31 | #' @examples 32 | #' \dontrun{ 33 | #' # Fit a joint model with bivariate longitudinal outcomes 34 | #' 35 | #' data(heart.valve) 36 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 37 | #' 38 | #' fit2 <- mjoint( 39 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 40 | #' "lvmi" = log.lvmi ~ time + sex), 41 | #' formLongRandom = list("grad" = ~ 1 | num, 42 | #' "lvmi" = ~ time | num), 43 | #' formSurv = Surv(fuyrs, status) ~ age, 44 | #' data = list(hvd, hvd), 45 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 46 | #' timeVar = "time", 47 | #' verbose = TRUE) 48 | #' summary(fit2) 49 | #' } 50 | summary.mjoint <- function(object, bootSE = NULL, ...) { 51 | 52 | if (!inherits(object, "mjoint")) { 53 | stop("Use only with 'mjoint' model objects.\n") 54 | } 55 | 56 | dims <- object$dims 57 | num.d <- with(dims, sum(r) * (sum(r) + 1) / 2) # number of RE covariance params 58 | num.b <- sum(dims$p) # number of beta coefficients 59 | num.s <- dims$K # number of error variances 60 | num.g <- with(dims, q + K) # number of gamma coefficients 61 | 62 | beta <- object$coefficients$beta 63 | beta.inds <- (num.d + 1):(num.d + num.b) 64 | if (is.null(bootSE) & !is.null(object$Hessian)) { 65 | beta.se <- sqrt(diag(vcov(object)))[beta.inds] 66 | } else if (!is.null(bootSE)) { 67 | beta.se <- bootSE$beta.se 68 | } else { 69 | beta.se <- rep(NA, length(beta)) 70 | } 71 | coefs.beta <- cbind( 72 | "Value" = beta, 73 | "Std.Err" = beta.se, 74 | "z-value" = beta / beta.se, 75 | "p-value" = 2 * pnorm(abs(beta / beta.se), lower.tail = FALSE)) 76 | 77 | gamma <- object$coefficients$gamma 78 | gamma.inds <- (num.d + num.b + num.s + 1):(num.d + num.b + num.s + num.g) 79 | if (is.null(bootSE) & !is.null(object$Hessian)) { 80 | gamma.se <- sqrt(diag(vcov(object)))[gamma.inds] 81 | } else if (!is.null(bootSE)) { 82 | gamma.se <- bootSE$gamma.se 83 | } else { 84 | gamma.se <- rep(NA, length(gamma)) 85 | } 86 | coefs.gamma <- cbind( 87 | "Value" = gamma, 88 | "Std.Err" = gamma.se, 89 | "z-value" = gamma / gamma.se, 90 | "p-value" = 2 * pnorm(abs(gamma / gamma.se), lower.tail = FALSE)) 91 | 92 | out <- list("coefs.long" = coefs.beta, 93 | "coefs.surv" = coefs.gamma, 94 | D = getVarCov(object), 95 | sigma = sqrt(object$coefficients$sigma2), 96 | logLik = as.vector(logLik(object)), 97 | AIC = AIC(object), 98 | BIC = AIC(object, k = log(dims$n))) 99 | 100 | out$formLongFixed <- object$formLongFixed 101 | out$formLongRandom <- object$formLongRandom 102 | out$formSurv <- object$formSurv 103 | out$sfit <- object$sfit 104 | out$lfit <- object$lfit 105 | out$timeVar <- object$timeVar 106 | out$dims <- object$dims 107 | out$control <- object$control 108 | out$finalnMC <- object$finalnMC 109 | out$call <- object$call 110 | out$comp.time <- object$comp.time 111 | out$conv <- object$conv 112 | out$se.type <- ifelse(is.null(bootSE) & !is.null(object$Hessian), "approx", 113 | ifelse(!is.null(bootSE), "boot", "none")) 114 | if (!is.null(bootSE)) { 115 | out$boot.time <- bootSE$boot.time 116 | out$nboot <- bootSE$nboot 117 | } 118 | 119 | class(out) <- "summary.mjoint" 120 | out 121 | 122 | } 123 | -------------------------------------------------------------------------------- /R/thetaDraw.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @importFrom Matrix nearPD 3 | #' @importFrom mvtnorm rmvnorm 4 | #' @importFrom utils relist as.relistable 5 | thetaDraw <- function(object) { 6 | 7 | # Mean 8 | theta.mean <- coef(object) 9 | theta.mean <- theta.mean[-which(names(theta.mean) == "haz")] 10 | D.inds <- which(lower.tri(theta.mean[["D"]], diag = TRUE), arr.ind = TRUE) 11 | theta.mean[["D"]] <- theta.mean[["D"]][D.inds] 12 | 13 | # Variance 14 | theta.var <- vcov(object) 15 | 16 | theta.samp <- mvtnorm::rmvnorm(n = 1, 17 | mean = unlist(as.relistable(theta.mean)), 18 | sigma = theta.var) 19 | theta.samp <- relist(theta.samp, skeleton = theta.mean) 20 | D <- matrix(0, nrow = max(D.inds), ncol = max(D.inds)) 21 | D[D.inds] <- theta.samp[["D"]] 22 | if (sum(object$dims$r) > 1) { 23 | D <- D + t(D) - diag(diag(D)) 24 | D <- Matrix::nearPD(D) 25 | theta.samp[["D"]] <- as.matrix(D$mat) 26 | } else { 27 | D <- max(D, 1e-08) 28 | theta.samp[["D"]] <- D 29 | } 30 | 31 | # Baseline hazard 32 | haz <- baseHaz(object, se = TRUE) 33 | haz.samp <- rnorm(nrow(haz), mean = haz$haz, sd = haz$se) 34 | haz.samp <- pmax(haz.samp, min(1e-06, haz$haz)) 35 | 36 | theta.samp[["haz"]] <- haz.samp 37 | return(theta.samp) 38 | 39 | } 40 | -------------------------------------------------------------------------------- /R/vcov.mjoint.R: -------------------------------------------------------------------------------- 1 | #' Extract an approximate variance-covariance matrix of estimated parameters 2 | #' from an \code{mjoint} object 3 | #' 4 | #' @description Returns the variance-covariance matrix of the main parameters of 5 | #' a fitted \code{mjoint} model object. 6 | #' 7 | #' @inheritParams confint.mjoint 8 | #' @param correlation logical: if \code{TRUE} returns the correlation matrix, 9 | #' otherwise returns the variance-covariance matrix (default). 10 | #' 11 | #' @details This is a generic function that extracts the variance-covariance 12 | #' matrix of parameters from an \code{mjoint} model fit. It is based on a 13 | #' profile likelihood, so no estimates are given for the baseline hazard 14 | #' function, which is generally considered a nuisance parameter. It is based 15 | #' on the empirical information matrix (see Lin et al. 2002, and McLachlan 16 | #' and Krishnan 2008 for details), so is only approximate. 17 | #' 18 | #' @note This function is not to be confused with \code{\link[nlme]{getVarCov}}, 19 | #' which returns the extracted variance-covariance matrix for the random 20 | #' effects distribution. 21 | #' 22 | #' @author Graeme L. Hickey (\email{graemeleehickey@@gmail.com}) 23 | #' @keywords methods 24 | #' @seealso \code{\link[stats]{vcov}} for the generic method description, and 25 | #' \code{\link[stats]{cov2cor}} for details of efficient scaling of a 26 | #' covariance matrix into the corresponding correlation matrix. 27 | #' 28 | #' @references 29 | #' 30 | #' Lin H, McCulloch CE, Mayne ST. Maximum likelihood estimation in the joint 31 | #' analysis of time-to-event and multiple longitudinal variables. \emph{Stat 32 | #' Med.} 2002; \strong{21}: 2369-2382. 33 | #' 34 | #' McLachlan GJ, Krishnan T. \emph{The EM Algorithm and Extensions}. Second 35 | #' Edition. Wiley-Interscience; 2008. 36 | #' 37 | #' @import stats 38 | #' @importFrom MASS ginv 39 | #' 40 | #' @return A variance-covariance matrix. 41 | #' @export 42 | #' 43 | #' @examples 44 | #' \dontrun{ 45 | #' # Fit a classical univariate joint model with a single longitudinal outcome 46 | #' # and a single time-to-event outcome 47 | #' 48 | #' data(heart.valve) 49 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 50 | #' 51 | #' set.seed(1) 52 | #' fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 53 | #' formLongRandom = ~ time | num, 54 | #' formSurv = Surv(fuyrs, status) ~ age, 55 | #' data = hvd, 56 | #' timeVar = "time", 57 | #' control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 58 | #' 59 | #' vcov(fit1) 60 | #' } 61 | #' 62 | #' \dontrun{ 63 | #' # Fit a joint model with bivariate longitudinal outcomes 64 | #' 65 | #' data(heart.valve) 66 | #' hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 67 | #' 68 | #' fit2 <- mjoint( 69 | #' formLongFixed = list("grad" = log.grad ~ time + sex + hs, 70 | #' "lvmi" = log.lvmi ~ time + sex), 71 | #' formLongRandom = list("grad" = ~ 1 | num, 72 | #' "lvmi" = ~ time | num), 73 | #' formSurv = Surv(fuyrs, status) ~ age, 74 | #' data = list(hvd, hvd), 75 | #' inits = list("gamma" = c(0.11, 1.51, 0.80)), 76 | #' timeVar = "time", 77 | #' verbose = TRUE) 78 | #' 79 | #' vcov(fit2) 80 | #' } 81 | vcov.mjoint <- function(object, correlation = FALSE, ...) { 82 | 83 | # Have used code by Dimitris Rizopoulos here after having some 84 | # issues inverting the matrix. 85 | # URL: https://github.com/drizopoulos/JM/blob/master/R/vcov.jointModel.R 86 | 87 | if (!inherits(object, "mjoint")) { 88 | stop("Use only with 'mjoint' model objects.\n") 89 | } 90 | 91 | out <- try(qr.solve(object$Hessian, tol = 1e-12), silent = TRUE) 92 | 93 | if (!inherits(out, "try-error")) { 94 | vmat <- structure(out, dimnames = dimnames(object$Hessian)) 95 | } else { 96 | vmat <- structure(MASS::ginv(object$Hessian), dimnames = dimnames(object$Hessian)) 97 | } 98 | vmat <- (vmat + t(vmat)) / 2 99 | 100 | if (!correlation) { 101 | vmat 102 | } else { 103 | stats::cov2cor(vmat) 104 | } 105 | 106 | } 107 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Other notes 2 | 3 | * Addresses all NOTES from CRAN Package Check Results. 4 | 5 | ## Test environments 6 | 7 | * local macOS (Sonoma 14.6.1) install, R 4.4.2 8 | * ubuntu (via GitHub actions, release + devel) 9 | * macOS (via GitHub actions, release) 10 | * windows (via appveyor CI, release) 11 | * windows (via GitHub actions, release) 12 | * windows (via win-builder, old + release + devel) 13 | 14 | ## R CMD check results 15 | 16 | 0 errors | 0 warnings | 1 notes 17 | 18 | Win-Builder NOTE: "checking CRAN incoming feasibility ... NOTE" 19 | 20 | ## Reverse dependencies 21 | 22 | We checked 3 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 23 | 24 | * We saw 0 new problems 25 | * We failed to check 0 packages 26 | -------------------------------------------------------------------------------- /data-raw/qol/.Rapp.history: -------------------------------------------------------------------------------- 1 | load("/Users/graemeleehickey/GitHub/datasets/epileptic.qol/epileptic.qol.Rdata") 2 | load("/Users/graemeleehickey/GitHub/datasets/qol/qol.Rdata") 3 | ls() 4 | -------------------------------------------------------------------------------- /data-raw/qol/epileptic.qol.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data-raw/qol/epileptic.qol.Rdata -------------------------------------------------------------------------------- /data-raw/qol/prepare_data.R: -------------------------------------------------------------------------------- 1 | # NB: subject randomisation numbers have be over-written in the CSV file 2 | # to further anonymise the data 3 | 4 | #********************************************** 5 | # Read-in CSV data 6 | #********************************************** 7 | 8 | epileptic <- read.csv("./data-raw/qol/qol.csv") 9 | 10 | colnames(epileptic)[1:4] <- c("id", "with.time", "trt", "with.status") 11 | 12 | epileptic <- by(epileptic, epileptic$id, FUN = function(x) { 13 | fu <- x[rep(1, 4), 1:4] 14 | time <- as.numeric(x[1, c("time.b", "time.3m", "time.1y", "time.2y")]) 15 | anxiety <- as.numeric(x[1, c("Anxiety.b", "Anxiety.3m", "Anxiety.1y", "Anxiety.2y")]) 16 | depress <- as.numeric(x[1, c("Depress.b", "Depress.3m", "Depress.1y", "Depress.2y")]) 17 | aep <- as.numeric(x[1, c("AEP.b", "AEP.3m", "AEP.1y", "AEP.2y")]) 18 | cbind(fu, time, anxiety, depress, aep) 19 | }) 20 | 21 | #------------------------------------------------------------------ 22 | 23 | #********************************************** 24 | # Code missing data 25 | #********************************************** 26 | 27 | epileptic <- do.call("rbind", epileptic) 28 | epileptic$time[epileptic$time == "999"] <- NA 29 | epileptic$time[epileptic$time < 0] <- NA 30 | epileptic$anxiety[epileptic$anxiety == "999"] <- NA 31 | epileptic$depress[epileptic$depress == "999"] <- NA 32 | epileptic$aep[epileptic$aep == "999"] <- NA 33 | 34 | epileptic <- epileptic[!is.na(epileptic$time), ] 35 | 36 | #------------------------------------------------------------------ 37 | 38 | #********************************************** 39 | # Finalise datasets 40 | #********************************************** 41 | 42 | epileptic$with.status2 <- as.numeric(epileptic$with.status != 0) 43 | row.names(epileptic) <- seq_len(nrow(epileptic)) 44 | epileptic.qol <- epileptic 45 | epileptic.qol <- droplevels(qol) 46 | save(epileptic.qol, file = "epileptic.qol.Rdata") 47 | -------------------------------------------------------------------------------- /data-raw/renal/.Rapp.history: -------------------------------------------------------------------------------- 1 | load("/Users/graemeleehickey/GitHub/datasets/renal/renal.Rdata") 2 | -------------------------------------------------------------------------------- /data-raw/renal/prepare_data.R: -------------------------------------------------------------------------------- 1 | #********************************************** 2 | # Read-in CSV data 3 | #********************************************** 4 | 5 | # Haematocrit 6 | haem <- read.csv("haem_raw.csv") 7 | haem <- haem[c("id", "haematocrit", "yearse", "gender", "weight", "age", 8 | "failure", "followyear")] 9 | names(haem) <- c("id", "haematocrit", "years", "gender", "weight", "age", 10 | "failure", "fuyears") 11 | haem$haematocrit <- 100 * haem$haematocrit 12 | 13 | # Proteinuria 14 | prot <- read.csv("prot_raw.csv") 15 | prot$proteinuria <- as.numeric(prot$proteinuria >= 1) 16 | prot <- prot[c("PATID", "proteinuria", "yearse", 17 | "failure", "followyear")] 18 | names(prot) <- c("id", "proteinuria", "years", 19 | "failure", "fuyears") 20 | 21 | # eGFR 22 | gfr <- read.csv("gfr_raw.csv") 23 | names(gfr) <- c("id", "failure", "failure10", "years", "gfr", "fuyears") 24 | gfr <- gfr[c("id", "gfr", "years", "failure", "fuyears")] 25 | 26 | #------------------------------------------------------------------ 27 | 28 | #********************************************** 29 | # Re-order and restrict to common patients 30 | #********************************************** 31 | 32 | ind.gfr <- gfr$id %in% unique(haem$id) 33 | gfr <- gfr[ind.gfr, ] 34 | gfr <- gfr[order(gfr$id, gfr$years), ] 35 | ind.prot <- prot$id %in% unique(haem$id) 36 | prot <- prot[ind.prot, ] 37 | prot <- prot[order(prot$id, prot$years), ] 38 | haem <- haem[order(haem$id, haem$years), ] 39 | 40 | #------------------------------------------------------------------ 41 | 42 | #********************************************** 43 | # Covariate data 44 | #********************************************** 45 | 46 | # Weight 47 | sp <- sapply(split(haem$weight, haem$id), "[", 1) 48 | prot$weight <- rep(sp, tapply(prot$id, prot$id, length)) 49 | gfr$weight <- rep(sp, tapply(gfr$id, gfr$id, length)) 50 | 51 | # Age 52 | sp <- sapply(split(haem$age, haem$id), "[", 1) 53 | prot$age <- rep(sp, tapply(prot$id, prot$id, length)) 54 | gfr$age <- rep(sp, tapply(gfr$id, gfr$id, length)) 55 | 56 | # Gender 57 | sp <- sapply(split(haem$gender, haem$id), "[", 1) 58 | prot$gender <- rep(sp, tapply(prot$id, prot$id, length)) 59 | gfr$gender <- rep(sp, tapply(gfr$id, gfr$id, length)) 60 | 61 | # Event time (for heamoglobin data) 62 | sp <- sapply(split(gfr$fuyears, gfr$id), "[", 1) 63 | haem$fuyears <- rep(sp, tapply(haem$id, haem$id, length)) 64 | haem <- haem[, c(1:3, 7:8, 4:6)] 65 | 66 | #------------------------------------------------------------------ 67 | 68 | #********************************************** 69 | # Finalise datasets 70 | #********************************************** 71 | 72 | # Convert IDs to factors 73 | gfr$id <- factor(gfr$id) 74 | haem$id <- factor(haem$id) 75 | prot$id <- factor(prot$id) 76 | 77 | # Remove missing values 78 | gfr <- gfr[!is.na(gfr$gfr), ] 79 | haem <- haem[!is.na(haem$haematocrit), ] 80 | prot <- prot[!is.na(prot$proteinuria), ] 81 | 82 | # Remove biomarkers measured at or after event time 83 | sp <- split(haem, haem$id) 84 | lsp <- lapply(sp, function (x) x[x$years < x$fuyears, ]) 85 | haem <- do.call("rbind", lsp) 86 | sp <- split(gfr, gfr$id) 87 | lsp <- lapply(sp, function (x) x[x$years < x$fuyears, ]) 88 | gfr <- do.call("rbind", lsp) 89 | sp <- split(prot, prot$id) 90 | lsp <- lapply(sp, function (x) x[x$years < x$fuyears, ]) 91 | prot <- do.call("rbind", lsp) 92 | 93 | # Clean the rownames 94 | row.names(prot) <- seq_len(nrow(prot)) 95 | row.names(haem) <- seq_len(nrow(haem)) 96 | row.names(gfr) <- seq_len(nrow(gfr)) 97 | 98 | #------------------------------------------------------------------ 99 | 100 | #********************************************** 101 | # Survival data 102 | #********************************************** 103 | 104 | surv <- data.frame( 105 | id = names(tapply(gfr$id, gfr$id, "[", 1)), 106 | fuyears = tapply(gfr$fuyears, gfr$id, "[", 1), 107 | failure = tapply(gfr$failure, gfr$id, "[", 1), 108 | weight = tapply(gfr$weight, gfr$id, "[", 1), 109 | age = tapply(gfr$age, gfr$id, "[", 1), 110 | gender = factor(tapply(gfr$gender, gfr$id, "[", 1), levels = 1:2, 111 | labels = c("female", "male")) 112 | ) 113 | row.names(surv) <- seq_len(nrow(surv)) 114 | 115 | renal <- list("prot" = prot, "haem" = haem, "gfr" = gfr, "surv" = surv) 116 | save(renal, file = "renal.Rdata") 117 | -------------------------------------------------------------------------------- /data-raw/renal/renal.Rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data-raw/renal/renal.Rdata -------------------------------------------------------------------------------- /data/epileptic.qol.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data/epileptic.qol.rda -------------------------------------------------------------------------------- /data/heart.valve.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data/heart.valve.rda -------------------------------------------------------------------------------- /data/pbc2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data/pbc2.rda -------------------------------------------------------------------------------- /data/renal.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/data/renal.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite joineRML in publications please use:") 2 | 3 | bibentry( 4 | bibtype = "Article", 5 | doi = "10.1186/s12874-018-0502-1", 6 | url = "https://doi.org/10.1186%2Fs12874-018-0502-1", 7 | year = "2018", 8 | volume = "18", 9 | number = "1", 10 | author = "Graeme L. Hickey and Pete Philipson and Andrea Jorgensen and Ruwanthi Kolamunnage-Dona", 11 | title = "joineRML: a joint model and software package for time-to-event and multivariate longitudinal outcomes", 12 | journal = "BMC Medical Research Methodology", 13 | textVersion = "G.L. Hickey, P. Philipson, A. Jorgensen and R. Kolamunnage-Dona. joineRML: a joint model and software package for time-to-event and multivariate longitudinal outcomes. BMC Med Res Methodol 18, 50 (2018). https://doi.org/10.1186/s12874-018-0502-1" 14 | ) 15 | -------------------------------------------------------------------------------- /inst/image/hex/hex.R: -------------------------------------------------------------------------------- 1 | library(ggplot2) 2 | library(joineRML) 3 | library(reshape2) 4 | library(hexSticker) 5 | 6 | data(pbc2) 7 | pbc2 <- subset(pbc2, id != "228") 8 | pbc2 <- subset(pbc2, select = c(id, year, serBilir, albumin)) 9 | pbc2 <- melt(pbc2, id.vars = c("id", "year")) 10 | #pbc2$variable <- relevel(pbc2$variable, ref = "albumin") 11 | 12 | p <- ggplot(aes(x = year, y = log(value)), data = pbc2) + 13 | geom_line(aes(group = id), alpha = 0.5) + 14 | geom_line(data = subset(pbc2, id == "11"), colour = "red") + 15 | facet_wrap( ~ variable, scales = "free_y") + 16 | labs(x = "", y = "") + 17 | theme_void() + 18 | theme(strip.background = element_blank(), 19 | strip.text = element_blank()) 20 | 21 | sticker(p, package = "joineRML", 22 | p_size = 8, 23 | s_x = 1, s_y = .8, s_width = 1.5, s_height = 0.9, 24 | #p_color = "#FFFFFFDD", 25 | h_color = "#C76730", 26 | h_fill = "#3090C7") 27 | -------------------------------------------------------------------------------- /joineRML.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 483f8e9f-e2c4-4816-8f7d-0c5691e666d3 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: knitr 14 | LaTeX: pdfLaTeX 15 | 16 | BuildType: Package 17 | PackageUseDevtools: Yes 18 | PackageInstallArgs: --no-multiarch --with-keep.source 19 | PackageBuildArgs: --compact-vignettes=both 20 | PackageBuildBinaryArgs: --compact-vignettes=both 21 | PackageCheckArgs: --as-cran 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/.gitignore: -------------------------------------------------------------------------------- 1 | .Rapp.history 2 | -------------------------------------------------------------------------------- /man/baseHaz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/baseHaz.R 3 | \name{baseHaz} 4 | \alias{baseHaz} 5 | \title{The baseline hazard estimate of an \code{mjoint} object} 6 | \usage{ 7 | baseHaz(object, centered = TRUE, se = FALSE) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{centered}{logical: should the baseline hazard be for the mean-centered 14 | covariates model or not? Default is \code{centered=TRUE}. See 15 | \strong{Details}.} 16 | 17 | \item{se}{logical: should standard errors be approximated for the hazard 18 | increments? Default is \code{se=FALSE}.} 19 | } 20 | \value{ 21 | A \code{data.frame} with two columns: the unique failure times and 22 | the estimate baseline hazard. If \code{se=TRUE}, then a third column is 23 | appended with the corresponding standard errors (for the centred case). 24 | } 25 | \description{ 26 | This function returns the (baseline) hazard increment from a 27 | fitted \code{mjoint} object. In addition, it can report either the 28 | \emph{uncentered} or the more ubiquitous \emph{centered} version. 29 | } 30 | \details{ 31 | When covariates are included in the time-to-event sub-model, 32 | \code{\link{mjoint}} automatically centers them about their respective 33 | means. This also applies to non-continuous covariates, which are first 34 | coded using a dummy-transformation for the design matrix and subsequently 35 | centered. The reason for the mean-centering is to improve numerical 36 | stability, as the survival function involves exponential terms. Extracting 37 | the baseline hazard increments from \code{\link{mjoint.object}} returns the 38 | Breslow hazard estimate (Lin, 2007) that corresponds to this mean-centered 39 | model. This is the same as is done in the R \code{survival} package when 40 | using \code{\link[survival]{coxph.detail}} (Therneau and Grambsch, 2000). 41 | If the user wants to access the baseline hazard estimate for the model in 42 | which no mean-centering is applied, then they can use this function, which 43 | scales the mean-centered baseline hazard by 44 | 45 | \deqn{\exp\{-\bar{w}^\top \gamma_v\},} 46 | 47 | where \eqn{\bar{w}} is a vector of the means from the time-to-event 48 | sub-model design matrix. 49 | } 50 | \examples{ 51 | 52 | \dontrun{ 53 | # Fit a joint model with bivariate longitudinal outcomes 54 | 55 | data(heart.valve) 56 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 57 | 58 | fit2 <- mjoint( 59 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 60 | "lvmi" = log.lvmi ~ time + sex), 61 | formLongRandom = list("grad" = ~ 1 | num, 62 | "lvmi" = ~ time | num), 63 | formSurv = Surv(fuyrs, status) ~ age, 64 | data = list(hvd, hvd), 65 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 66 | timeVar = "time", 67 | verbose = TRUE) 68 | baseHaz(fit2, centered = FALSE) 69 | } 70 | } 71 | \references{ 72 | Therneau TM, Grambsch PM. \emph{Modeling Survival Data: Extending the Cox 73 | Model.} New Jersey: Springer-Verlag; 2000. 74 | 75 | Lin DY. On the Breslow estimator. \emph{Lifetime Data Anal.} 2007; 76 | \strong{13(4)}: 471-480. 77 | } 78 | \seealso{ 79 | \code{\link{mjoint}} and \code{\link[stats]{coef}}. 80 | } 81 | \author{ 82 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 83 | } 84 | \keyword{methods} 85 | \keyword{survival} 86 | -------------------------------------------------------------------------------- /man/confint.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/confint.mjoint.R 3 | \name{confint.mjoint} 4 | \alias{confint.mjoint} 5 | \title{Confidence intervals for model parameters of an \code{mjoint} object} 6 | \usage{ 7 | \method{confint}{mjoint}( 8 | object, 9 | parm = c("Both", "Longitudinal", "Event"), 10 | level = 0.95, 11 | bootSE = NULL, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 17 | of time-to-event and multivariate longitudinal data.} 18 | 19 | \item{parm}{a character string specifying which sub-model parameter 20 | confidence intervals should be returned for. Can be specified as 21 | \code{parm='Longitudinal'} (multivariate longitudinal sub-model), 22 | \code{parm='Event'} (time-to-event sub-model), or \code{parm='both'} 23 | (default).} 24 | 25 | \item{level}{the confidence level required. Default is \code{level=0.95} for 26 | a 95\% confidence interval.} 27 | 28 | \item{bootSE}{an object inheriting from class \code{bootSE} for the 29 | corresponding model. If \code{bootSE=NULL}, the function will attempt to 30 | utilize approximate standard error estimates (if available) calculated from 31 | the empirical information matrix.} 32 | 33 | \item{...}{additional arguments; currently none are used.} 34 | } 35 | \value{ 36 | A matrix containing the confidence intervals for either the 37 | longitudinal, time-to-event, or both sub-models. 38 | } 39 | \description{ 40 | This function computes confidence intervals for one or more 41 | parameters in a fitted \code{mjoint} object. 42 | } 43 | \examples{ 44 | \dontrun{ 45 | # Fit a classical univariate joint model with a single longitudinal outcome 46 | # and a single time-to-event outcome 47 | 48 | data(heart.valve) 49 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 50 | 51 | gamma <- c(0.1059417, 1.0843359) 52 | sigma2 <- 0.03725999 53 | beta <- c(4.9988669999, -0.0093527634, 0.0004317697) 54 | D <- matrix(c(0.128219108, -0.006665505, -0.006665505, 0.002468688), 55 | nrow = 2, byrow = TRUE) 56 | 57 | set.seed(1) 58 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 59 | formLongRandom = ~ time | num, 60 | formSurv = Surv(fuyrs, status) ~ age, 61 | data = hvd, 62 | timeVar = "time", 63 | inits = list(gamma = gamma, sigma2 = sigma2, beta = beta, D = D), 64 | control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 65 | 66 | confint(fit1, parm = "Longitudinal") 67 | } 68 | 69 | \dontrun{ 70 | # Fit a joint model with bivariate longitudinal outcomes 71 | 72 | data(heart.valve) 73 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 74 | 75 | fit2 <- mjoint( 76 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 77 | "lvmi" = log.lvmi ~ time + sex), 78 | formLongRandom = list("grad" = ~ 1 | num, 79 | "lvmi" = ~ time | num), 80 | formSurv = Surv(fuyrs, status) ~ age, 81 | data = list(hvd, hvd), 82 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 83 | timeVar = "time", 84 | verbose = TRUE) 85 | confint(fit2) 86 | } 87 | } 88 | \references{ 89 | McLachlan GJ, Krishnan T. \emph{The EM Algorithm and Extensions.} Second 90 | Edition. Wiley-Interscience; 2008. 91 | 92 | Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 93 | measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 94 | 465-480. 95 | 96 | Lin H, McCulloch CE, Mayne ST. Maximum likelihood estimation in the joint 97 | analysis of time-to-event and multiple longitudinal variables. \emph{Stat 98 | Med.} 2002; \strong{21}: 2369-2382. 99 | 100 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 101 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 102 | } 103 | \seealso{ 104 | \code{\link{mjoint}}, \code{\link{bootSE}}, and 105 | \code{\link[stats]{confint}} for the generic method description. 106 | } 107 | \author{ 108 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 109 | } 110 | \keyword{methods} 111 | -------------------------------------------------------------------------------- /man/epileptic.qol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/epileptic.qol.R 3 | \docType{data} 4 | \name{epileptic.qol} 5 | \alias{epileptic.qol} 6 | \title{Quality of life data following epilepsy drug treatment} 7 | \format{ 8 | A data frame with 1853 observations on the following 9 variables: 9 | \describe{ 10 | 11 | \item{\code{id}}{patients identifier; in total there are 544 patients.} 12 | 13 | \item{\code{with.time}}{number of days between registration and the earlier 14 | of treatment failure or study analysis time.} 15 | 16 | \item{\code{trt}}{a factor with levels \code{CBZ} and \code{LTG} denoting 17 | carbamazepine and lamotrigine, respectively.} 18 | 19 | \item{\code{with.status}}{the reason for treatment failure. Coded as 20 | \code{0=}censored; \code{1=}unacceptable adverse effects; 21 | \code{2=}inadequate seizure control.} 22 | 23 | \item{\code{time}}{the time the quality of life measures were recorded 24 | (days). The first measurement for each subject is the baseline measurement, 25 | however there was variability between the time taken to return the 26 | questionnaires; hence the reason this is non-zero. Similarly, the second, 27 | third, and fourth follow-up times, which were scheduled for 3-months, 28 | 1-year, and 2-years, respectively, also had variability in completion 29 | times.} 30 | 31 | \item{\code{anxiety}}{a continuous measure of anxiety, as defined according 32 | to the NEWQOL (Newly Diagnosed Epilepsy Quality of Life) assessment. Higher 33 | scores are indicative of worse QoL.} 34 | 35 | \item{\code{depress}}{a continuous measure of depression, as defined 36 | according to the NEWQOL (Newly Diagnosed Epilepsy Quality of Life) 37 | assessment. Higher scores are indicative of worse QoL.} 38 | 39 | \item{\code{aep}}{a continuous measure of the Liverpool Adverse Events 40 | Profile (AEP), as defined according to the NEWQOL (Newly Diagnosed Epilepsy 41 | Quality of Life) assessment. Higher scores are indicative of worse QoL.} 42 | 43 | \item{\code{with.status2}}{a binary indicator of composite treatment 44 | failure (for any reason), coded \code{status2=1}, or right-censoring 45 | \code{status2=0}.} 46 | 47 | } 48 | } 49 | \source{ 50 | SANAD Trial: University of Liverpool. See Jacoby et al. (2015). 51 | } 52 | \usage{ 53 | data(epileptic.qol) 54 | } 55 | \description{ 56 | The SANAD (Standard and New Antiepileptic Drugs) study (Marson 57 | et al., 2007) is a randomised control trial of standard and new 58 | antiepileptic drugs, comparing effects on longer term clinical outcomes. 59 | Quality of life (QoL) data were collected by mail at baseline, 3 months, 60 | and at 1 and 2 years using validated measures. This data is a subset of the 61 | trial for 544 patients randomised to one of 2 drugs: carbamazepine and 62 | lamotrigine. 63 | } 64 | \references{ 65 | Jacoby A, Sudell M, Tudur Smith C, et al. Quality-of-life outcomes of 66 | initiating treatment with standard and newer antiepileptic drugs in adults 67 | with new-onset epilepsy: Findings from the SANAD trial. \emph{Epilepsia}. 68 | 2015; \strong{56(3)}: 460-472. 69 | 70 | Marson AG, Appleton R, Baker GA, et al. A randomised controlled trial 71 | examining longer-term outcomes of standard versus new antiepileptic drugs. 72 | The SANAD Trial. \emph{Health Technology Assessment}. 2007; \strong{11(37)}. 73 | 74 | Marson AG, Al-Kharusi AM, Alwaidh M, et al. The SANAD study of effectiveness 75 | of carbamazepine, gabapentin, lamotrigine, oxcarbazepine, or topiramate for 76 | treatment of partial epilepsy: an unblinded randomised controlled trial. 77 | \emph{Lancet}. 2007; \strong{365}: 2007-2013. 78 | 79 | Abetz L, Jacoby A, Baker GA, et al. Patient-based assessments of quality of 80 | life in newly diagnosed epilepsy patients: validation of the NEWQOL. 81 | \emph{Epilepsia}. 2000; \strong{41}: 1119-1128. 82 | } 83 | \seealso{ 84 | \code{\link{pbc2}}, \code{\link{heart.valve}}, \code{\link{renal}}. 85 | } 86 | \keyword{datasets} 87 | -------------------------------------------------------------------------------- /man/figures/hex.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/man/figures/hex.png -------------------------------------------------------------------------------- /man/fitted.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fitted.mjoint.R 3 | \name{fitted.mjoint} 4 | \alias{fitted.mjoint} 5 | \title{Extract \code{mjoint} fitted values} 6 | \usage{ 7 | \method{fitted}{mjoint}(object, level = 0, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{level}{an optional integer giving the level of grouping to be used in 14 | extracting the fitted values from object. Level values increase from outermost 15 | to innermost grouping, with level 0 corresponding to the population 16 | fitted values and level 1 corresponding to subject-specific fitted values Defaults 17 | to level 0.} 18 | 19 | \item{...}{additional arguments; currently none are used.} 20 | } 21 | \value{ 22 | A \code{list} of length \emph{K} with each element a vector of 23 | fitted values for the \emph{k}-th longitudinal outcome. 24 | } 25 | \description{ 26 | The fitted values at level \emph{i} are obtained by adding 27 | together the population fitted values (based only on the fixed effects 28 | estimates) and the estimated contributions of the random effects. 29 | } 30 | \references{ 31 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 32 | Springer Verlag; 2000. 33 | } 34 | \seealso{ 35 | \code{\link{mjoint}}, \code{\link{residuals.mjoint}} 36 | } 37 | \author{ 38 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 39 | } 40 | \keyword{methods} 41 | -------------------------------------------------------------------------------- /man/fixef.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fixef.mjoint.R 3 | \name{fixef.mjoint} 4 | \alias{fixef.mjoint} 5 | \title{Extract fixed effects estimates from an \code{mjoint} object} 6 | \usage{ 7 | \method{fixef}{mjoint}(object, process = c("Longitudinal", "Event"), ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{process}{character string: if \code{process='Longitudinal'} the fixed 14 | effects coefficients from the (multivariate) longitudinal sub-model are 15 | returned. Else, if \code{process='Event'}, the coefficients from the 16 | time-to-event sub-model are returned.} 17 | 18 | \item{...}{additional arguments; currently none are used.} 19 | } 20 | \value{ 21 | A named vector of length equal to the number of sub-model 22 | coefficients estimated. 23 | } 24 | \description{ 25 | Extract fixed effects estimates from an \code{mjoint} object. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | # Fit a classical univariate joint model with a single longitudinal outcome 30 | # and a single time-to-event outcome 31 | 32 | data(heart.valve) 33 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 34 | 35 | set.seed(1) 36 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 37 | formLongRandom = ~ time | num, 38 | formSurv = Surv(fuyrs, status) ~ age, 39 | data = hvd, 40 | timeVar = "time", 41 | control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 42 | 43 | fixef(fit1, process = "Longitudinal") 44 | fixef(fit1, process = "Event") 45 | } 46 | 47 | \dontrun{ 48 | # Fit a joint model with bivariate longitudinal outcomes 49 | 50 | data(heart.valve) 51 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 52 | 53 | fit2 <- mjoint( 54 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 55 | "lvmi" = log.lvmi ~ time + sex), 56 | formLongRandom = list("grad" = ~ 1 | num, 57 | "lvmi" = ~ time | num), 58 | formSurv = Surv(fuyrs, status) ~ age, 59 | data = list(hvd, hvd), 60 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 61 | timeVar = "time", 62 | verbose = TRUE) 63 | 64 | fixef(fit2, process = "Longitudinal") 65 | fixef(fit2, process = "Event") 66 | } 67 | } 68 | \references{ 69 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 70 | Springer Verlag; 2000. 71 | 72 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 73 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 74 | } 75 | \seealso{ 76 | \code{\link[nlme]{fixef}} for the generic method description, and 77 | \code{\link{ranef.mjoint}}. 78 | } 79 | \author{ 80 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 81 | } 82 | \keyword{methods} 83 | -------------------------------------------------------------------------------- /man/formula.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/formula.mjoint.R 3 | \name{formula.mjoint} 4 | \alias{formula.mjoint} 5 | \title{Extract model formulae from an \code{mjoint} object} 6 | \usage{ 7 | \method{formula}{mjoint}(x, process = c("Longitudinal", "Event"), k = 1, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object inheriting from class \code{mjoint} for a joint model of 11 | time-to-event and multivariate longitudinal data.} 12 | 13 | \item{process}{character string: if \code{process='Longitudinal'} a fixed 14 | effects formula from the (multivariate) longitudinal sub-model is returned 15 | for the \code{k}-th outcome. Else, if \code{process='Event'}, the 16 | time-to-event model formula is returned.} 17 | 18 | \item{k}{integer: a number between 1 and \emph{K} (the total number of 19 | longitudinal outcomes) that specifies the longitudinal outcome of interest.} 20 | 21 | \item{...}{additional arguments; currently none are used.} 22 | } 23 | \value{ 24 | An object of class "formula" which contains a symbolic model formula 25 | for the separate sub-model fixed effect terms only. 26 | } 27 | \description{ 28 | Extract model formulae from an \code{mjoint} object. 29 | } 30 | \references{ 31 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 32 | Springer Verlag; 2000. 33 | 34 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 35 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 36 | } 37 | \seealso{ 38 | \code{\link[stats]{formula}} for the generic method description, and 39 | \code{\link{ranef.mjoint}}. 40 | } 41 | \author{ 42 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 43 | } 44 | \keyword{methods} 45 | -------------------------------------------------------------------------------- /man/getVarCov.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/getVarCov.mjoint.R 3 | \name{getVarCov.mjoint} 4 | \alias{getVarCov.mjoint} 5 | \title{Extract variance-covariance matrix of random effects from an \code{mjoint} 6 | object} 7 | \usage{ 8 | \method{getVarCov}{mjoint}(obj, ...) 9 | } 10 | \arguments{ 11 | \item{obj}{an object inheriting from class \code{mjoint} for a joint model of 12 | time-to-event and multivariate longitudinal data.} 13 | 14 | \item{...}{additional arguments; currently none are used.} 15 | } 16 | \value{ 17 | A variance-covariance matrix. 18 | } 19 | \description{ 20 | Extract variance-covariance matrix of random effects from an 21 | \code{mjoint} object. 22 | } 23 | \examples{ 24 | \dontrun{ 25 | # Fit a joint model with bivariate longitudinal outcomes 26 | 27 | data(heart.valve) 28 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 29 | 30 | fit2 <- mjoint( 31 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 32 | "lvmi" = log.lvmi ~ time + sex), 33 | formLongRandom = list("grad" = ~ 1 | num, 34 | "lvmi" = ~ time | num), 35 | formSurv = Surv(fuyrs, status) ~ age, 36 | data = list(hvd, hvd), 37 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 38 | timeVar = "time", 39 | verbose = TRUE) 40 | 41 | getVarCov(fit2) 42 | } 43 | } 44 | \references{ 45 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 46 | Springer Verlag; 2000. 47 | } 48 | \seealso{ 49 | \code{\link[nlme]{getVarCov}} for the generic method description. 50 | } 51 | \author{ 52 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 53 | } 54 | \keyword{methods} 55 | -------------------------------------------------------------------------------- /man/heart.valve.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/heart.valve.R 3 | \docType{data} 4 | \name{heart.valve} 5 | \alias{heart.valve} 6 | \title{Aortic valve replacement surgery data} 7 | \format{ 8 | This is a data frame in the unbalanced format, that is, with one row 9 | per observation. The data consists in columns for patient identification, 10 | time of measurements, longitudinal multiple longitudinal measurements, 11 | baseline covariates, and survival data. The column names are identified as 12 | follows: \describe{ 13 | 14 | \item{\code{num}}{number for patient identification.} 15 | 16 | \item{\code{sex}}{gender of patient (\code{0=}Male and \code{1=}Female).} 17 | 18 | \item{\code{age}}{age of patient at day of surgery (years).} 19 | 20 | \item{\code{time}}{observed time point, with surgery date as the time 21 | origin (years).} 22 | 23 | \item{\code{fuyrs}}{maximum follow up time, with surgery date as the time 24 | origin (years).} 25 | 26 | \item{\code{status}}{censoring indicator (\code{1=}died and \code{0=}lost 27 | at follow up).} 28 | 29 | \item{\code{grad}}{valve gradient at follow-up visit.} 30 | 31 | \item{\code{log.grad}}{natural log transformation of \code{grad}.} 32 | 33 | \item{\code{lvmi}}{left ventricular mass index (standardised) at follow-up 34 | visit.} 35 | 36 | \item{\code{log.lvmi}}{natural log transformation of \code{lvmi}.} 37 | 38 | \item{\code{ef}}{ejection fraction at follow-up visit.} 39 | 40 | \item{\code{bsa}}{preoperative body surface area.} 41 | 42 | \item{\code{lvh}}{preoperative left ventricular hypertrophy.} 43 | 44 | \item{\code{prenyha}}{preoperative New York Heart Association (NYHA) 45 | classification (\code{1=}I/II and \code{3=}III/IV).} 46 | 47 | \item{\code{redo}}{previous cardiac surgery.} 48 | 49 | \item{\code{size}}{size of the valve (millimeters).} 50 | 51 | \item{\code{con.cabg}}{concomitant coronary artery bypass graft.} 52 | 53 | \item{\code{creat}}{preoperative serum creatinine (\eqn{\mu}mol/mL).} 54 | 55 | \item{\code{dm}}{preoperative diabetes.} 56 | 57 | \item{\code{acei}}{preoperative use of ace inhibitor.} 58 | 59 | \item{\code{lv}}{preoperative left ventricular ejection fraction (LVEF) 60 | (\code{1=}good, \code{2=}moderate, and \code{3=}poor).} 61 | 62 | \item{\code{emergenc}}{operative urgency (\code{0=}elective, \code{1 = 63 | }urgent, and \code{3=}emergency).} 64 | 65 | \item{\code{hc}}{preoperative high cholesterol (\code{0=}absent, \code{1 66 | =}present treated, and \code{2=}present untreated).} 67 | 68 | \item{\code{sten.reg.mix}}{aortic valve haemodynamics (\code{1=}stenosis, 69 | \code{2=}regurgitation, \code{3=}mixed).} 70 | 71 | \item{\code{hs}}{implanted aortic prosthesis type (\code{1=}homograft and 72 | \code{0=}stentless porcine tissue).} 73 | 74 | } 75 | } 76 | \usage{ 77 | data(heart.valve) 78 | } 79 | \description{ 80 | This is longitudinal data on an observational study on detecting 81 | effects of different heart valves, differing on type of tissue, implanted 82 | in the aortic position. The data consists of longitudinal measurements on 83 | three different heart function outcomes, after surgery occurred. There are 84 | several baseline covariates available, and also survival data. 85 | } 86 | \references{ 87 | Lim E, Ali A, Theodorou P, Sousa I, Ashrafian H, Chamageorgakis T, Duncan M, 88 | Diggle P, Pepper J. A longitudinal study of the profile and predictors of 89 | left ventricular mass regression after stentless aortic valve replacement. 90 | \emph{Ann Thorac Surg.} 2008; \strong{85(6)}: 2026-2029. 91 | } 92 | \seealso{ 93 | \code{\link{pbc2}}, \code{\link{renal}}, 94 | \code{\link{epileptic.qol}}. 95 | } 96 | \keyword{datasets} 97 | -------------------------------------------------------------------------------- /man/joineRML-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/joineRML.R 3 | \docType{package} 4 | \name{joineRML-package} 5 | \alias{joineRML-package} 6 | \title{joineRML: Joint Modelling of Multivariate Longitudinal Data and Time-to-Event Outcomes} 7 | \description{ 8 | Fits the joint model proposed by Henderson and colleagues (2000) \doi{10.1093/biostatistics/1.4.465}, but extended to the case of multiple continuous longitudinal measures. The time-to-event data is modelled using a Cox proportional hazards regression model with time-varying covariates. The multiple longitudinal outcomes are modelled using a multivariate version of the Laird and Ware linear mixed model. The association is captured by a multivariate latent Gaussian process. The model is estimated using a Monte Carlo Expectation Maximization algorithm. This project was funded by the Medical Research Council (Grant number MR/M013227/1). 9 | } 10 | \seealso{ 11 | Useful links: 12 | \itemize{ 13 | \item \url{https://github.com/graemeleehickey/joineRML} 14 | \item Report bugs at \url{https://github.com/graemeleehickey/joineRML/issues} 15 | } 16 | 17 | } 18 | \author{ 19 | \strong{Maintainer}: Graeme L. Hickey \email{graemeleehickey@gmail.com} (\href{https://orcid.org/0000-0002-4989-0054}{ORCID}) 20 | 21 | Authors: 22 | \itemize{ 23 | \item Pete Philipson \email{peter.philipson1@newcastle.ac.uk} (\href{https://orcid.org/0000-0001-7846-0208}{ORCID}) 24 | \item Ruwanthi Kolamunnage-Dona \email{kdrr@liverpool.ac.uk} (\href{https://orcid.org/0000-0003-3886-6208}{ORCID}) 25 | \item Alessandro Gasparini \email{alessandro.gasparini@ki.se} (\href{https://orcid.org/0000-0002-8319-7624}{ORCID}) 26 | } 27 | 28 | Other contributors: 29 | \itemize{ 30 | \item Andrea Jorgensen \email{aljorgen@liverpool.ac.uk} (\href{https://orcid.org/0000-0002-6977-9337}{ORCID}) [contributor] 31 | \item Paula Williamson \email{p.r.williamson@liverpool.ac.uk} (\href{https://orcid.org/0000-0001-9802-6636}{ORCID}) [contributor] 32 | \item Dimitris Rizopoulos \email{d.rizopoulos@erasmusmc.nl} (data/renal.rda, R/hessian.R, R/vcov.R) [contributor, data contributor] 33 | \item Medical Research Council (Grant number: MR/M013227/1) [funder] 34 | } 35 | 36 | } 37 | \keyword{internal} 38 | -------------------------------------------------------------------------------- /man/joineRML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/joineRML.R 3 | \name{joineRML} 4 | \alias{joineRML} 5 | \title{joineRML} 6 | \description{ 7 | joineRML is an extension of the joineR package for fitting joint 8 | models of time-to-event data and multivariate longitudinal data. The model 9 | fitted in joineRML is an extension of the Wulfsohn and Tsiatis (1997) and 10 | Henderson et al. (2000) models, which is comprised on 11 | \eqn{(K+1)}-sub-models: a Cox proportional hazards regression model (Cox, 12 | 1972) and a \emph{K}-variate linear mixed-effects model - a direct 13 | extension of the Laird and Ware (1982) regression model. The model is 14 | fitted using a Monte Carlo Expectation-Maximization (MCEM) algorithm, which 15 | closely follows the methodology presented by Lin et al. (2002). 16 | } 17 | \references{ 18 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 19 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 20 | 21 | Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 22 | measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 23 | 465-480. 24 | 25 | Cox DR. Regression models and life-tables. \emph{J R Stat Soc Ser B Stat 26 | Methodol.} 1972; \strong{34(2)}: 187-220. 27 | 28 | Laird NM, Ware JH. Random-effects models for longitudinal data. 29 | \emph{Biometrics.} 1982; \strong{38(4)}: 963-974. 30 | } 31 | -------------------------------------------------------------------------------- /man/logLik.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/logLik.mjoint.R 3 | \name{logLik.mjoint} 4 | \alias{logLik.mjoint} 5 | \title{Extract log-likelihood from an \code{mjoint} object} 6 | \usage{ 7 | \method{logLik}{mjoint}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{...}{additional arguments; currently none are used.} 14 | } 15 | \value{ 16 | Returns an object of class \code{logLik}. This is a number with two 17 | attributes: \code{df} (degrees of freedom), giving the number of parameters 18 | in the model, and \code{nobs}, the number of observations used in 19 | estimation. 20 | } 21 | \description{ 22 | Extract log-likelihood from an \code{mjoint} object. 23 | } 24 | \examples{ 25 | \dontrun{ 26 | # Fit a joint model with bivariate longitudinal outcomes 27 | 28 | data(heart.valve) 29 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 30 | fit2 <- mjoint( 31 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 32 | "lvmi" = log.lvmi ~ time + sex), 33 | formLongRandom = list("grad" = ~ 1 | num, 34 | "lvmi" = ~ time | num), 35 | formSurv = Surv(fuyrs, status) ~ age, 36 | data = list(hvd, hvd), 37 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 38 | timeVar = "time", 39 | verbose = TRUE) 40 | 41 | logLik(fit2) 42 | } 43 | } 44 | \references{ 45 | Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 46 | measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 47 | 465-480. 48 | } 49 | \seealso{ 50 | \code{\link[stats]{logLik}} for the generic method description. 51 | } 52 | \author{ 53 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 54 | } 55 | \keyword{methods} 56 | -------------------------------------------------------------------------------- /man/mjoint_tidiers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tidiers.R 3 | \name{mjoint_tidiers} 4 | \alias{mjoint_tidiers} 5 | \alias{tidy.mjoint} 6 | \alias{augment.mjoint} 7 | \alias{glance.mjoint} 8 | \title{Tidying methods for joint models for time-to-event data and multivariate 9 | longitudinal data} 10 | \usage{ 11 | \method{tidy}{mjoint}( 12 | x, 13 | component = "survival", 14 | bootSE = NULL, 15 | conf.int = FALSE, 16 | conf.level = 0.95, 17 | ... 18 | ) 19 | 20 | \method{augment}{mjoint}(x, data = x$data, ...) 21 | 22 | \method{glance}{mjoint}(x, ...) 23 | } 24 | \arguments{ 25 | \item{x}{An object of class \code{mjoint}.} 26 | 27 | \item{component}{Either \code{survival} (the survival component of the model, 28 | default) or \code{longitudinal} (the longitudinal component).} 29 | 30 | \item{bootSE}{An object of class \code{bootSE} for the corresponding model. 31 | If \code{bootSE = NULL} (the default), the function will use approximate 32 | standard error estimates calculated from the empirical information matrix.} 33 | 34 | \item{conf.int}{Include (1 - \code{conf.level})\% confidence intervals? 35 | Defaults to \code{FALSE}.} 36 | 37 | \item{conf.level}{The confidence level required.} 38 | 39 | \item{...}{extra arguments (not used)} 40 | 41 | \item{data}{Original data this was fitted on, in a list (e.g. 42 | \code{list(data)}). This will be extracted from \code{x} if not given.} 43 | } 44 | \value{ 45 | All tidying methods return a \code{data.frame} without rownames. The 46 | structure depends on the method chosen. 47 | 48 | \code{tidy} returns one row for each estimated fixed effect depending 49 | on the \code{component} parameter. It contains the following columns: 50 | \item{term}{The term being estimated} \item{estimate}{Estimated value} 51 | \item{std.error}{Standard error} \item{statistic}{Z-statistic} 52 | \item{p.value}{P-value computed from Z-statistic} \item{conf.low}{The lower 53 | bound of a confidence interval on \code{estimate}, if required} 54 | \item{conf.high}{The upper bound of a confidence interval on 55 | \code{estimate}, if required}. 56 | 57 | \code{augment} returns one row for each original observation, with 58 | columns (each prepended by a .) added. Included are the columns: 59 | \item{.fitted_j_0}{population-level fitted values for the j-th longitudinal 60 | process} \item{.fitted_j_1}{individuals-level fitted values for the j-th 61 | longitudinal process} \item{.resid_j_0}{population-level residuals for the 62 | j-th longitudinal process} \item{.resid_j_1}{individual-level residuals for 63 | the j-th longitudinal process} See \code{\link[joineRML]{fitted.mjoint}} 64 | and \code{\link[joineRML]{residuals.mjoint}} for more information on the 65 | difference between population-level and individual-level fitted values and 66 | residuals. 67 | 68 | \code{glance} returns one row with the columns \item{sigma2_j}{the 69 | square root of the estimated residual variance for the j-th longitudinal 70 | process} \item{AIC}{the Akaike Information Criterion} \item{BIC}{the 71 | Bayesian Information Criterion} \item{logLik}{the data's log-likelihood 72 | under the model}. 73 | } 74 | \description{ 75 | These methods tidy the coefficients of joint models for time-to-event data 76 | and multivariate longitudinal data of the \code{mjoint} class from the 77 | \code{joineRML} package. 78 | } 79 | \note{ 80 | If fitting a joint model with a single longitudinal process, please 81 | make sure you are using a named \code{list} to define the formula for the 82 | fixed and random effects of the longitudinal submodel. 83 | } 84 | \examples{ 85 | \dontrun{ 86 | # Fit a joint model with bivariate longitudinal outcomes 87 | library(joineRML) 88 | data(heart.valve) 89 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & 90 | !is.na(heart.valve$log.lvmi) & 91 | heart.valve$num <= 50, ] 92 | fit <- mjoint( 93 | formLongFixed = list( 94 | "grad" = log.grad ~ time + sex + hs, 95 | "lvmi" = log.lvmi ~ time + sex 96 | ), 97 | formLongRandom = list( 98 | "grad" = ~ 1 | num, 99 | "lvmi" = ~ time | num 100 | ), 101 | formSurv = Surv(fuyrs, status) ~ age, 102 | data = hvd, 103 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 104 | timeVar = "time" 105 | ) 106 | 107 | # Extract the survival fixed effects 108 | tidy(fit) 109 | 110 | # Extract the longitudinal fixed effects 111 | tidy(fit, component = "longitudinal") 112 | 113 | # Extract the survival fixed effects with confidence intervals 114 | tidy(fit, ci = TRUE) 115 | 116 | # Extract the survival fixed effects with confidence intervals based on 117 | # bootstrapped standard errors 118 | bSE <- bootSE(fit, nboot = 5, safe.boot = TRUE) 119 | tidy(fit, bootSE = bSE, ci = TRUE) 120 | 121 | # Augment original data with fitted longitudinal values and residuals 122 | hvd2 <- augment(fit) 123 | 124 | # Extract model statistics 125 | glance(fit) 126 | } 127 | 128 | } 129 | \author{ 130 | Alessandro Gasparini (\email{alessandro.gasparini@ki.se}) 131 | } 132 | -------------------------------------------------------------------------------- /man/pbc2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pbc2.R 3 | \docType{data} 4 | \name{pbc2} 5 | \alias{pbc2} 6 | \title{Mayo Clinic primary biliary cirrhosis data} 7 | \format{ 8 | A data frame with 1945 observations on the following 20 variables: 9 | \describe{ 10 | 11 | \item{\code{id}}{patients identifier; in total there are 312 patients.} 12 | 13 | \item{\code{years}}{number of years between registration and the earlier of 14 | death, transplantation, or study analysis time.} 15 | 16 | \item{\code{status}}{a factor with levels \code{alive}, \code{transplanted} 17 | and \code{dead}.} 18 | 19 | \item{\code{drug}}{a factor with levels \code{placebo} and 20 | \code{D-penicil}.} 21 | 22 | \item{\code{age}}{at registration in years.} 23 | 24 | \item{\code{sex}}{a factor with levels \code{male} and \code{female}.} 25 | 26 | \item{\code{year}}{number of years between enrollment and this visit date, 27 | remaining values on the line of data refer to this visit.} 28 | 29 | \item{\code{ascites}}{a factor with levels \code{No} and \code{Yes}.} 30 | 31 | \item{\code{hepatomegaly}}{a factor with levels \code{No} and \code{Yes}.} 32 | 33 | \item{\code{spiders}}{a factor with levels \code{No} and \code{Yes}.} 34 | 35 | \item{\code{edema}}{a factor with levels \code{No edema} (i.e. no edema and 36 | no diuretic therapy for edema), \code{edema no diuretics} (i.e. edema 37 | present without diuretics, or edema resolved by diuretics), and 38 | \code{edema despite diuretics} (i.e. edema despite diuretic therapy).} 39 | 40 | \item{\code{serBilir}}{serum bilirubin in mg/dl.} 41 | 42 | \item{\code{serChol}}{serum cholesterol in mg/dl.} 43 | 44 | \item{\code{albumin}}{albumin in mg/dl.} 45 | 46 | \item{\code{alkaline}}{alkaline phosphatase in U/liter.} 47 | 48 | \item{\code{SGOT}}{SGOT in U/ml.} 49 | 50 | \item{\code{platelets}}{platelets per cubic ml/1000.} 51 | 52 | \item{\code{prothrombin}}{prothrombin time in seconds.} 53 | 54 | \item{\code{histologic}}{histologic stage of disease.} 55 | 56 | \item{\code{status2}}{a numeric vector with the value 1 denoting if the 57 | patient was dead, and 0 if the patient was alive or transplanted.} 58 | 59 | } 60 | } 61 | \source{ 62 | \code{\link[JM]{pbc2}} and \code{\link[survival]{pbc}}. 63 | } 64 | \usage{ 65 | data(pbc2) 66 | } 67 | \description{ 68 | This data is from the Mayo Clinic trial in primary biliary 69 | cirrhosis (PBC) of the liver conducted between 1974 and 1984. A total of 70 | 424 PBC patients, referred to Mayo Clinic during that ten-year interval met 71 | eligibility criteria for the randomized placebo controlled trial of the 72 | drug D-penicillamine, but only the first 312 cases in the data set 73 | participated in the randomized trial. Therefore, the data here are for the 74 | 312 patients with largely complete data. 75 | } 76 | \references{ 77 | Fleming T, Harrington D. \emph{Counting Processes and Survival Analysis}. 78 | 1991; New York: Wiley. 79 | 80 | Therneau T, Grambsch P. \emph{Modeling Survival Data: Extending the Cox 81 | Model}. 2000; New York: Springer-Verlag. 82 | } 83 | \seealso{ 84 | \code{\link{heart.valve}}, \code{\link{renal}}, 85 | \code{\link{epileptic.qol}}. 86 | } 87 | \keyword{datasets} 88 | -------------------------------------------------------------------------------- /man/plot.dynLong.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.dynLong.R 3 | \name{plot.dynLong} 4 | \alias{plot.dynLong} 5 | \title{Plot a \code{dynLong} object} 6 | \usage{ 7 | \method{plot}{dynLong}(x, main = NULL, xlab = NULL, ylab = NULL, grid = TRUE, estimator, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object of class \code{dynLong} calculated by the 11 | \code{\link{dynLong}} function.} 12 | 13 | \item{main}{an overall title for the plot: see \code{\link[graphics]{title}}.} 14 | 15 | \item{xlab}{a title for the x [time] axis: see \code{\link[graphics]{title}}.} 16 | 17 | \item{ylab}{a character vector of the titles for the \emph{K} longitudinal 18 | outcomes y-axes: see \code{\link[graphics]{title}}.} 19 | 20 | \item{grid}{adds a rectangular grid to an existing plot: see 21 | \code{\link[graphics]{grid}}.} 22 | 23 | \item{estimator}{a character string that can take values \code{mean} or 24 | \code{median} to specify what prediction statistic is plotted from an 25 | objecting inheritting of class \code{dynSurv}. Default is 26 | \code{estimator='median'}. This argument is ignored for non-simulated 27 | \code{dynSurv} objects, i.e. those of \code{type='first-order'}, as in that 28 | case a mode-based prediction is plotted.} 29 | 30 | \item{...}{additional plotting arguments; currently limited to \code{lwd} and 31 | \code{cex}. See \code{\link[graphics]{par}} for details.} 32 | } 33 | \value{ 34 | A dynamic prediction plot. 35 | } 36 | \description{ 37 | Plots the conditional longitudinal expectations for a 38 | \emph{new} subject calculated using the \code{\link{dynLong}} function. 39 | } 40 | \examples{ 41 | \dontrun{ 42 | # Fit a joint model with bivariate longitudinal outcomes 43 | 44 | data(heart.valve) 45 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 46 | 47 | fit2 <- mjoint( 48 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 49 | "lvmi" = log.lvmi ~ time + sex), 50 | formLongRandom = list("grad" = ~ 1 | num, 51 | "lvmi" = ~ time | num), 52 | formSurv = Surv(fuyrs, status) ~ age, 53 | data = list(hvd, hvd), 54 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 55 | timeVar = "time", 56 | verbose = TRUE) 57 | 58 | hvd2 <- droplevels(hvd[hvd$num == 1, ]) 59 | out <- dynLong(fit2, hvd2) 60 | plot(out, main = "Patient 1") 61 | } 62 | } 63 | \references{ 64 | Rizopoulos D. Dynamic predictions and prospective accuracy in joint models 65 | for longitudinal and time-to-event data. \emph{Biometrics}. 2011; 66 | \strong{67}: 819–829. 67 | } 68 | \seealso{ 69 | \code{\link{dynLong}} 70 | } 71 | \author{ 72 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 73 | } 74 | \keyword{hplot} 75 | -------------------------------------------------------------------------------- /man/plot.dynSurv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.dynSurv.R 3 | \name{plot.dynSurv} 4 | \alias{plot.dynSurv} 5 | \title{Plot a \code{dynSurv} object} 6 | \usage{ 7 | \method{plot}{dynSurv}( 8 | x, 9 | main = NULL, 10 | xlab = NULL, 11 | ylab1 = NULL, 12 | ylab2 = NULL, 13 | grid = TRUE, 14 | estimator, 15 | smooth = FALSE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{an object of class \code{dynSurv} calculated by the 21 | \code{\link{dynSurv}} function.} 22 | 23 | \item{main}{an overall title for the plot: see \code{\link[graphics]{title}}.} 24 | 25 | \item{xlab}{a title for the x [time] axis: see \code{\link[graphics]{title}}.} 26 | 27 | \item{ylab1}{a character vector of the titles for the \emph{K} longitudinal 28 | outcomes y-axes: see \code{\link[graphics]{title}}.} 29 | 30 | \item{ylab2}{a title for the event-time outcome axis: see 31 | \code{\link[graphics]{title}}.} 32 | 33 | \item{grid}{adds a rectangular grid to an existing plot: see 34 | \code{\link[graphics]{grid}}.} 35 | 36 | \item{estimator}{a character string that can take values \code{mean} or 37 | \code{median} to specify what prediction statistic is plotted from an 38 | objecting inheritting of class \code{dynSurv}. Default is 39 | \code{estimator='median'}. This argument is ignored for non-simulated 40 | \code{dynSurv} objects, i.e. those of \code{type='first-order'}, as in that 41 | case a mode-based prediction is plotted.} 42 | 43 | \item{smooth}{logical: whether to overlay a smooth survival curve (see 44 | \strong{Details}). Defaults to \code{FALSE}.} 45 | 46 | \item{...}{additional plotting arguments; currently limited to \code{lwd} and 47 | \code{cex}. See \code{\link[graphics]{par}} for details.} 48 | } 49 | \value{ 50 | A dynamic prediction plot. 51 | } 52 | \description{ 53 | Plots the conditional time-to-event distribution for a 54 | \emph{new} subject calculated using the \code{\link{dynSurv}} function. 55 | } 56 | \details{ 57 | The \code{joineRML} package is based on a semi-parametric model, 58 | such that the baseline hazards function is left unspecified. For 59 | prediction, it might be preferable to have a smooth survival curve. Rather 60 | than changing modelling framework \emph{a prior}, a constrained B-splines 61 | non-parametric median quantile curve is estimated using 62 | \code{\link[cobs]{cobs}}, with a penalty function of \eqn{\lambda=1}, and 63 | subject to constraints of monotonicity and \eqn{S(t)=1}. 64 | } 65 | \examples{ 66 | \dontrun{ 67 | # Fit a joint model with bivariate longitudinal outcomes 68 | 69 | data(heart.valve) 70 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 71 | 72 | fit2 <- mjoint( 73 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 74 | "lvmi" = log.lvmi ~ time + sex), 75 | formLongRandom = list("grad" = ~ 1 | num, 76 | "lvmi" = ~ time | num), 77 | formSurv = Surv(fuyrs, status) ~ age, 78 | data = list(hvd, hvd), 79 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 80 | timeVar = "time", 81 | verbose = TRUE) 82 | 83 | hvd2 <- droplevels(hvd[hvd$num == 1, ]) 84 | out1 <- dynSurv(fit2, hvd2) 85 | plot(out1, main = "Patient 1") 86 | } 87 | 88 | \dontrun{ 89 | # Monte Carlo simulation with 95\% confidence intervals on plot 90 | 91 | out2 <- dynSurv(fit2, hvd2, type = "simulated", M = 200) 92 | plot(out2, main = "Patient 1") 93 | } 94 | } 95 | \references{ 96 | Ng P, Maechler M. A fast and efficient implementation of qualitatively 97 | constrained quantile smoothing splines. \emph{Statistical Modelling}. 2007; 98 | \strong{7(4)}: 315-328. 99 | 100 | Rizopoulos D. Dynamic predictions and prospective accuracy in joint models 101 | for longitudinal and time-to-event data. \emph{Biometrics}. 2011; 102 | \strong{67}: 819–829. 103 | } 104 | \seealso{ 105 | \code{\link{dynSurv}} 106 | } 107 | \author{ 108 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 109 | } 110 | \keyword{hplot} 111 | -------------------------------------------------------------------------------- /man/plot.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.mjoint.R 3 | \name{plot.mjoint} 4 | \alias{plot.mjoint} 5 | \title{Plot diagnostics from an \code{mjoint} object} 6 | \usage{ 7 | \method{plot}{mjoint}(x, type = "convergence", ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object inheriting from class \code{mjoint} for a joint model of 11 | time-to-event and multivariate longitudinal data.} 12 | 13 | \item{type}{currently the only option is \code{type='convergence'} for 14 | graphical examination of convergence over MCEM iteration.} 15 | 16 | \item{...}{other parameters passed to \code{\link{plotConvergence}}.} 17 | } 18 | \description{ 19 | Plot diagnostics from an \code{mjoint} object. 20 | } 21 | \examples{ 22 | \dontrun{ 23 | # Fit a classical univariate joint model with a single longitudinal outcome 24 | # and a single time-to-event outcome 25 | 26 | data(heart.valve) 27 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 28 | 29 | set.seed(1) 30 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 31 | formLongRandom = ~ time | num, 32 | formSurv = Surv(fuyrs, status) ~ age, 33 | data = hvd, 34 | timeVar = "time", 35 | control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 36 | 37 | plot(fit1, param = "beta") # LMM fixed effect parameters 38 | plot(fit1, param = "gamma") # event model parameters 39 | } 40 | 41 | \dontrun{ 42 | # Fit a joint model with bivariate longitudinal outcomes 43 | 44 | data(heart.valve) 45 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 46 | 47 | fit2 <- mjoint( 48 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 49 | "lvmi" = log.lvmi ~ time + sex), 50 | formLongRandom = list("grad" = ~ 1 | num, 51 | "lvmi" = ~ time | num), 52 | formSurv = Surv(fuyrs, status) ~ age, 53 | data = list(hvd, hvd), 54 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 55 | timeVar = "time", 56 | control = list(burnin = 50), 57 | verbose = TRUE) 58 | 59 | plot(fit2, type = "convergence", params = "gamma") 60 | } 61 | } 62 | \seealso{ 63 | \code{\link[graphics]{plot.default}}, \code{\link[graphics]{par}}, 64 | \code{\link[graphics]{abline}}. 65 | } 66 | \author{ 67 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 68 | } 69 | \keyword{dplot} 70 | \keyword{methods} 71 | -------------------------------------------------------------------------------- /man/plot.ranef.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.ranef.mjoint.R 3 | \name{plot.ranef.mjoint} 4 | \alias{plot.ranef.mjoint} 5 | \title{Plot a \code{ranef.mjoint} object} 6 | \usage{ 7 | \method{plot}{ranef.mjoint}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object inheriting from class \code{ranef.mjoint}, representing 11 | the estimated random effects for the \code{mjoint} object from which it was 12 | produced.} 13 | 14 | \item{...}{additional arguments; currently none are used.} 15 | } 16 | \value{ 17 | an object inheriting from class \code{ggplot}, which displays a 18 | trellis plot with a separate panel for each effect, showing a dotplot (with 19 | optional error bars indicating approximate 95\% prediction intervals if the 20 | argument \code{postVar=TRUE} is set in the call to 21 | \code{\link[nlme]{ranef}}) for each subject (by row). 22 | } 23 | \description{ 24 | Displays a plot of the BLUPs and approximate 95\% prediction 25 | interval for each subject. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | require(ggplot2) 30 | data(heart.valve) 31 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 32 | set.seed(1) 33 | 34 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time, 35 | formLongRandom = ~ time | num, 36 | formSurv = Surv(fuyrs, status) ~ 1, 37 | data = hvd, 38 | timeVar = "time") 39 | 40 | plot(ranef(fit1, postVar = TRUE)) 41 | } 42 | } 43 | \references{ 44 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 45 | Springer Verlag; 2000. 46 | } 47 | \seealso{ 48 | \code{\link{ranef.mjoint}}. 49 | } 50 | \author{ 51 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 52 | } 53 | \keyword{methods} 54 | -------------------------------------------------------------------------------- /man/plotConvergence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotConvergence.R 3 | \name{plotConvergence} 4 | \alias{plotConvergence} 5 | \title{Plot convergence time series for parameter vectors from an \code{mjoint} 6 | object} 7 | \usage{ 8 | plotConvergence(object, params = "gamma", discard = FALSE) 9 | } 10 | \arguments{ 11 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 12 | of time-to-event and multivariate longitudinal data.} 13 | 14 | \item{params}{a string indicating what parameters are to be shown. Options 15 | are \code{params='gamma'} for the time-to-event sub-model covariate 16 | coefficients, including the latent association parameters; 17 | \code{params='beta'} for the longitudinal sub-model fixed effects 18 | coefficients; \code{params='sigma2'} for the residual error variances from 19 | the longitudinal sub-model; \code{params='D'} for the lower triangular 20 | matrix of the variance-covariance matrix of random effects; 21 | \code{params='loglik'} for the log-likelihood.} 22 | 23 | \item{discard}{logical; if \code{TRUE} then the 'burn-in' phase iterations of 24 | the MCEM algorithm are discarded. Default is \code{discard=FALSE}.} 25 | } 26 | \description{ 27 | Plot convergence time series for parameter vectors from an 28 | \code{mjoint} object. 29 | } 30 | \references{ 31 | Wei GC, Tanner MA. A Monte Carlo implementation of the EM algorithm and the 32 | poor man's data augmentation algorithms. \emph{J Am Stat Assoc.} 1990; 33 | \strong{85(411)}: 699-704. 34 | } 35 | \seealso{ 36 | \code{\link{plot.mjoint}}, \code{\link[graphics]{plot.default}}, 37 | \code{\link[graphics]{par}}, \code{\link[graphics]{abline}}. 38 | } 39 | \author{ 40 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 41 | } 42 | \keyword{dplot} 43 | \keyword{methods} 44 | -------------------------------------------------------------------------------- /man/ranef.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ranef.mjoint.R 3 | \name{ranef.mjoint} 4 | \alias{ranef.mjoint} 5 | \title{Extract random effects estimates from an \code{mjoint} object} 6 | \usage{ 7 | \method{ranef}{mjoint}(object, postVar = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{postVar}{logical: if \code{TRUE} the variance of the posterior 14 | distribution is also returned.} 15 | 16 | \item{...}{additional arguments; currently none are used.} 17 | } 18 | \value{ 19 | A \code{data.frame} (also of class \code{ranef.mjoint}) with rows 20 | denoting the individuals and columns the random effects (e.g., intercepts, 21 | slopes, etc.). If \code{postVar=TRUE}, the numeric matrix has an extra 22 | attribute, \code{postVar}. 23 | } 24 | \description{ 25 | Extract random effects estimates from an \code{mjoint} object. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | # Fit a joint model with bivariate longitudinal outcomes 30 | 31 | data(heart.valve) 32 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 33 | 34 | fit2 <- mjoint( 35 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 36 | "lvmi" = log.lvmi ~ time + sex), 37 | formLongRandom = list("grad" = ~ 1 | num, 38 | "lvmi" = ~ time | num), 39 | formSurv = Surv(fuyrs, status) ~ age, 40 | data = list(hvd, hvd), 41 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 42 | timeVar = "time", 43 | verbose = TRUE) 44 | 45 | ranef(fit2) 46 | } 47 | } 48 | \references{ 49 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 50 | Springer Verlag; 2000. 51 | 52 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 53 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 54 | } 55 | \seealso{ 56 | \code{\link[nlme]{ranef}} for the generic method description, and 57 | \code{\link{fixef.mjoint}}. To plot \code{ranef.mjoint} objects, see 58 | \code{\link{plot.ranef.mjoint}}. 59 | } 60 | \author{ 61 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 62 | } 63 | \keyword{methods} 64 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/generics.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{augment} 7 | \alias{glance} 8 | \alias{tidy} 9 | \title{Objects exported from other packages} 10 | \keyword{internal} 11 | \description{ 12 | These objects are imported from other packages. Follow the links 13 | below to see their documentation. 14 | 15 | \describe{ 16 | \item{generics}{\code{\link[generics]{augment}}, \code{\link[generics]{glance}}, \code{\link[generics]{tidy}}} 17 | }} 18 | 19 | -------------------------------------------------------------------------------- /man/renal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/renal.R 3 | \docType{data} 4 | \name{renal} 5 | \alias{renal} 6 | \title{Renal transplantation data} 7 | \format{ 8 | This is a list with 4 data frames: \enumerate{ 9 | 10 | \item{\code{prot}: repeated measurement data for proteinuria (binary) that 11 | measures whether the kidneys succeed in sustaining the proteins in the 12 | blood and not discard them in the urine.} 13 | 14 | \item{\code{haem}: repeated measurement data for blood haematocrit level 15 | (continuous) that measures whether the kidneys produce adequate amounts of 16 | the hormone erythropoietin that regulates the red blood cell production.} 17 | 18 | \item{\code{gfr}: repeated measurement data for GFR (continuous) that 19 | measures the filtration rate of the kidneys.} 20 | 21 | \item{\code{surv}: time-to-event data for renal graft failure.} 22 | 23 | } 24 | 25 | \strong{All datasets} have the common data columns, which are in long 26 | format for the 3 longitudinal data data frames, and 1-per-subject for the 27 | time-to-event data frame: \describe{ 28 | 29 | \item{\code{id}}{number for patient identification.} 30 | 31 | \item{\code{age}}{age of patient at day of surgery (years).} 32 | 33 | \item{\code{weight}}{preoperative weight of patient (kg).} 34 | 35 | \item{\code{sex}}{gender of patient.} 36 | 37 | \item{\code{fuyears}}{maximum follow up time, with transplant date as the 38 | time origin (years).} 39 | 40 | \item{\code{failure}}{censoring indicator (\code{1=}graft failure and 41 | \code{0=}censored).} 42 | 43 | } 44 | 45 | \strong{The longitudinal datasets only} contain 2 further columns: 46 | \describe{ 47 | 48 | \item{\code{time}}{observed time point, with surgery date as the time 49 | origin (years).} 50 | 51 | \item{biomarker value}{a recorded measurement of the biomarker taken at 52 | time \code{time}. The 3 biomarkers (one per data frame) are: \itemize{ 53 | 54 | \item{\code{proteinuria}: recorded as binary indicator: present or 55 | not-present. Present in the \code{prot} data.} 56 | 57 | \item{\code{haematocrit}: recorded as percentage (\%) of the ratio of the 58 | volume of red blood cells to the total volume of blood. Present in the 59 | \code{haem} data.} 60 | 61 | \item{\code{gfr}: measured as ml/min/1.73\eqn{m^2}. Present in the 62 | \code{gfr} data.} 63 | 64 | }} 65 | 66 | } 67 | } 68 | \source{ 69 | Dr Dimitris Rizopoulos (\email{d.rizopoulos@erasmusmc.nl}). 70 | } 71 | \usage{ 72 | data(renal) 73 | } 74 | \description{ 75 | This is a dataset on 407 patients suffering from chronic kidney 76 | disease who underwent a primary renal transplantation with a graft from a 77 | deceased or living donor in the University Hospital of the Catholic 78 | University of Leuven (Belgium) between 21 January 1983 and 16 August 2000. 79 | Chronic kidney (renal) disease is a progressive loss of renal function over 80 | a period of months or years through five stages. Each stage is a 81 | progression through an abnormally low and progressively worse glomerular 82 | filtration rate (GFR). The dataset records 3 repeated measures (2 83 | continuous and 1 binary), and an event time. 84 | } 85 | \references{ 86 | Rizopoulos D, Ghosh, P. A Bayesian semiparametric multivariate joint model 87 | for multiple longitudinal outcomes and a time-to-event. \emph{Stat Med.} 88 | 2011; \strong{30(12)}: 1366-80. 89 | } 90 | \seealso{ 91 | \code{\link{pbc2}}, \code{\link{heart.valve}}, 92 | \code{\link{epileptic.qol}}. 93 | } 94 | \keyword{datasets} 95 | -------------------------------------------------------------------------------- /man/residuals.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/residuals.mjoint.R 3 | \name{residuals.mjoint} 4 | \alias{residuals.mjoint} 5 | \title{Extract \code{mjoint} residuals} 6 | \usage{ 7 | \method{residuals}{mjoint}(object, level = 0, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{level}{an optional integer giving the level of grouping to be used in 14 | extracting the residuals from object. Level values increase from outermost 15 | to innermost grouping, with level 0 corresponding to the population 16 | residuals and level 1 corresponding to subject-specific residuals. Defaults 17 | to \code{level=0}.} 18 | 19 | \item{...}{additional arguments; currently none are used.} 20 | } 21 | \value{ 22 | A \code{list} of length \emph{K} with each element a vector of 23 | residuals for the \emph{k}-th longitudinal outcome. 24 | } 25 | \description{ 26 | The residuals at level \emph{i} are obtained by subtracting the fitted 27 | levels at that level from the response vector. 28 | } 29 | \references{ 30 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 31 | Springer Verlag; 2000. 32 | } 33 | \seealso{ 34 | \code{\link{mjoint}}, \code{\link{fitted.mjoint}} 35 | } 36 | \author{ 37 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 38 | } 39 | \keyword{methods} 40 | -------------------------------------------------------------------------------- /man/sampleData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sampleData.R 3 | \name{sampleData} 4 | \alias{sampleData} 5 | \title{Sample from an \code{mjoint} object} 6 | \usage{ 7 | sampleData(object, size = NULL, replace = TRUE) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{size}{number of subjects to include in the sampled subset. If 14 | \code{size=NULL} (default), then size is set equal to the number of 15 | subjects used to fit the \code{mjoint} model.} 16 | 17 | \item{replace}{use replacement when sampling subjects? Default is 18 | \code{TRUE}. If replacement is used, then the subjects are re-labelled from 19 | 1 to \code{size}.} 20 | } 21 | \value{ 22 | A list of 2 data.frames: one recording the requisite longitudinal 23 | outcomes data, and the other recording the time-to-event data. 24 | } 25 | \description{ 26 | Generic function used to sample a subset of data from an object 27 | of class \code{mjoint} with a specific number of subjects. 28 | } 29 | \details{ 30 | This function is primarily intended for internal use in the 31 | \code{\link{bootSE}} function in order to permit bootstrapping. However, it 32 | can be used for other purposes given a fitted \code{mjoint} object. 33 | } 34 | \examples{ 35 | \dontrun{ 36 | # Fit a joint model with bivariate longitudinal outcomes 37 | 38 | data(heart.valve) 39 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 40 | 41 | fit2 <- mjoint( 42 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 43 | "lvmi" = log.lvmi ~ time + sex), 44 | formLongRandom = list("grad" = ~ 1 | num, 45 | "lvmi" = ~ time | num), 46 | formSurv = Surv(fuyrs, status) ~ age, 47 | data = list(hvd, hvd), 48 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 49 | timeVar = "time", 50 | verbose = TRUE) 51 | sampleData(fit2, size = 10) 52 | } 53 | } 54 | \seealso{ 55 | \code{\link{mjoint}}. 56 | } 57 | \author{ 58 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 59 | } 60 | \keyword{datagen} 61 | \keyword{methods} 62 | \keyword{multivariate} 63 | \keyword{survival} 64 | -------------------------------------------------------------------------------- /man/sigma.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sigma.mjoint.R 3 | \name{sigma.mjoint} 4 | \alias{sigma.mjoint} 5 | \title{Extract residual standard deviation(s) from an \code{mjoint} object} 6 | \usage{ 7 | \method{sigma}{mjoint}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{...}{additional arguments; currently none are used.} 14 | } 15 | \value{ 16 | a number (standard deviation) if \eqn{K = 1} (univariate model), or a 17 | vector if \eqn{K>1} (multivariate model). 18 | } 19 | \description{ 20 | Extract residual standard deviation(s) from an \code{mjoint} 21 | object. 22 | } 23 | \references{ 24 | Pinheiro JC, Bates DM. \emph{Mixed-Effects Models in S and S-PLUS.} New York: 25 | Springer Verlag; 2000. 26 | } 27 | \seealso{ 28 | \code{\link[lme4]{sigma}} in the \strong{lme4} package. 29 | } 30 | \author{ 31 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 32 | } 33 | \keyword{methods} 34 | -------------------------------------------------------------------------------- /man/summary.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.mjoint.R 3 | \name{summary.mjoint} 4 | \alias{summary.mjoint} 5 | \title{Summary of an \code{mjoint} object} 6 | \usage{ 7 | \method{summary}{mjoint}(object, bootSE = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 11 | of time-to-event and multivariate longitudinal data.} 12 | 13 | \item{bootSE}{an object inheriting from class \code{bootSE} for the 14 | corresponding model. If \code{bootSE=NULL}, the function will attempt to 15 | utilize approximate standard error estimates (if available) calculated from 16 | the empirical information matrix.} 17 | 18 | \item{...}{additional arguments; currently none are used.} 19 | } 20 | \value{ 21 | A list containing the coefficient matrices for the longitudinal and 22 | time-to-event sub-models; variance-covariance matrix for the random 23 | effects; residual error variances; log-likelihood of joint model; AIC and 24 | BIC statistics; and model fit objects. 25 | } 26 | \description{ 27 | This function provides a summary of an \code{mjoint} object. 28 | } 29 | \examples{ 30 | \dontrun{ 31 | # Fit a joint model with bivariate longitudinal outcomes 32 | 33 | data(heart.valve) 34 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 35 | 36 | fit2 <- mjoint( 37 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 38 | "lvmi" = log.lvmi ~ time + sex), 39 | formLongRandom = list("grad" = ~ 1 | num, 40 | "lvmi" = ~ time | num), 41 | formSurv = Surv(fuyrs, status) ~ age, 42 | data = list(hvd, hvd), 43 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 44 | timeVar = "time", 45 | verbose = TRUE) 46 | summary(fit2) 47 | } 48 | } 49 | \references{ 50 | Wulfsohn MS, Tsiatis AA. A joint model for survival and longitudinal data 51 | measured with error. \emph{Biometrics.} 1997; \strong{53(1)}: 330-339. 52 | 53 | Henderson R, Diggle PJ, Dobson A. Joint modelling of longitudinal 54 | measurements and event time data. \emph{Biostatistics.} 2000; \strong{1(4)}: 55 | 465-480. 56 | 57 | Lin H, McCulloch CE, Mayne ST. Maximum likelihood estimation in the joint 58 | analysis of time-to-event and multiple longitudinal variables. \emph{Stat 59 | Med.} 2002; \strong{21}: 2369-2382. 60 | } 61 | \seealso{ 62 | \code{\link{mjoint}}, \code{\link{mjoint.object}}, and 63 | \code{\link[base]{summary}} for the generic method description. 64 | } 65 | \author{ 66 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 67 | } 68 | \keyword{methods} 69 | -------------------------------------------------------------------------------- /man/vcov.mjoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/vcov.mjoint.R 3 | \name{vcov.mjoint} 4 | \alias{vcov.mjoint} 5 | \title{Extract an approximate variance-covariance matrix of estimated parameters 6 | from an \code{mjoint} object} 7 | \usage{ 8 | \method{vcov}{mjoint}(object, correlation = FALSE, ...) 9 | } 10 | \arguments{ 11 | \item{object}{an object inheriting from class \code{mjoint} for a joint model 12 | of time-to-event and multivariate longitudinal data.} 13 | 14 | \item{correlation}{logical: if \code{TRUE} returns the correlation matrix, 15 | otherwise returns the variance-covariance matrix (default).} 16 | 17 | \item{...}{additional arguments; currently none are used.} 18 | } 19 | \value{ 20 | A variance-covariance matrix. 21 | } 22 | \description{ 23 | Returns the variance-covariance matrix of the main parameters of 24 | a fitted \code{mjoint} model object. 25 | } 26 | \details{ 27 | This is a generic function that extracts the variance-covariance 28 | matrix of parameters from an \code{mjoint} model fit. It is based on a 29 | profile likelihood, so no estimates are given for the baseline hazard 30 | function, which is generally considered a nuisance parameter. It is based 31 | on the empirical information matrix (see Lin et al. 2002, and McLachlan 32 | and Krishnan 2008 for details), so is only approximate. 33 | } 34 | \note{ 35 | This function is not to be confused with \code{\link[nlme]{getVarCov}}, 36 | which returns the extracted variance-covariance matrix for the random 37 | effects distribution. 38 | } 39 | \examples{ 40 | \dontrun{ 41 | # Fit a classical univariate joint model with a single longitudinal outcome 42 | # and a single time-to-event outcome 43 | 44 | data(heart.valve) 45 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 46 | 47 | set.seed(1) 48 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 49 | formLongRandom = ~ time | num, 50 | formSurv = Surv(fuyrs, status) ~ age, 51 | data = hvd, 52 | timeVar = "time", 53 | control = list(nMCscale = 2, burnin = 5)) # controls for illustration only 54 | 55 | vcov(fit1) 56 | } 57 | 58 | \dontrun{ 59 | # Fit a joint model with bivariate longitudinal outcomes 60 | 61 | data(heart.valve) 62 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 63 | 64 | fit2 <- mjoint( 65 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 66 | "lvmi" = log.lvmi ~ time + sex), 67 | formLongRandom = list("grad" = ~ 1 | num, 68 | "lvmi" = ~ time | num), 69 | formSurv = Surv(fuyrs, status) ~ age, 70 | data = list(hvd, hvd), 71 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 72 | timeVar = "time", 73 | verbose = TRUE) 74 | 75 | vcov(fit2) 76 | } 77 | } 78 | \references{ 79 | Lin H, McCulloch CE, Mayne ST. Maximum likelihood estimation in the joint 80 | analysis of time-to-event and multiple longitudinal variables. \emph{Stat 81 | Med.} 2002; \strong{21}: 2369-2382. 82 | 83 | McLachlan GJ, Krishnan T. \emph{The EM Algorithm and Extensions}. Second 84 | Edition. Wiley-Interscience; 2008. 85 | } 86 | \seealso{ 87 | \code{\link[stats]{vcov}} for the generic method description, and 88 | \code{\link[stats]{cov2cor}} for details of efficient scaling of a 89 | covariance matrix into the corresponding correlation matrix. 90 | } 91 | \author{ 92 | Graeme L. Hickey (\email{graemeleehickey@gmail.com}) 93 | } 94 | \keyword{methods} 95 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:------------------------------------------------------------------------------------------------| 5 | |version |R version 4.4.2 (2024-10-31) | 6 | |os |macOS Sonoma 14.6.1 | 7 | |system |aarch64, darwin20 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |Europe/London | 13 | |date |2024-12-30 | 14 | |rstudio |2024.12.0+467 Kousa Dogwood (desktop) | 15 | |pandoc |3.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/aarch64/ (via rmarkdown) | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:--------|:-----|:-----|:--| 21 | |joineRML |0.4.6 |0.4.7 |* | 22 | 23 | # Revdeps 24 | 25 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 3 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.dll 4 | .Rapp.history 5 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 2 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 2 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -------------------------------------------------------------------------------- /src/expW.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppArmadillo)]] 3 | 4 | using namespace Rcpp; 5 | 6 | //' @keywords internal 7 | // [[Rcpp::export]] 8 | List expWArma(const Rcpp::List& iz_, const Rcpp::List& b_, const arma::mat& gam, 9 | const Rcpp::List& h_) { 10 | 11 | // Calculation of exp{W(tj, b)} 12 | 13 | List expw(b_.size()); 14 | 15 | for (int i=0; i(h_[i]); 18 | arma::mat iz = Rcpp::as(iz_[i]); 19 | arma::mat b = Rcpp::as(b_[i]); 20 | int tj_ind = h["tj.ind"]; 21 | 22 | expw[i] = exp(b * gam * iz); 23 | 24 | if (tj_ind == 0) { 25 | // subjects who are censored before first failure 26 | // time do not contribute anything 27 | expw[i] = arma::zeros(arma::size(as(expw[i]))); 28 | } 29 | 30 | } 31 | 32 | return(expw); 33 | 34 | } 35 | -------------------------------------------------------------------------------- /src/gammaUpdate.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppArmadillo)]] 3 | 4 | using namespace Rcpp; 5 | 6 | //' @keywords internal 7 | // [[Rcpp::export]] 8 | List gammaUpdate(const Rcpp::List& b_, const Rcpp::List& z_, const Rcpp::List& w_, 9 | const Rcpp::List& pb_, const arma::vec& haz, const Rcpp::List& v_, 10 | const Rcpp::List& h_, const int& K, const int& q, const int& nev, 11 | const arma::vec& jcount) { 12 | 13 | // Newton-Raphson updates of gamma (E-step and M-step) using an exact observed 14 | // information calculation 15 | 16 | // declare score, E[delta x v*], and information matrix 17 | arma::mat Si = arma::zeros(q+K, w_.size()); 18 | arma::vec S = arma::zeros(q+K); 19 | arma::mat Evstari = arma::zeros(q+K, w_.size()); 20 | arma::mat I = arma::zeros(q+K, q+K); 21 | arma::mat Gammaj = arma::zeros(q+K, nev); 22 | arma::mat Gamma = arma::zeros(q+K, q+K); 23 | 24 | // loop over subjects 25 | for (int i=0; i(b_[i]); 31 | arma::mat z = Rcpp::as(z_[i]); 32 | arma::mat w = Rcpp::as(w_[i]); 33 | arma::vec pb = Rcpp::as(pb_[i]); 34 | arma::vec v = Rcpp::as(v_[i]); 35 | Rcpp::DataFrame h = Rcpp::as(h_[i]); 36 | 37 | // subjects who are censored before the first failure time 38 | // do not contribute towards \gamma estimation 39 | int tj_ind = h["tj.ind"]; 40 | if (tj_ind == 0) continue; 41 | 42 | int nj = w.n_cols; // number of failure times upto time T_i 43 | int delta = h["delta"]; // delta_i 44 | 45 | arma::mat Ii_int = arma::zeros(q+K, q+K); // information matrix (uninitialized) for subject i 46 | arma::mat bzt = b * z; // b x t(z) 47 | arma::mat bztev = bzt % repmat(w, 1, K); // b x t(Z) . exp(v*gamma) 48 | arma::mat Eexpvj = (mean(w.each_col() % pb, 0)) % trans(haz.subvec(0, nj-1)); 49 | arma::mat Eexpv = sum(Eexpvj, 1); // lambda0 x E[exp(v*gamma)] 50 | arma::mat hexpand = trans(repmat(haz.subvec(0, nj-1), K, 1)); // K reps of lambda0(tj) 51 | arma::mat outj = (mean(bztev.each_col() % pb, 0)) % hexpand; 52 | arma::mat bzt2ev = bzt % bztev; // [b x t(z)]^2 . exp(v*gamma) 53 | arma::mat Ii_int_Kdiag = (mean(bzt2ev.each_col() % pb, 0)) % hexpand; 54 | 55 | arma::mat Eb = mean(b.each_col() % pb, 0); 56 | 57 | // loop of K longitudinal outcomes 58 | for (int k=0; k 0) { 77 | for (int j=0; j 0) 88 | if (q > 0) { 89 | // E[delta x v] 90 | Evstari.submat(0, i, q-1, i) = delta * v; 91 | // score elements 92 | Si.submat(0, i, q-1, i) = v * Eexpv; 93 | // cross-prod elements 94 | Ii_int.submat(0, 0, q-1, q-1) = (v * trans(v)) * arma::as_scalar(Eexpv); 95 | // Gamma_j elements 96 | Gammaj.submat(0, 0, q-1, nj-1) += v * Eexpvj; 97 | } 98 | 99 | S += (Evstari.col(i) - Si.col(i)); // NB: actual score is sum(Evstari - Si) 100 | I += Ii_int; 101 | 102 | } // end loop over subjects i 103 | 104 | // lambda0 x Gamma_j sum term (minus from information matrix) 105 | for (int t=0; t(nev.n_elem); 125 | 126 | // loop over subjects 127 | for (int i=0; i(w_[i]); 131 | arma::vec pb = Rcpp::as(pb_[i]); 132 | 133 | haz.subvec(0, w.n_cols-1) += arma::trans(mean(w.each_col() % pb, 0)); 134 | 135 | } 136 | 137 | return(nev / haz); 138 | 139 | } 140 | 141 | 142 | 143 | -------------------------------------------------------------------------------- /src/gammaUpdate_approx.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppArmadillo)]] 3 | 4 | using namespace Rcpp; 5 | 6 | //' @keywords internal 7 | // [[Rcpp::export]] 8 | List gammaUpdate_approx(const Rcpp::List& b_, const Rcpp::List& z_, const Rcpp::List& w_, 9 | const Rcpp::List& pb_, const arma::vec& haz, 10 | const Rcpp::List& v_, const Rcpp::List& h_, const int& K, 11 | const int& q, const int& nev) { 12 | 13 | // Newton-Raphson updates of gamma (E-step and M-step) using an empirical 14 | // infomration matrix approximation 15 | 16 | // declare score and E[delta x v*] 17 | arma::mat Si = arma::zeros(q+K, w_.size()); 18 | arma::vec S = arma::zeros(q+K); 19 | arma::mat Evstari = arma::zeros(q+K, w_.size()); 20 | arma::mat I = arma::zeros(q+K, q+K); 21 | 22 | // loop over subjects 23 | for (int i=0; i(b_[i]); 29 | arma::mat z = Rcpp::as(z_[i]); 30 | arma::mat w = Rcpp::as(w_[i]); 31 | arma::vec pb = Rcpp::as(pb_[i]); 32 | arma::vec v = Rcpp::as(v_[i]); 33 | Rcpp::DataFrame h = Rcpp::as(h_[i]); 34 | 35 | // subjects who are censored before the first failure time 36 | // do not contribute towards \gamma estimation 37 | int tj_ind = h["tj.ind"]; 38 | if (tj_ind == 0) continue; 39 | 40 | int nj = w.n_cols; // number of failures upto time T_i 41 | int delta = h["delta"]; // delta_i 42 | 43 | arma::mat bzt = b * z; // b x t(z) 44 | arma::mat bztev = bzt % repmat(w, 1, K); // b x t(Z) . exp(v*gamma) 45 | arma::mat Eexpvj = (mean(w.each_col() % pb, 0)) % trans(haz.subvec(0, nj-1)); 46 | arma::mat Eexpv = sum(Eexpvj, 1); // lambda0 x E[exp(v*gamma)] 47 | arma::mat hexpand = trans(repmat(haz.subvec(0, nj-1), K, 1)); // K reps of lambda0(tj) 48 | arma::mat outj = (mean(bztev.each_col() % pb, 0)) % hexpand; 49 | 50 | arma::mat Eb = mean(b.each_col() % pb, 0); 51 | 52 | // loop of K longitudinal outcomes 53 | for (int k=0; k 0) 62 | if (q > 0) { 63 | // E[delta x v] 64 | Evstari.submat(0, i, q-1, i) = delta * v; 65 | // score elements 66 | Si.submat(0, i, q-1, i) = Evstari.submat(0, i, q-1, i) - v * Eexpv; 67 | } 68 | 69 | S += Si.col(i); 70 | I += Si.col(i) * Si.col(i).t(); // see below 71 | 72 | } // end loop over subjects i 73 | 74 | 75 | // an approximate I-matrix using observed empirical information 76 | I = I - (S * S.t()) / w_.size(); 77 | 78 | return List::create( 79 | Named("gDelta") = 0.5 * solve(I, S), 80 | Named("scorei") = Si 81 | ); 82 | 83 | } 84 | -------------------------------------------------------------------------------- /src/lambdaUpdate.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppArmadillo)]] 3 | 4 | using namespace Rcpp; 5 | 6 | //' @keywords internal 7 | // [[Rcpp::export]] 8 | arma::mat lambdaUpdate(const Rcpp::List& b_, const Rcpp::List& imat_, 9 | const Rcpp::List& zt_, const Rcpp::List& pb_, 10 | const Rcpp::List& v_, const arma::mat& gam, 11 | const arma::vec& gam_vec, const int& q, const arma::vec& nev, 12 | const Rcpp::List& h_) { 13 | 14 | // Updates of lambda0 (E-step and M-step) 15 | 16 | arma::vec haz = arma::zeros(nev.n_elem); 17 | 18 | // loop over subjects 19 | for (int i=0; i(b_[i]); 23 | arma::mat I = Rcpp::as(imat_[i]); 24 | arma::mat zt = Rcpp::as(zt_[i]); 25 | arma::vec pb = Rcpp::as(pb_[i]); 26 | arma::vec v = Rcpp::as(v_[i]); 27 | Rcpp::DataFrame h = Rcpp::as(h_[i]); 28 | 29 | // subjects who are censored before the first failure time 30 | // do not contribute towards \lambda estimation 31 | int tj_ind = h["tj.ind"]; 32 | if (tj_ind == 0) continue; 33 | 34 | arma::mat expW_new = exp((b * gam) * trans(I * zt)); 35 | arma::mat EexpVstar = mean(expW_new.each_col() % pb, 0); 36 | if (q > 0) { 37 | EexpVstar *= arma::as_scalar(exp(v.t() * gam_vec.subvec(0, q-1))); 38 | } 39 | haz.subvec(0, EexpVstar.n_cols-1) += EexpVstar.t(); 40 | 41 | } 42 | 43 | return(nev / haz); 44 | 45 | } 46 | -------------------------------------------------------------------------------- /src/mvnorm.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | // [[Rcpp::depends(RcppArmadillo)]] 3 | 4 | using namespace Rcpp; 5 | 6 | //' @keywords internal 7 | // [[Rcpp::export]] 8 | arma::mat mvrnormArma(const int& n, const arma::vec& mu, const arma::mat& sigma) { 9 | 10 | // Antithetic simulation of MVN random variables 11 | 12 | int ncols = sigma.n_cols; 13 | // +/- 1 vector (n each) for antithetic calculation 14 | arma::vec pmvec = arma::ones(2*n); 15 | pmvec.tail(n) *= -1; 16 | arma::mat Z = repmat(arma::randn(n, ncols), 2, 1); 17 | 18 | return(arma::repmat(mu, 1, 2*n).t() + 19 | (Z.each_col() % pmvec) * arma::trimatu(arma::chol(sigma))); 20 | 21 | } 22 | 23 | 24 | //' @keywords internal 25 | // [[Rcpp::export]] 26 | List bSim(const int& n, const Rcpp::List& Mean_, const Rcpp::List& Sigma_) { 27 | 28 | // Get a list of MVN samples for each subject 29 | 30 | List b(Mean_.size()); 31 | for(int i=0; i(Mean_[i]); 33 | arma::mat s = Rcpp::as(Sigma_[i]); 34 | b[i] = mvrnormArma(n, m, s); 35 | } 36 | 37 | return(b); 38 | 39 | } 40 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(joineRML) 3 | 4 | test_check("joineRML") 5 | -------------------------------------------------------------------------------- /tests/testthat/Rplots.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/graemeleehickey/joineRML/5c68c4f5bf52118ea3eaf82965e462becda32deb/tests/testthat/Rplots.pdf -------------------------------------------------------------------------------- /tests/testthat/test-#59.R: -------------------------------------------------------------------------------- 1 | # test tidy, augment, glance methods for mjoint object (joineRML package) 2 | context("Issue #59") 3 | library(joineRML) 4 | 5 | test_that("Example that was broken in #59 is not broken anymore", { 6 | data(heart.valve) 7 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 8 | hvd <- hvd[, c(2:ncol(hvd), 1)] 9 | fit1 <- mjoint( 10 | formLongFixed = log.lvmi ~ time + age, 11 | formLongRandom = ~ time | num, 12 | formSurv = Surv(fuyrs, status) ~ age, 13 | data = hvd, 14 | timeVar = "time", 15 | control = list(nMCscale = 2, burnin = 5) 16 | ) 17 | expect_s3_class(object = fit1, class = "mjoint") 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-ancillary.R: -------------------------------------------------------------------------------- 1 | library(joineRML) 2 | context("Ancillary functions") 3 | 4 | test_that("simulated data: intslope", { 5 | # simulate data 6 | beta <- rbind(c(0.5, 2, 1, 1), 7 | c(2, 2, -0.5, -1)) 8 | D <- diag(4) 9 | D[1, 1] <- D[3, 3] <- 0.5 10 | D[1, 2] <- D[2, 1] <- D[3, 4] <- D[4, 3] <- 0.1 11 | D[1, 3] <- D[3, 1] <- 0.01 12 | sim <- simData(n = 250, beta = beta, D = D, sigma2 = c(0.25, 0.25), 13 | censlam = exp(-0.2), gamma.y = c(-0.2, 1), ntms = 8) 14 | # tests 15 | expect_is(sim, "list") 16 | expect_output(str(sim), "List of 2") 17 | expect_equal(names(sim), c("longdat", "survdat")) 18 | expect_equal(ncol(sim$longdat), 8) 19 | expect_equal(dim(sim$survdat), c(250, 5)) 20 | }) 21 | 22 | 23 | test_that("simulated data: int", { 24 | # simulate data 25 | beta <- rbind(c(0.5, 2, 1, 1), 26 | c(2, 2, -0.5, -1)) 27 | sim <- simData(n = 250, beta = beta, sigma2 = c(0.25, 0.25), 28 | censlam = exp(-0.2), gamma.y = c(-0.2, 1), ntms = 8, 29 | model = "int") 30 | # tests 31 | expect_is(sim, "list") 32 | expect_output(str(sim), "List of 2") 33 | expect_equal(names(sim), c("longdat", "survdat")) 34 | expect_equal(ncol(sim$longdat), 8) 35 | expect_equal(dim(sim$survdat), c(250, 5)) 36 | }) 37 | 38 | 39 | test_that("convergence plots", { 40 | # load data + fit model 41 | set.seed(1) 42 | data(pbc2) 43 | pbc2$log.b <- log(pbc2$serBilir) 44 | fit <- mjoint( 45 | formLongFixed = list("log.bil" = log.b ~ year), 46 | formLongRandom = list("log.bil" = ~ 1 | id), 47 | formSurv = Surv(years, status2) ~ age, 48 | data = pbc2, 49 | timeVar = "year", 50 | control = list(convCrit = "abs", tol0 = 5e-01, burnin = 5), 51 | verbose = FALSE) 52 | # tests 53 | expect_silent(plotConvergence(fit, params = "gamma")) 54 | expect_silent(plot(fit, type = "convergence", params = "beta")) 55 | expect_silent(plot(fit, type = "convergence", params = "gamma")) 56 | expect_silent(plot(fit, type = "convergence", params = "D")) 57 | expect_silent(plot(fit, type = "convergence", params = "sigma2")) 58 | expect_silent(plot(fit, type = "convergence", params = "loglik", discard = TRUE)) 59 | }) 60 | 61 | 62 | test_that("ranef plots + sampling", { 63 | # load data + fit model 64 | data(heart.valve) 65 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 66 | set.seed(1) 67 | fit1 <- mjoint(formLongFixed = log.lvmi ~ time + age, 68 | formLongRandom = ~ time | num, 69 | formSurv = Surv(fuyrs, status) ~ age, 70 | data = hvd, 71 | timeVar = "time", 72 | control = list(burnin = 6, tol0 = 5e-01)) 73 | p <- plot(ranef(fit1, postVar = TRUE)) 74 | # tests 75 | expect_true(is.ggplot(p)) 76 | expect_error(sampleData(fit1, size = 1000, replace = FALSE), "Cannot select more subjects than in data without replacement") 77 | }) 78 | 79 | 80 | test_that("dynamic predictions, residuals, fitted values, baseline hazard", { 81 | # Takes the most time so skip testing to pass Windows time-limit threshold 82 | skip_on_cran() 83 | skip_on_os("mac") 84 | # load data + fit model 85 | data(heart.valve) 86 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 87 | set.seed(1) 88 | fit2 <- mjoint( 89 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 90 | "lvmi" = log.lvmi ~ time + sex), 91 | formLongRandom = list("grad" = ~ 1 | num, 92 | "lvmi" = ~ time | num), 93 | formSurv = Surv(fuyrs, status) ~ age, 94 | data = list(hvd, hvd), 95 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 96 | control = list("burnin" = 10, mcmaxIter = 120, tol0 = 0.5), 97 | timeVar = "time") 98 | hvd2 <- droplevels(hvd[hvd$num == 1, ]) 99 | test1 <- dynLong(fit2, hvd2) 100 | test2 <- dynLong(fit2, hvd2, u = 7) 101 | test3 <- dynSurv(fit2, hvd2) 102 | test4 <- dynSurv(fit2, hvd2, u = 7) 103 | test5 <- dynLong(fit2, hvd2, type = "simulated", M = 3) 104 | test6 <- dynSurv(fit2, hvd2, type = "simulated", M = 3) 105 | # tests: dynamic predictions 106 | expect_is(test1, "dynLong") 107 | expect_output(str(test1$pred), "List of 2") 108 | expect_silent(plot(test1)) 109 | expect_output(print(test1)) 110 | expect_is(test2, "dynLong") 111 | expect_is(test3, "dynSurv") 112 | expect_output(str(test3$pred), "data.frame") 113 | expect_silent(plot(test3)) 114 | expect_output(print(test3)) 115 | expect_is(test4, "dynSurv") 116 | expect_is(test5, "dynLong") 117 | expect_is(test6, "dynSurv") 118 | # tests: residuals + fitted values 119 | expect_output(str(resid(fit2, level = 0)), "List of 2") 120 | expect_output(str(resid(fit2, level = 1)), "List of 2") 121 | expect_output(str(fitted(fit2, level = 0)), "List of 2") 122 | expect_output(str(fitted(fit2, level = 1)), "List of 2") 123 | expect_error(fitted(fit2, level = 3)) 124 | expect_equal(names(resid(fit2)), c("grad", "lvmi")) 125 | # tests: baseline hazard 126 | expect_is(baseHaz(fit2, se = TRUE), "data.frame") 127 | expect_is(baseHaz(fit2, centered = FALSE), "data.frame") 128 | # tests: missingg damts 129 | fit2$dmats <- NULL 130 | expect_error(fitted(fit2)) 131 | }) 132 | 133 | -------------------------------------------------------------------------------- /tests/testthat/test-boot.R: -------------------------------------------------------------------------------- 1 | library(joineRML) 2 | context("Bootstrap") 3 | 4 | test_that("bootstrap MV models", { 5 | skip_on_cran() 6 | skip_on_os("mac") 7 | # load data + fit model 8 | data(heart.valve) 9 | hvd <- heart.valve[!is.na(heart.valve$log.grad) & !is.na(heart.valve$log.lvmi), ] 10 | set.seed(12345) 11 | fit <- mjoint( 12 | formLongFixed = list("grad" = log.grad ~ time + sex + hs, 13 | "lvmi" = log.lvmi ~ time + sex), 14 | formLongRandom = list("grad" = ~ 1 | num, 15 | "lvmi" = ~ time | num), 16 | formSurv = Surv(fuyrs, status) ~ age, 17 | data = list(hvd, hvd), 18 | inits = list("gamma" = c(0.11, 1.51, 0.80)), 19 | timeVar = "time", 20 | control = list(convCrit = "abs", tol0 = 0.1, tol.em = 1e-02, 21 | burnin = 40, mcmaxIter = 200), 22 | verbose = FALSE) 23 | set.seed(1) 24 | fit.boot1 <- bootSE(fit, nboot = 1, verbose = TRUE) 25 | set.seed(1) 26 | fit.boot2 <- bootSE(fit, nboot = 1, ncores = 1) 27 | # tests 28 | expect_is(fit.boot1, "bootSE") 29 | expect_is(fit.boot2, "bootSE") 30 | expect_output(str(fit.boot1), "List of 11") 31 | expect_output(print(fit.boot1)) 32 | expect_is(summary(fit, bootSE = fit.boot1), "summary.mjoint") 33 | expect_output(print(summary(fit.boot1, bootSE = fit.boot))) 34 | expect_output(str(summary(fit, bootSE = fit.boot1)), "List of 22") 35 | expect_equal(summary(fit, bootSE = fit.boot1)$se.type, "boot") 36 | expect_equal(dim(confint(fit, bootSE = fit.boot1)), c(10, 2)) 37 | expect_equal(dim(confint(fit, parm = "Longitudinal", bootSE = fit.boot1)), c(7, 2)) 38 | expect_equal(dim(confint(fit, parm = "Event", bootSE = fit.boot1)), c(3, 2)) 39 | }) 40 | 41 | 42 | test_that("non-convergence", { 43 | skip_on_cran() 44 | skip_on_os("mac") 45 | # load data + fit model 46 | data(pbc2) 47 | pbc2$log.b <- log(pbc2$serBilir) 48 | fit <- mjoint( 49 | formLongFixed = list("log.bil" = log.b ~ year), 50 | formLongRandom = list("log.bil" = ~ year | id), 51 | formSurv = Surv(years, status2) ~ age, 52 | data = pbc2, 53 | timeVar = "year", 54 | control = list(convCrit = "abs", tol0 = 1e-3, 55 | burnin = 5, mcmaxIter = 10), 56 | verbose = FALSE) 57 | set.seed(1) 58 | # tests 59 | expect_error(bootSE(fit, nboot = 1, progress = FALSE), 60 | "Cannot estimate SEs: fewer than 10% of bootstrap models converged.") 61 | }) 62 | 63 | 64 | test_that("univariate intercept only + non-MLE inits", { 65 | skip_on_cran() 66 | skip_on_appveyor() 67 | skip_on_os("mac") 68 | # load data + fit model 69 | data(pbc2) 70 | pbc2$log.b <- log(pbc2$serBilir) 71 | fit <- mjoint( 72 | formLongFixed = list("log.bil" = log.b ~ year), 73 | formLongRandom = list("log.bil" = ~ 1 | id), 74 | formSurv = Surv(years, status2) ~ age, 75 | data = pbc2, 76 | timeVar = "year", 77 | control = list(convCrit = "abs", tol0 = 0.05, burnin = 100), 78 | verbose = FALSE) 79 | set.seed(12345) 80 | fit.boot <- bootSE(fit, nboot = 1, 81 | progress = FALSE, 82 | use.mle = FALSE, 83 | control = list(convCrit = "abs", tol0 = 0.05, gammaOpt = "GN")) 84 | # tests 85 | expect_is(fit.boot, "bootSE") 86 | expect_warning(bootSE(fit, control = list("fake" = TRUE), nboot = 1), 87 | "Unknown arguments passed to 'control': fake") 88 | }) 89 | --------------------------------------------------------------------------------