├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── check-standard.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── covml.R ├── ctACF.R ├── ctCheckFit.R ├── ctCompare.R ├── ctDataHelp.R ├── ctDeintervalise.R ├── ctDiscretePars.R ├── ctDiscretiseData.R ├── ctExtractComplexMatrix.R ├── ctFitAuto.R ├── ctFitMultiModel.R ├── ctGenerate.R ├── ctGraph.R ├── ctIndplot.R ├── ctIntervalise.R ├── ctJacobian.R ├── ctKalman.R ├── ctLOO.R ├── ctLabel.R ├── ctLongtowide.r ├── ctModel.R ├── ctModelHigherOrder.R ├── ctModelLatex.R ├── ctPlotArray.R ├── ctStanContinuousPars.R ├── ctStanData.R ├── ctStanFit.R ├── ctStanGenerate.R ├── ctStanGenerateFromFit.R ├── ctStanKalman.R ├── ctStanModel.R ├── ctStanModelWriter.R ├── ctStanParMatrices.R ├── ctStanPlotPost.R ├── ctStanPostPredict.R ├── ctStanProfileCI.R ├── ctStanTIpredeffects.R ├── ctSummarise.R ├── ctTIpredAuto.R ├── ctTransforms.R ├── ctWideToLong.R ├── ctdataupdate.R ├── ctsem-package.R ├── ctsemUtils.R ├── ctsmupdate.R ├── databasedTIpreds.R ├── extract.ctStanFit.R ├── isdiag.R ├── listOfMatrices.R ├── modelchecking.R ├── plot.ctStanFit.R ├── plot.ctStanModel.R ├── plothelpers.R ├── priorcheck.R ├── sdpcor2cov.R ├── sgd.R ├── stanWplot.R ├── stan_checkdivergences.R ├── stan_confidenceRegion.R ├── stan_postcalc.R ├── stan_unconstrainsamples.R ├── stanmodels.R ├── stanoptimis.R ├── summary.ctStanFit.R └── tformshapes.R ├── README.md ├── README.rmd ├── configure ├── configure.win ├── ctsem.Rproj ├── data ├── AnomAuth.rda ├── Oscillating.rda ├── ctExample1.rda ├── ctExample1TIpred.rda ├── ctExample2.rda ├── ctExample3.rda ├── ctExample4.rda ├── ctstantestdat.rda ├── ctstantestfit.rda ├── datastructure.rda └── longexample.rda ├── inst ├── CITATION ├── include │ └── stan_meta_header.hpp └── stan │ ├── cov.stan │ ├── ctsm.bak │ ├── ctsm.stan │ ├── ctsmSimple.bak │ ├── ctsmgen.bak │ ├── ctsmgen.stan │ └── include │ └── license.stan ├── man ├── AnomAuth.Rd ├── Oscillating.Rd ├── ctACF.Rd ├── ctACFresiduals.Rd ├── ctAddSamples.Rd ├── ctCheckFit.Rd ├── ctChisqTest.Rd ├── ctCollapse.Rd ├── ctDeintervalise.Rd ├── ctDensity.Rd ├── ctDiscretiseData.Rd ├── ctDocs.Rd ├── ctExample1.Rd ├── ctExample1TIpred.Rd ├── ctExample2.Rd ├── ctExample2level.Rd ├── ctExample3.Rd ├── ctExample4.Rd ├── ctExtract.Rd ├── ctFit.Rd ├── ctFitAuto.Rd ├── ctFitAutoGroupModel.Rd ├── ctFitCovCheck.Rd ├── ctFitMultiModel.Rd ├── ctGenerate.Rd ├── ctIndplot.Rd ├── ctIntervalise.Rd ├── ctKalman.Rd ├── ctLOO.Rd ├── ctLongToWide.Rd ├── ctModel.Rd ├── ctModelHigherOrder.Rd ├── ctModelLatex.Rd ├── ctPlotArray.Rd ├── ctPoly.Rd ├── ctPostPredData.Rd ├── ctPostPredPlots.Rd ├── ctPredictTIP.Rd ├── ctResiduals.Rd ├── ctStanContinuousPars.Rd ├── ctStanDiscretePars.Rd ├── ctStanDiscreteParsPlot.Rd ├── ctStanFit.Rd ├── ctStanFitUpdate.Rd ├── ctStanGenerate.Rd ├── ctStanGenerateFromFit.Rd ├── ctStanKalman.Rd ├── ctStanModel.Rd ├── ctStanParnames.Rd ├── ctStanPlotPost.Rd ├── ctStanPostPredict.Rd ├── ctStanSubjectPars.Rd ├── ctStanTIpredeffects.Rd ├── ctStanUpdModel.Rd ├── ctWideNames.Rd ├── ctWideToLong.Rd ├── ctsem-package.Rd ├── ctstantestdat.Rd ├── ctstantestfit.Rd ├── datastructure.Rd ├── inv_logit.Rd ├── isdiag.Rd ├── log1p_exp.Rd ├── longexample.Rd ├── plot.ctFitCovCheck.Rd ├── plot.ctKalmanDF.Rd ├── plot.ctStanFit.Rd ├── plot.ctStanModel.Rd ├── plotctACF.Rd ├── sdpcor2cov.Rd ├── stanWplot.Rd ├── stan_checkdivergences.Rd ├── stan_reinitsf.Rd ├── stan_unconstrainsamples.Rd ├── standatact_specificsubjects.Rd ├── stanoptimis.Rd ├── summary.ctStanFit.Rd └── test_isclose.Rd ├── tests ├── testthat.R └── testthat │ ├── ctBinaryBinaryMix.R │ ├── ctBinaryGaussianMix.R │ ├── test-bivariatetrait_hmc.R │ ├── test-bootHessian.R │ ├── test-bootstrapScoreHessian.R │ ├── test-corrcheck.R │ ├── test-ctLOO.R │ ├── test-ctRaschExampleTest.R │ ├── test-dtVct.R │ ├── test-fixedvalsunspot.R │ ├── test-intervalise.R │ ├── test-knownFits.R │ ├── test-nonlinearVlinear.R │ ├── test-reshaping.R │ ├── test-runExamples.R │ ├── test-stantipred.R │ ├── test-sunspots.R │ ├── test-tdeffectvariation_covtest.R │ ├── test-timevarying.R │ ├── test-ukfpoptest.R │ └── test_behavGenNLcor.R └── vignettes ├── compactPDF.R ├── hierarchicalmanual.pdf ├── hierarchicalmanual.rnw └── hierarchicalrefs.bib /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^util/ 4 | ^staging/ 5 | ^R/old/*. 6 | ^R/dev/*. 7 | ^R/donotpackage/*. 8 | ^.git 9 | ^.gitignore 10 | ^README\.Rmd$ 11 | ^vignettes/hierarchicalmanual\.pdf$ 12 | ^vignettes/ctsem\.pdf$ 13 | ^vignettes/cache 14 | ^vignettes/figure 15 | ^vignettes/.*\.xml 16 | ^vignettes/.*\.log 17 | ^vignettes/.*\.gz 18 | ^vignettes/jss.cls 19 | ^vignettes/Sweave.sty 20 | ^vignettes/.*\.log 21 | ^vignettes/Sweave.sty 22 | ^vignettes/compactPDF.R 23 | ^docs 24 | ^src/((?!RcppExports\.cpp).)*$ 25 | ^tests/testthat/Rplots.pdf 26 | ^vignettes/.*\.blg 27 | ^\.github$ 28 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/check-standard.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,rstantools] 6 | pull_request: 7 | branches: [main, master,rstantools] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 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 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 30 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 31 | R_KEEP_PKG_SOURCE: yes 32 | 33 | steps: 34 | - uses: actions/checkout@v3 35 | 36 | - uses: r-lib/actions/setup-pandoc@v2 37 | 38 | - uses: r-lib/actions/setup-r@v2 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | http-user-agent: ${{ matrix.config.http-user-agent }} 42 | use-public-rspm: true 43 | 44 | - uses: r-lib/actions/setup-r-dependencies@v2 45 | with: 46 | extra-packages: any::rcmdcheck, local::. 47 | needs: check 48 | 49 | - name: executable Permissions 50 | run: | 51 | chmod +x configure 52 | 53 | - uses: r-lib/actions/setup-tinytex@v2 54 | env: 55 | TINYTEX_INSTALLER: TinyTeX 56 | 57 | - name: Install additional LaTeX packages 58 | run: | 59 | tlmgr install biblatex-apa biblatex babel-english csquotes preprint mathtools caption biber 60 | 61 | - uses: r-lib/actions/check-r-package@v2 62 | with: 63 | error-on: '"error"' 64 | upload-snapshots: true 65 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | /staging 5 | src 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ctsem 2 | Type: Package 3 | Title: Continuous Time Structural Equation Modelling 4 | Version: 3.10.3 5 | Date: 2025-4-9 6 | Authors@R: c(person("Charles", "Driver", role = 7 | c("aut","cre","cph"),email="charles.driver2@uzh.ch"), 8 | person("Manuel", "Voelkle", role = c("aut","cph")), 9 | person("Han", "Oud", role = c("aut","cph") ), 10 | person("Trustees of Columbia University",role='cph')) 11 | Description: Hierarchical continuous (and discrete) time state space modelling, for linear 12 | and nonlinear systems measured by continuous variables, with limited support for 13 | binary data. The subject specific dynamic system is modelled as a stochastic 14 | differential equation (SDE) or difference equation, measurement models are typically multivariate normal factor models. 15 | Linear mixed effects SDE's estimated via maximum likelihood and optimization are the default. 16 | Nonlinearities, (state dependent parameters) and random effects on all parameters 17 | are possible, using either max likelihood / max a posteriori optimization 18 | (with optional importance sampling) or Stan's Hamiltonian Monte Carlo sampling. 19 | See 20 | for details. Priors may be used. For the conceptual overview of the hierarchical Bayesian 21 | linear SDE approach, 22 | see . 23 | Exogenous inputs may also be included, for an overview of such possibilities see . 24 | Stan based functions are not available on 32 bit Windows systems at present. 25 | contains some tutorial blog posts. 26 | License: GPL-3 27 | Depends: 28 | R (>= 4.2.0), 29 | Rcpp (>= 0.12.16) 30 | URL: https://github.com/cdriveraus/ctsem 31 | Imports: 32 | cOde, 33 | data.table (>= 1.12.8), 34 | datasets, 35 | Deriv, 36 | expm, 37 | ggplot2, 38 | graphics, 39 | grDevices, 40 | MASS, 41 | Matrix, 42 | methods, 43 | mize, 44 | mvtnorm, 45 | parallel, 46 | plyr, 47 | RcppParallel (>= 5.0.1), 48 | rstan (>= 2.26.0), 49 | rstantools (>= 2.3.0), 50 | stats, 51 | tibble, 52 | tools, 53 | utils, 54 | splines, 55 | statmod 56 | Encoding: UTF-8 57 | LazyData: true 58 | ByteCompile: true 59 | LinkingTo: 60 | BH (>= 1.66.0-1), 61 | Rcpp (>= 0.12.16), 62 | RcppEigen (>= 0.3.3.4.0), 63 | RcppParallel (>= 5.0.1), 64 | rstan (>= 2.26), 65 | StanHeaders (>= 2.26.0), 66 | RcppParallel (>= 5.0.1) 67 | Suggests: 68 | knitr, 69 | testthat, 70 | devtools, 71 | DEoptim, 72 | tinytex, 73 | lme4, 74 | shiny, 75 | gridExtra, 76 | arules, 77 | collapse, 78 | qgam, 79 | papaja, 80 | future, 81 | future.apply 82 | VignetteBuilder: knitr 83 | RoxygenNote: 7.3.2 84 | SystemRequirements: GNU make 85 | NeedsCompilation: yes 86 | Biarch: true 87 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,ctFitCovCheck) 4 | S3method(plot,ctKalmanDF) 5 | S3method(plot,ctStanFit) 6 | S3method(plot,ctStanModel) 7 | S3method(summary,ctStanFit) 8 | export(ctACF) 9 | export(ctACFresiduals) 10 | export(ctAddSamples) 11 | export(ctCheckFit) 12 | export(ctChisqTest) 13 | export(ctCollapse) 14 | export(ctDeintervalise) 15 | export(ctDensity) 16 | export(ctDiscretiseData) 17 | export(ctDocs) 18 | export(ctExtract) 19 | export(ctFit) 20 | export(ctFitAuto) 21 | export(ctFitAutoGroupModel) 22 | export(ctFitCovCheck) 23 | export(ctFitMultiModel) 24 | export(ctGenerate) 25 | export(ctIndplot) 26 | export(ctIntervalise) 27 | export(ctKalman) 28 | export(ctLOO) 29 | export(ctLongToWide) 30 | export(ctModel) 31 | export(ctModelHigherOrder) 32 | export(ctModelLatex) 33 | export(ctPlotArray) 34 | export(ctPoly) 35 | export(ctPostPredData) 36 | export(ctPostPredPlots) 37 | export(ctPredictTIP) 38 | export(ctResiduals) 39 | export(ctStanContinuousPars) 40 | export(ctStanDiscretePars) 41 | export(ctStanDiscreteParsPlot) 42 | export(ctStanFit) 43 | export(ctStanFitUpdate) 44 | export(ctStanGenerate) 45 | export(ctStanGenerateFromFit) 46 | export(ctStanKalman) 47 | export(ctStanModel) 48 | export(ctStanParnames) 49 | export(ctStanPlotPost) 50 | export(ctStanPostPredict) 51 | export(ctStanSubjectPars) 52 | export(ctStanTIpredeffects) 53 | export(ctWideNames) 54 | export(ctWideToLong) 55 | export(inv_logit) 56 | export(isdiag) 57 | export(log1p_exp) 58 | export(plot.ctKalmanDF) 59 | export(plotctACF) 60 | export(sdpcor2cov) 61 | export(stanWplot) 62 | export(stan_checkdivergences) 63 | export(stan_reinitsf) 64 | export(stan_unconstrainsamples) 65 | export(standatact_specificsubjects) 66 | export(test_isclose) 67 | import(Rcpp) 68 | import(data.table) 69 | import(expm) 70 | import(ggplot2) 71 | import(grDevices) 72 | import(graphics) 73 | import(methods) 74 | import(stats) 75 | importFrom(Deriv,Simplify) 76 | importFrom(Rcpp,cpp_object_initializer) 77 | importFrom(Rcpp,evalCpp) 78 | importFrom(RcppParallel,CxxFlags) 79 | importFrom(RcppParallel,RcppParallelLibs) 80 | importFrom(cOde,jacobianSymb) 81 | importFrom(cOde,prodSymb) 82 | importFrom(data.table,data.table) 83 | importFrom(mize,mize) 84 | importFrom(plyr,aaply) 85 | importFrom(plyr,alply) 86 | importFrom(plyr,round_any) 87 | importFrom(rstan,As.mcmc.list) 88 | importFrom(rstan,constrain_pars) 89 | importFrom(rstan,get_num_upars) 90 | importFrom(rstan,get_sampler_params) 91 | importFrom(rstan,log_prob) 92 | importFrom(rstan,monitor) 93 | importFrom(rstan,sampling) 94 | importFrom(rstan,stan_model) 95 | importFrom(rstan,stanc) 96 | importFrom(rstan,unconstrain_pars) 97 | importFrom(splines,bs) 98 | importFrom(tibble,tibble) 99 | importFrom(tools,texi2pdf) 100 | importFrom(utils,as.relistable) 101 | importFrom(utils,capture.output) 102 | importFrom(utils,head) 103 | importFrom(utils,relist) 104 | importFrom(utils,tail) 105 | useDynLib(ctsem, .registration = TRUE) 106 | -------------------------------------------------------------------------------- /R/ctDataHelp.R: -------------------------------------------------------------------------------- 1 | #' AnomAuth 2 | #' 3 | #' A dataset containing panel data assessments of individuals Anomia and Authoritarianism. 4 | #' @format data frame with 2722 rows, 14 columns. Column Y1 represents anomia, 5 | #' Y2 Authoritarianism, dTx the time interval for measurement occasion x. 6 | #' @source See \doi{10.1037/a0027543} for details. 7 | #' @name AnomAuth 8 | NULL 9 | 10 | 11 | #' Oscillating 12 | #' 13 | #' Simulated example dataset for the ctsem package. 14 | #' @format 200 by 21 matrix containing containing ctsem wide format data. 15 | #' 11 measurement occasions and 10 measurement intervals for each of 200 individuals 16 | #' @source See \url{https://bpspsychub.onlinelibrary.wiley.com/doi/10.1111/j.2044-8317.2012.02043.x} 17 | #' @name Oscillating 18 | NULL 19 | 20 | 21 | 22 | #' ctExample1 23 | #' 24 | #' Simulated example dataset for the ctsem package 25 | #' @format 100 by 17 matrix containing containing ctsem wide format data. 26 | #' 6 measurement occasions of leisure time and happiness and 5 measurement intervals for each of 100 individuals. 27 | #' @name ctExample1 28 | NULL 29 | 30 | 31 | #' ctExample2 32 | #' 33 | #' Simulated example dataset for the ctsem package 34 | #' @format 100 by 18 matrix containing containing ctsem wide format data. 35 | #' 8 measurement occasions of leisure time and happiness, 36 | #' 7 measurement occasions of a money intervention dummy, 37 | #' and 7 measurement intervals for each of 50 individuals. 38 | #' @name ctExample2 39 | NULL 40 | 41 | #' ctExample3 42 | #' 43 | #' Simulated example dataset for the ctsem package 44 | #' @format 1 by 399 matrix containing containing ctsem wide format data. 45 | #' 100 observations of variables Y1 and Y2 and 199 measurement intervals, for 1 subject. 46 | #' @name ctExample3 47 | NULL 48 | 49 | #' ctExample4 50 | #' 51 | #' Simulated example dataset for the ctsem package 52 | #' @format 20 by 79 matrix containing 20 observations of variables 53 | #' Y1, Y2, Y3, and 19 measurement intervals dTx, for each of 20 individuals. 54 | #' @name ctExample4 55 | NULL 56 | 57 | #' ctExample1TIpred 58 | #' 59 | #' Simulated example dataset for the ctsem package 60 | #' @format 100 by 18 matrix containing containing ctsem wide format data. 61 | #' 6 measurement occasions of leisure time and happiness, 1 measurement of number of friends, 62 | #' and 5 measurement intervals for each of 100 individuals. 63 | #' @name ctExample1TIpred 64 | NULL 65 | 66 | 67 | #' ctExample2level 68 | #' 69 | #' Simulated example dataset for the ctsem package 70 | #' @format 100 by 18 matrix containing ctsem wide format data. 71 | #' 8 measurement occasions of leisure time and happiness, 72 | #' 7 measurement occasions of a money intervention dummy, 73 | #' and 7 measurement intervals for each of 50 individuals. 74 | #' @name ctExample2level 75 | NULL 76 | 77 | 78 | #' datastructure 79 | #' 80 | #' Simulated example dataset for the ctsem package 81 | #' @format 2 by 15 matrix containing containing ctsem wide format data. 82 | #' 3 measurement occasions of manifest variables Y1 and Y2, 83 | #' 2 measurement occasions of time dependent predictor TD1, 84 | #' 2 measurement intervals dTx, and 2 time independent predictors 85 | #' TI1 and TI2, for 2 individuals. 86 | #' @name datastructure 87 | NULL 88 | 89 | 90 | #' longexample 91 | #' 92 | #' Simulated example dataset for the ctsem package 93 | #' @format 7 by 8 matrix containing ctsem long format data, for two subjects, 94 | #' with three manifest variables Y1, Y2, Y3, 95 | #' one time dependent predictor TD1, two time independent predictors TI1 and TI2, 96 | #' and absolute timing information Time. 97 | #' @name longexample 98 | NULL 99 | 100 | 101 | 102 | #' ctstantestdat 103 | #' 104 | #' Generated dataset for testing \code{\link{ctStanFit}} from ctsem package. 105 | #' @format matrix 106 | #' @name ctstantestdat 107 | NULL 108 | 109 | #' ctstantestfit 110 | #' 111 | #' Dummy fit for testing functions from ctsem package. 112 | #' @format ctStanFit object 113 | #' @name ctstantestfit 114 | NULL 115 | 116 | 117 | 118 | -------------------------------------------------------------------------------- /R/ctDeintervalise.R: -------------------------------------------------------------------------------- 1 | #' ctDeintervalise 2 | #' 3 | #' Converts intervals in ctsem long format data to absolute time 4 | #' @param datalong data to use, in ctsem long format (attained via function ctWideToLong) 5 | #' @param id character string denoting column of data containing numeric identifier for each subject. 6 | #' @param dT character string denoting column of data containing time interval preceding observations in that row. 7 | #' @param startoffset Number of units of time to offset by when converting. 8 | #' @export 9 | ctDeintervalise<-function(datalong,id='id', dT='dT',startoffset=0){ 10 | 11 | message(paste0("Converting intervals to absolute time: Any missing intervals on 1st row of each subject are assumed to occur at earliest measurement time (", startoffset ,"), any other missing intervals render subsequent intervals for the subject unusable so time variables are set NA")) 12 | 13 | # initialmissingcount <- ifelse(is.na(datalong[1,dT]),1,0) 14 | # othermissingcount<-0 15 | datalong[1,dT]<-sum(c(datalong[1,dT],startoffset),na.rm=TRUE) #datalong row 1 equals first interval and offset 16 | 17 | for(i in 2:nrow(datalong)){ #for subsequent rows 18 | if(datalong[i,id]==datalong[i-1,id]){ #check if the subject is the same as the row above 19 | # othermissingcount <- ifelse(is.na(datalong[i,id]==datalong[i-1,id]),othermissingcount+1, othermissingcount) 20 | datalong[i,dT]<-sum(datalong[(i-1):i,dT],na.rm=FALSE) #if same subject, sum the new interval with the prev total time 21 | } else { 22 | # initialmissingcount <- ifelse(is.na(datalong[i,dT]),initialmissingcount+1,initialmissingcount) 23 | datalong[i,dT]<-sum(c(datalong[i,dT],startoffset),na.rm=T) #otherwise create new total time with new interval and offset 24 | } 25 | } 26 | colnames(datalong)[colnames(datalong) %in% dT] <-'time' 27 | return(datalong) 28 | } 29 | -------------------------------------------------------------------------------- /R/ctDiscretiseData.R: -------------------------------------------------------------------------------- 1 | #' Discretise long format continuous time (ctsem) data to specific timestep. 2 | #' 3 | #' Extends and rounds timing information so equal intervals, according to specified 4 | #' timestep, are achieved. NA's are inserted in other columns as necessary, 5 | #' any columns specified by TDpredNames or TIpredNames have zeroes rather than NA's 6 | #' inserted (because some estimation routines do not tolerate NA's in covariates). 7 | #' 8 | #' @param dlong Long format data 9 | #' @param timestep Positive real value to discretise 10 | #' @param timecol Name of column containing absolute (not intervals) time information. 11 | #' @param idcol Name of column containing subject id variable. 12 | #' @param TDpredNames Vector of column names of any time dependent predictors 13 | #' @param TIpredNames Vector of column names of any time independent predictors 14 | #' 15 | #' @return long format ctsem data. 16 | #' @export 17 | #' 18 | #' @examples 19 | #' long <- ctDiscretiseData(dlong=ctstantestdat, timestep = .1, 20 | #' TDpredNames=c('TD1'),TIpredNames=c('TI1','TI2','TI3')) 21 | 22 | ctDiscretiseData <- function(dlong, timestep, timecol = 'time', idcol = 'id', TDpredNames = NULL, TIpredNames = NULL) { 23 | 24 | dlong <- data.table(dlong) 25 | 26 | if (any(is.na(dlong[[timecol]]))) stop('Cannot discretise with missing time data!') 27 | if (any(is.na(dlong[[idcol]]))) stop('Cannot discretise with missing id data!') 28 | 29 | # Calculate the time offset that minimizes information loss 30 | offset <- mean(diff(unique(dlong[[timecol]]))) %% timestep 31 | 32 | originalrows <- sum(apply(dlong, 1, function(x) sum(!is.na(x)) - 2)) 33 | 34 | dlong[[timecol]] <- dlong[[timecol]] - offset 35 | dlong <- melt(dlong, id.vars = c(idcol, timecol)) 36 | dlong <- dlong[!is.na(value),] 37 | dlong <- dcast(dlong, formula = formula(paste0(idcol, '+', timecol, '~variable')), fun.aggregate = mean, na.rm = TRUE) 38 | 39 | dnew <- dlong 40 | dnew <- dnew[, .(newtime = seq(min(get(timecol)), max(get(timecol)), timestep)), by = idcol] 41 | setnames(dnew, old = 'newtime', timecol) 42 | dlong <- merge(dlong, dnew, all = TRUE, by = c(idcol, timecol)) 43 | setorderv(dlong, cols = c(idcol, timecol)) 44 | 45 | newrows <- sum(apply(dlong, 1, function(x) sum(!is.na(x)) - 2)) 46 | 47 | if (newrows != originalrows) warning(paste0(originalrows - newrows, ' cells of data removed due to time overlap -- reduce timestep if problematic')) 48 | 49 | dlong <- data.frame(dlong) 50 | dlong[, TDpredNames][is.na(dlong[, TDpredNames])] <- 0 51 | dlong[, TIpredNames][is.na(dlong[, TIpredNames])] <- NA 52 | 53 | return(dlong) 54 | } 55 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /R/ctExtractComplexMatrix.R: -------------------------------------------------------------------------------- 1 | ctExtractComplexMatrix <- function(matname, fit, time,id){ 2 | ks=ctStanKalman(fit) 3 | if(!id %in% ks$id) stop('Specified id not found in dataset') 4 | if(!time %in% ks$time[id %in% ks$id]) stop(paste0('Specified time not found in data from subject', id)) 5 | s=summary(fit,parmatrices=FALSE,residualcov=FALSE,priorcheck=FALSE) 6 | list2env(data.frame(t(s$popmeans[,'50%',drop=FALSE])),envir = environment()) 7 | list2env(data.frame(t(ks$etasmooth[1,which(ks$time %in% time & ks$id %in% id)[1], ])),envir = environment()) 8 | mat <- listOfMatrices(fit$ctstanmodelbase$pars)[[matname]] 9 | fit$ctstanmodel$LAMBDA[,1,drop=FALSE] 10 | for(i in 1:nrow(mat)){ 11 | for(j in 1:ncol(mat)){ 12 | mat[i,j] <- eval(parse(text=paste0(mat[i,j]))) 13 | } 14 | } 15 | mat <- matrix(as.numeric(mat),nrow(mat)) 16 | } 17 | -------------------------------------------------------------------------------- /R/ctFitMultiModel.R: -------------------------------------------------------------------------------- 1 | #' Fit and summarise a list of ctsem models 2 | #' 3 | #' @param mlist Named list of models 4 | #' @param datalong ctsem long format data 5 | #' @param type 'ct' for continuous time or 'dt' for discrete time 6 | #' @param cores number of cpu cores to use 7 | #' @param summaryOutput Generate summary output into ctSummary folder? Large datasets can take some time. 8 | #' @param saveFits Save fit objects to working directory? 9 | #' @param summaryArgs Additional arguments for ctSummarise. 10 | #' @param prefix prefix for output files. 11 | #' @param cv Perform k-fold cross validation? 12 | #' @param cvArgs Additional arguments for ctLOO function used for cross validation. 13 | #' @param ... Additional arguments for ctStanFit. 14 | #' 15 | #' @return List containing a named list of model fits ($fits), and a compare object ($compare) 16 | #' @export 17 | #' 18 | #' @examples 19 | #' \dontrun{ 20 | #' sunspots<-data.frame(id=1, 21 | #' time=do.call(seq,(lapply(attributes(sunspot.year)$tsp,function(x) x))), 22 | #' sunspots=sunspot.year) 23 | #' 24 | #' ssmodel1 <- ctModel(type='omx', manifestNames='sunspots', Tpoints=3, 25 | #' latentNames=c('ss_level', 'ss_velocity'), 26 | #' LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 27 | #' DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 28 | #' MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 29 | #' MANIFESTVAR=diag(0,1), #As per original spec 30 | #' CINT=matrix(c(0, 0), nrow=2, ncol=1), 31 | #' DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 32 | #' 33 | #' ssmodel2 <- ssmodel1 34 | #' ssmodel2$LAMBDA[2] <- 0 35 | #' 36 | #' fits<-ctFitMultiModel(list(m1=ssmodel1,m2=ssmodel2),datalong = sunspots, 37 | #' summaryOutput = FALSE, saveFits = FALSE, cores=1, cv=TRUE, cvArgs=list(folds=5)) 38 | #' print(fits$compare) 39 | #' } 40 | 41 | 42 | ctFitMultiModel <- function(mlist, datalong, prefix='',type='ct',cores=2, summaryOutput=TRUE, 43 | saveFits = TRUE, summaryArgs = list(),cv=FALSE, cvArgs=list(),...){ 44 | 45 | newfit <- function(model,name){ #function to convert old model to new form, fit with and without covariates, summarise, and save. 46 | if(class(model) %in% "ctsemInit") model <- ctStanModel(model,type = type) #convert to new model form 47 | fit <- ctStanFit(datalong =datalong, ctstanmodel =model,cores=cores,...) 48 | 49 | if(summaryOutput){ 50 | summaryArgs$cores <- cores 51 | summaryArgs$name <- paste0(prefix,name) 52 | summaryArgs$sf <- fit 53 | do.call(ctSummarise, summaryArgs) 54 | } 55 | if(saveFits) save(fit,file=paste0('fit_',name,'.rda')) 56 | return(fit) 57 | } 58 | 59 | 60 | mfit <- lapply(1:length(mlist),function(x) newfit(mlist[[x]],names(mlist)[x])) 61 | names(mfit) <- names(mlist) 62 | mcompare <- data.frame(t(sapply(mfit,function(x) c( 63 | npars=length(x$stanfit$rawest), 64 | loglik=x$stanfit$transformedparsfull$ll, 65 | aic=2*length(x$stanfit$rawest)-2*x$stanfit$transformedparsfull$ll, 66 | logprob=x$stanfit$optimfit$value)))) 67 | 68 | # mcompare <- mcompare[order(mcompare$aic),] #disabled ordering - return in same order as models input 69 | 70 | if(summaryOutput){ 71 | sink(file = paste0(prefix,'_compare.txt')) 72 | print(mcompare) 73 | sink() 74 | } 75 | 76 | if(cv){ 77 | if(is.null(cvArgs$cores)) cvArgs$cores <- cores 78 | cv <- lapply(mfit,function(x){ 79 | args <- cvArgs 80 | args$fit <- x 81 | do.call(ctLOO,args) 82 | }) 83 | mcompare$OOSloglik <- lapply(cv,function(x) x$outsampleLogLik) 84 | } 85 | 86 | return(list(fits = mfit, compare=mcompare)) 87 | } 88 | -------------------------------------------------------------------------------- /R/ctGraph.R: -------------------------------------------------------------------------------- 1 | ctGraphPlot <- function(x,DRIFT=TRUE, DIFFUSION=TRUE){ 2 | if('ctStanModel' %in% class(x)){ 3 | model <- x 4 | parmats <- listOfMatrices(x$pars) 5 | A <- parmats$DRIFT 6 | G <- parmats$DIFFUSION 7 | 8 | A <- matrix(as.integer(!A %in% '0'),nrow(A),ncol(A)) 9 | G <- matrix(as.numeric(!G %in% '0'),nrow(G),ncol(G)) 10 | } 11 | if('ctStanFit' %in% class(x)){ 12 | model <-x$ctstanmodelbase 13 | A <- x$stanfit$transformedparsfull$DRIFT[1,,] 14 | G <- x$stanfit$transformedparsfull$DIFFUSION[1,,] 15 | } 16 | 17 | dimnames(A) <- list(model$latentNames,model$latentNames) 18 | dimnames(G) <- list(model$latentNames,model$latentNames) 19 | 20 | 21 | # Load required libraries 22 | library(tidygraph) 23 | library(ggraph) 24 | library(dplyr) 25 | library(igraph) # Only needed for matrix handling 26 | 27 | 28 | 29 | # Create node data frame from rownames 30 | nodes_df <- data.frame(name = rownames(G), stringsAsFactors = FALSE) 31 | 32 | # Create edge data frame for G edges (undirected; use only lower triangle to avoid duplicates) 33 | edges_G <- do.call(rbind, lapply(2:nrow(G), function(i) { 34 | do.call(rbind, lapply(1:(i - 1), function(j) { 35 | if (G[i, j] != 0) 36 | data.frame(from = rownames(G)[j], 37 | to = rownames(G)[i], 38 | weight = G[i, j], 39 | edge_type = "G", 40 | stringsAsFactors = FALSE) 41 | })) 42 | })) 43 | edges_G <- edges_G[!is.na(edges_G$from), ] 44 | 45 | # Create edge data frame for A edges (directed; include all nonzero entries) 46 | edges_A <- do.call(rbind, lapply(1:nrow(A), function(i) { 47 | do.call(rbind, lapply(1:ncol(A), function(j) { 48 | if (A[i, j] != 0) 49 | data.frame(from = rownames(A)[i], 50 | to = rownames(A)[j], 51 | weight = A[i, j], 52 | edge_type = "A", 53 | stringsAsFactors = FALSE) 54 | })) 55 | })) 56 | edges_A <- edges_A[!is.na(edges_A$from), ] 57 | 58 | # Combine the two edge data frames and add a column for layout weights (absolute weight) 59 | edges_all <- bind_rows(edges_G, edges_A) %>% 60 | mutate(layout_weight = abs(weight)) 61 | 62 | # Create a tidygraph object 63 | graph_obj <- tbl_graph(nodes = nodes_df, edges = edges_all, directed = TRUE) 64 | 65 | # Compute the layout using the positive weights (Fruchterman-Reingold) 66 | # (Alternatively, you can use create_layout() as below if you want a layout object.) 67 | layout_obj <- create_layout(graph_obj, layout = "fr", weights = layout_weight) 68 | 69 | # Plot the network using ggraph. 70 | # We use the filter aesthetic (with .data) to choose which edges to plot in each layer. 71 | ggraph(graph_obj, layout = "fr", weights = layout_weight) + 72 | # Plot undirected G edges as dashed green arcs (no arrowheads) 73 | geom_edge_arc(aes(filter = .data$edge_type == "G"), 74 | edge_colour = "green", 75 | linetype = "dashed", 76 | edge_width = 0.8, 77 | edge_alpha = 0.8) + 78 | # Plot directed A edges using geom_edge_parallel to offset overlapping edges. 79 | geom_edge_parallel(aes(filter = .data$edge_type == "A", 80 | edge_colour = ifelse(.data$weight > 0, "red", "blue")), 81 | arrow = arrow(length = unit(3, 'mm'), type = "closed"), 82 | end_cap = circle(3, 'mm'), 83 | edge_width = 0.8) + 84 | # Plot nodes and labels. 85 | geom_node_point(size = 5, color = "black") + 86 | geom_node_text(aes(label = name), repel = TRUE, size = 4) + 87 | theme_void() + 88 | guides( 89 | edge_alpha = "none", 90 | edge_width = "none", 91 | edge_colour = "none" 92 | ) 93 | 94 | } 95 | -------------------------------------------------------------------------------- /R/ctIndplot.R: -------------------------------------------------------------------------------- 1 | #' ctIndplot 2 | #' 3 | #' Convenience function to simply plot individuals trajectories from ctsem wide format data 4 | #' @param datawide ctsem wide format data 5 | #' @param n.subjects Number of subjects to randomly select for plotting, or character vector 'all'. 6 | #' @param Tpoints Number of discrete time points per case in data structure 7 | #' @param n.manifest Number of manifest variables in data structure 8 | #' @param colourby set plot colours by "subject" or "variable" 9 | #' @param vars either 'all' or a numeric vector specifying which manifest variables to plot. 10 | #' @param opacity Opacity of plot lines 11 | #' @param varnames vector of variable names for legend (defaults to NULL) 12 | #' @param xlab X axis label. 13 | #' @param ylab Y axis label. 14 | #' @param type character specifying plot type, as per usual base R plot commands. 15 | #' Defaults to 'b', both points and lines. 16 | #' @param start Measurement occasion to start plotting from - defaults to T0. 17 | #' @param legend Logical. Plot a legend? 18 | #' @param legendposition Where to position the legend. 19 | #' @param ... additional plotting parameters. 20 | #' @param new logical. If TRUE, creates a new plot, otherwise overlays on current plot. 21 | #' @param jittersd positive numeric indicating standard deviation of noise to add to observed 22 | #' data for plotting purposes. 23 | #' @examples 24 | #' 25 | #' data(ctExample1) 26 | #' ctIndplot(ctExample1,n.subjects=1, n.manifest=2,Tpoints=6, colourby='variable') 27 | #' 28 | #' @export 29 | ctIndplot<-function(datawide,n.manifest,Tpoints,n.subjects='all',colourby="variable", 30 | vars='all',opacity=1,varnames=NULL,xlab='Time',ylab='Value',type='b',start=0,legend=TRUE, 31 | legendposition='topright',new=TRUE,jittersd=.05,...){ 32 | 33 | if(n.subjects=='all') n.subjects=nrow(datawide) 34 | 35 | if(length(vars)==1 && vars[1]=='all') vars<-1:n.manifest 36 | 37 | if(colourby=="variable") colourvector <- grDevices::rainbow(length(vars),alpha=opacity) 38 | if(colourby=="subject") colourvector <- grDevices::rainbow(n.subjects,alpha=opacity) 39 | 40 | 41 | ymin<-min(datawide[1:nrow(datawide),cseq(vars,n.manifest*Tpoints,n.manifest)],na.rm=T) 42 | ymax<-max(datawide[1:nrow(datawide),cseq(vars,n.manifest*Tpoints,n.manifest)],na.rm=T) 43 | 44 | # browser() 45 | individuals<-sample(1:nrow(datawide),n.subjects) 46 | times<-matrix(unlist(lapply(1:(Tpoints-1),function(x){ 47 | apply(datawide[individuals,,drop=FALSE][,paste0('dT',1:x),drop=FALSE],1,sum,na.rm=T) 48 | })),ncol=(Tpoints-1)) 49 | 50 | if(new==TRUE) graphics::plot(NA,ylim=c(ymin,ymax),xlim=c(start,max(times)), 51 | ylab=ylab,xlab=xlab,...) 52 | 53 | 54 | message(c('Plotting rows ',paste0(individuals,", "))) 55 | for(i in 1:n.subjects){ 56 | 57 | for(j in 1:length(vars)){ 58 | graphics::points(c(0,times[i,]), 59 | datawide[individuals[i],seq(vars[j],n.manifest*Tpoints,n.manifest)] + 60 | rnorm(length(t(datawide[individuals[i],seq(vars[j],n.manifest*Tpoints,n.manifest)])),0,jittersd), 61 | col=ifelse(colourby=="variable",colourvector[j],colourvector[i]),type=type,pch=j,lty=1,...) 62 | }} 63 | 64 | if(is.null(varnames)) varnames <- paste0("var",vars) #set varnames for legend 65 | 66 | if(legend==TRUE){ 67 | if(colourby=="variable") { 68 | graphics::legend(legendposition,varnames,pch=vars,col=colourvector,text.col=colourvector,bty="n") 69 | } 70 | if(colourby=="subject") { 71 | graphics::legend(legendposition,varnames,pch=vars,bty="n") 72 | } 73 | } 74 | 75 | } 76 | -------------------------------------------------------------------------------- /R/ctModelHigherOrder.R: -------------------------------------------------------------------------------- 1 | #' Raise the order of a ctsem model object of type 'omx'. 2 | #' 3 | #' @param ctm ctModel 4 | #' @param indices Vector of integers, which latents to raise the order of. 5 | #' @param diffusion Shift the diffusion parameters / values to the higher order? 6 | #' @param crosseffects Shift cross coupling parameters of the DRIFT matrix to the higher order? 7 | #' @param cint shift continuous intercepts to higher order? 8 | #' @param explosive Allow explosive (non equilibrium returning) processes? 9 | #' 10 | #' @return extended ctModel 11 | #' @export 12 | #' 13 | #' @examples 14 | #' om <- ctModel(LAMBDA=diag(1,2),DRIFT=0, 15 | #' MANIFESTMEANS=0,type='omx',Tpoints=4) 16 | #' 17 | #' om <- ctModelHigherOrder(om,1:2) 18 | #' print(om$DRIFT) 19 | #' 20 | #' m <- ctStanModel(om) 21 | #' print(m$pars) 22 | ctModelHigherOrder <- function(ctm, indices,diffusion=TRUE, crosseffects=FALSE,cint=FALSE, explosive=FALSE){ 23 | ctm$latentNames <- c(ctm$latentNames,paste0('d',ctm$latentNames[indices])) 24 | nl <- ctm$n.latent 25 | 26 | for(i in 1:length(indices)){ 27 | for(m in c('DRIFT','DIFFUSION','T0VAR')){ 28 | ctm[[m]] <- rbind(cbind(ctm[[m]],0),0) 29 | } 30 | for(m in c('CINT','T0MEANS')){ 31 | ctm[[m]] <- rbind(ctm[[m]],0) 32 | } 33 | ctm$LAMBDA <- cbind(ctm$LAMBDA,0) 34 | if(ctm$n.TDpred > 0) ctm$TDPREDEFFECT <- rbind(ctm$TDPREDEFFECT,0) 35 | } 36 | 37 | for(i in 1:length(indices)){ 38 | # browser() 39 | if(!crosseffects) ctm$DRIFT[i+nl,i+nl] <- ctm$DRIFT[indices[i],indices[i]] #move ar param / value to higher order 40 | if(crosseffects){ 41 | m <- 'DRIFT' 42 | # browser() 43 | ctm[[m]][i+nl,] <- ctm[[m]][indices[i],] #move crosseffect params / value to higher order 44 | ctm[[m]][,i+nl] <- ctm[[m]][,indices[i]] #move crosseffect params / value to higher order 45 | ctm[[m]][indices[i],] <- 0 #set order 1 crosseffect to 0 46 | ctm[[m]][,indices[i]] <- 0 #set order 1 crosseffect to 0 47 | } 48 | ctm$DRIFT[indices[i],indices[i]] <- 0 #set ar param / value to 0 49 | ctm$DRIFT[indices[i],i+nl] <- 1 #set effect of higher order to 1 50 | ctm$DRIFT[i+nl,indices[i]] <-paste0('drift_',ctm$latentNames[i+nl],'_', 51 | ctm$latentNames[indices[i]], 52 | ifelse(!explosive,'|-log1p(exp(-param*2))-1e-6','|param*2-1')) #estimate effect of 1st order on 2nd 53 | if(indices[i]==tail(indices,1)) rownames(ctm$DRIFT) <- ctm$latentNames 54 | if(indices[i]==tail(indices,1)) colnames(ctm$DRIFT) <- ctm$latentNames 55 | 56 | for(m in c('T0VAR','DIFFUSION')){ 57 | if(diffusion && m=='DIFFUSION'){ 58 | ctm[[m]][i+nl,] <- ctm[[m]][indices[i],] #move diffusion params / value to higher order 59 | ctm[[m]][,i+nl] <- ctm[[m]][,indices[i]] #move diffusion params / value to higher order 60 | ctm[[m]][indices[i],] <- 0 #set order 1 diffusion to 0 61 | ctm[[m]][,indices[i]] <- 0 #set order 1 diffusion to 0 62 | } 63 | if(indices[i]==tail(indices,1)) colnames(ctm[[m]]) <- ctm$latentNames 64 | if(indices[i]==tail(indices,1)) rownames(ctm[[m]]) <- ctm$latentNames 65 | } 66 | 67 | for(m in c('CINT','T0MEANS')){ 68 | # browser() 69 | if(m %in% 'T0MEANS') ctm[[m]][i+nl,1] <- paste0('T0mean_d_',ctm$latentNames[indices[i]]) 70 | if(!m %in% 'T0MEANS' && cint){ 71 | ctm[[m]][indices[i]+nl,] <- ctm[[m]][indices[i],] 72 | ctm[[m]][indices[i],] <- 0 #set order 1 param to 0 73 | } 74 | if(indices[i]==tail(indices,1)) rownames(ctm[[m]]) <- ctm$latentNames 75 | } 76 | } 77 | # browser() 78 | for(i in c(nl+seq_along(indices))){ 79 | for(j in c(1:nl,nl+seq_along(indices))){ 80 | if(i >= j) ctm$T0VAR[i,j] <- paste0('T0var_',ctm$latentNames[i],'_', 81 | ctm$latentNames[j]) 82 | } 83 | } 84 | ctm$n.latent <- ctm$n.latent + length(indices) 85 | 86 | return(ctm) 87 | } 88 | 89 | -------------------------------------------------------------------------------- /R/ctStanContinuousPars.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #'ctStanContinuousPars 4 | #' 5 | #'Returns the continuous time parameter matrices of a ctStanFit fit object 6 | #' 7 | #'@param fit fit object from \code{\link{ctStanFit}} 8 | #'@param calcfunc Function to apply over samples, must return a single value. 9 | #'By default the median over all samples is returned using the \code{\link[stats]{quantile}} function, 10 | #'but one might also be interested in the \code{\link[base]{mean}} or \code{\link[stats]{sd}}, for instance. 11 | #'@param calcfuncargs A list of additional parameters to pass to calcfunc. 12 | #'For instance, with the default of calcfunc = quantile, 13 | #'the probs argument is needed to ensure only a single value is returned. 14 | #'@param timeinterval time interval for discrete time parameter matrix computation. 15 | #'@examples 16 | #'\donttest{ 17 | #'#posterior median over all subjects (also reflects mean of unconstrained pars) 18 | #'ctStanContinuousPars(ctstantestfit) 19 | #'} 20 | #'@export 21 | ctStanContinuousPars <- function(fit, 22 | calcfunc=quantile,calcfuncargs=list(probs=0.5),timeinterval=1){ 23 | 24 | if(!'ctStanFit' %in% class(fit)) stop(paste0('Not an object of class ctStanFit! Instead is ',paste0(class(fit),collapse=', '))) 25 | 26 | e<-ctExtract(fit,cores=1) #Qfit$stanfit$transformedpars #first dim of subobjects is iter, 2nd subjects 27 | niter=dim(e$pop_DRIFT)[1] 28 | 29 | 30 | 31 | 32 | mats <- ctStanMatricesList() 33 | mats <- c(names(mats$base), names(mats$asymptotic),names(mats$extra)) 34 | if(fit$ctstanmodel$continuoustime){ 35 | d=list(DRIFT=e$pop_DRIFT) 36 | dd=ctStanDiscreteParsDrift(d,timeinterval,observational = FALSE,standardise = FALSE,cov = FALSE,quiet=TRUE) 37 | e$pop_dtDRIFT <- array(dd,dim=dim(dd)[-2:-3]) 38 | mats <- c(mats, 'dtDRIFT') 39 | } 40 | 41 | out <- list() 42 | for(matname in (mats)){ 43 | try({ 44 | calcfuncargs$collapsemargin = 1 45 | calcfuncargs$collapsefunc=calcfunc 46 | calcfuncargs$na.rm=TRUE 47 | 48 | calcfuncargs$inarray = e[[paste0('pop_',matname)]] 49 | out[[matname]] <- array(do.call(ctCollapse,calcfuncargs), 50 | dim=dim(calcfuncargs$inarray)[-1]) 51 | },silent=TRUE) 52 | } 53 | 54 | if(nrow(out$T0MEANS) > nrow(out$CINT)){ #then intoverpop used... 55 | nlatent <- nrow(out$CINT) 56 | out$T0MEANS <- out$T0MEANS[1:nlatent,1,drop=FALSE] 57 | out$DRIFT <- out$DRIFT[1:nlatent,1:nlatent,drop=FALSE] 58 | out$T0VAR <- out$T0VAR[1:nlatent,1:nlatent,drop=FALSE] 59 | out$T0cov <- out$T0cov[1:nlatent,1:nlatent,drop=FALSE] 60 | } 61 | 62 | ln=fit$ctstanmodel$latentNames 63 | mn=fit$ctstanmodel$manifestNames 64 | tdn=fit$ctstanmodel$TDpredNames 65 | dimnames(out$DRIFT)=list(ln,ln) 66 | dimnames(out$DIFFUSIONcov)=list(ln,ln) 67 | dimnames(out$DIFFUSION)=list(ln,ln) 68 | dimnames(out$T0cov)=list(ln,ln) 69 | dimnames(out$asymDIFFUSIONcov)=list(ln,ln) 70 | rownames(out$CINT)=ln 71 | rownames(out$MANIFESTMEANS)=mn 72 | rownames(out$T0MEANS)=ln 73 | 74 | dimnames(out$T0VAR)=list(ln,ln) 75 | dimnames(out$LAMBDA)=list(mn,ln) 76 | 77 | 78 | if(!is.null(e$pop_MANIFESTVAR)) { 79 | dimnames(out$MANIFESTVAR)=list(mn,mn) 80 | dimnames(out$MANIFESTcov)=list(mn,mn) 81 | # out$MANIFESTVAR=out$MANIFESTVAR %*% t(out$MANIFESTVAR) #cholesky factor inside stanfit... 82 | 83 | } 84 | 85 | if(!is.null(e$pop_TDPREDEFFECT)) { 86 | dimnames(out$TDPREDEFFECT)=list(ln,tdn) 87 | } 88 | 89 | out$MANIFESTVAR <- NULL ; 90 | 91 | 92 | return(out) 93 | } 94 | 95 | -------------------------------------------------------------------------------- /R/ctStanGenerateFromFit.R: -------------------------------------------------------------------------------- 1 | #' Add a \code{$generated} object to ctstanfit object, with random data generated from posterior of ctstanfit object 2 | #' 3 | #' @param fit ctstanfit object 4 | #' @param nsamples Positive integer specifying number of datasets to generate. 5 | #' @param fullposterior Logical indicating whether to sample from the full posterior (original nsamples) or the posterior mean. 6 | #' @param verboseErrors if TRUE, print verbose output when errors in generation encountered. 7 | #' @param cores Number of cpu cores to use. 8 | #' @return Matrix of generated data -- one dataset per iteration, according to original time and missingness structure. 9 | #' @export 10 | #' @examples 11 | #' gen <- ctStanGenerateFromFit(ctstantestfit, nsamples=3,fullposterior=TRUE,cores=1) 12 | #' plot(gen$generated$Y[3,,2],type='l') #Third random data sample, 2nd manifest var, all time points. 13 | ctStanGenerateFromFit<-function(fit,nsamples=200,fullposterior=FALSE, verboseErrors=FALSE,cores=2){ 14 | 15 | if(!'ctStanFit' %in% class(fit)) stop('Not a ctStanFit object!') 16 | 17 | if(nsamples > ncol(fit$stanfit$rawposterior) & fullposterior & is.null(fit$stanfit$stanfit)) fit <- ctAddSamples(fit,nsamples = nsamples,cores=1) 18 | 19 | if(nsamples > ncol(fit$stanfit$rawposterior)) replace=TRUE else replace=FALSE #if nsamples still larger than available, use replacement 20 | 21 | if(!fullposterior){ 22 | umat=matrix(fit$stanfit$rawest,nrow=length(fit$stanfit$rawest),ncol=nsamples) 23 | } else umat=t(fit$stanfit$rawposterior)[,sample(1:nrow(fit$stanfit$rawposterior),size=nsamples,replace = replace),drop=FALSE] 24 | 25 | 26 | if(fit$setup$recompile) { 27 | message('Compilation needed -- compiling (usually ~ 1 min)') 28 | genm <- rstan::stan_model(model_code = 29 | ctStanModelWriter(ctm = fit$ctstanmodel, 30 | gendata = TRUE, 31 | extratforms = fit$setup$extratforms, 32 | matsetup=fit$ctstanmodel$modelmats$matsetup)) 33 | } else { 34 | genm <- stanmodels$ctsmgen 35 | } 36 | message('Generating data from ',ifelse(fullposterior,'posterior', 'posterior mean')) 37 | message('Using ',cores,'/', parallel::detectCores(),' logical CPU cores') 38 | standata <- fit$standata 39 | # standata$intoverstates=0L #why doesnt this work?? 40 | standata$savescores <- 0L #have to disable for data generation in same structure as original 41 | # genf <- stan_reinitsf(genm,standata) 42 | 43 | 44 | cs=suppressMessages(stan_constrainsamples(sm =genm,standata = standata,cores=cores,samples = t(umat), 45 | savescores = FALSE, savesubjectmatrices = FALSE,dokalman = TRUE, onlyfirstrow = FALSE,pcovn = FALSE)) 46 | fit$generated$Y <- cs$Y #,c(2,1,3)) 47 | fit$generated$llrow <- cs$llrow 48 | fit$generated$llrow[fit$generated$llrow==0]<-NA 49 | fit$generated$stanmodel <- genm 50 | 51 | dimnames( fit$generated$Y)<-list( 52 | sample=1:dim(fit$generated$Y)[1], 53 | row=1:dim(fit$generated$Y)[2], 54 | fit$ctstanmodel$manifestNames) 55 | 56 | fit$generated$Y[fit$generated$Y==99999] <- NA 57 | 58 | return(fit) 59 | } 60 | -------------------------------------------------------------------------------- /R/ctStanParMatrices.R: -------------------------------------------------------------------------------- 1 | 2 | ctStanParMatrices <- function(fit, parvalues, parindex, timeinterval=1){ 3 | if(!'ctStanFit' %in% class(fit)) stop('not a ctStanFit object') 4 | 5 | model <- fit$ctstanmodel 6 | fit$standata$savescores <- 0L 7 | fit$standata$gendata <- 0L 8 | fit$standata$dokalman <- 0L 9 | fit$standata$dokalmanrows[-1] <- 0L 10 | nlatent = fit$standata$nlatent 11 | 12 | whichmatrices <- c('PARS','T0MEANS','LAMBDA','DRIFT','MANIFESTMEANS','CINT', 13 | 'DIFFUSIONcov','DIFFUSIONcor','asymDIFFUSIONcov','asymDIFFUSIONcor','T0cov','T0cor','asymCINT','MANIFESTcov') 14 | if(fit$ctstanmodel$continuoustime) whichmatrices <- c(whichmatrices, 15 | 'dtDRIFT','dtDIFFUSION','dtCINT') 16 | 17 | out <- list() 18 | for(m in whichmatrices){ 19 | if(!is.null(parvalues[[paste0('pop_',m)]])){ 20 | arrcommas <- paste0(rep(',',times=length(dim(parvalues[[paste0('pop_',m)]]))-1),collapse='') 21 | out[[m]] <- 22 | eval(parse(text=paste0( 23 | "array(parvalues[[paste0('pop_',m)]][parindex",arrcommas,"],dim=dim(parvalues[[paste0('pop_',m)]])[-1])"))) 24 | } 25 | } 26 | 27 | out$T0cov <- out$T0cov[1:nlatent,1:nlatent,drop=FALSE] 28 | out$T0MEANS <- out$T0MEANS[1:nlatent,,drop=FALSE] 29 | 30 | 31 | # #cholesky factor fix 32 | # out$MANIFESTVAR=out$MANIFESTcov #cholesky factor inside stanfit... 33 | # out$DIFFUSION=out$DIFFUSIONcov 34 | 35 | # #dimension naming (latent row object, manifest column object, etc 36 | # for(lro in c('DRIFT','DIFFUSION','CINT','T0VAR','T0MEANS','asymDIFFUSION',if('TDPREDEFFECT' %in% model$pars$matrix) 'TDPREDEFFECT')){ 37 | # if(lro %in% whichmatrices) rownames(out[[lro]]) <- model$latentNames 38 | # } 39 | # for(lco in c('DRIFT','DIFFUSIONcov','T0VAR','asymDIFFUSION','LAMBDA')){ 40 | # if(lco %in% whichmatrices) colnames(out[[lco]]) <- model$latentNames 41 | # } 42 | # for(mro in c('LAMBDA','MANIFESTVAR','MANIFESTMEANS')){ 43 | # if(mro %in% whichmatrices) rownames(out[[mro]]) <- model$manifestNames 44 | # } 45 | # for(mco in c('MANIFESTVAR')){ 46 | # if(mco %in% whichmatrices) colnames(out[[mco]]) <- model$manifestNames 47 | # } 48 | # 49 | # if('TDPREDEFFECT' %in% model$pars$matrix) colnames(out$TDPREDEFFECT) <- model$TDpredNames 50 | # 51 | 52 | # choltrue <- FALSE #!as.logical(fit$data$lineardynamics) 53 | 54 | # if(choltrue) DIFFUSION = msquare(DIFFUSION) #sdcovchol2cov(DIFFUSION,0) 55 | if('DIFFUSIONcor' %in% whichmatrices){ 56 | out$DIFFUSIONcor = suppressWarnings(stats::cov2cor(out$DIFFUSIONcov)) 57 | out$DIFFUSIONcor[is.na(out$DIFFUSIONcor)] <- 0 58 | } 59 | 60 | if('asymDIFFUSIONcor' %in% whichmatrices){ 61 | out$asymDIFFUSIONcor = suppressWarnings(stats::cov2cor(out$asymDIFFUSIONcov)) 62 | out$asymDIFFUSIONcor[is.na(out$asymDIFFUSIONcor)] <- 0 63 | } 64 | 65 | if(fit$ctstanmodel$continuoustime) out$dtDRIFT=as.matrix(Matrix::expm(out$DRIFT * timeinterval)) 66 | if('dtDIFFUSION' %in% whichmatrices) out$dtDIFFUSION = out$asymDIFFUSIONcov - (out$dtDRIFT %*% out$asymDIFFUSIONcov %*% t(out$dtDRIFT )) 67 | if('dtDIFFUSIONcor' %in% whichmatrices) out$dtDIFFUSIONcor = cov2cor(out$dtDIFFUSION) 68 | if('dtCINT' %in% whichmatrices) out$dtCINT = (solve(out$DRIFT, out$dtDRIFT - diag(nrow(out$DRIFT))) %*% (out$CINT)) 69 | if('asymCINT' %in% whichmatrices) out$asymCINT = matrix(out$asymCINT,ncol=1)#-solve(out$DRIFT) %*% out$CINT 70 | 71 | if('T0cor' %in% whichmatrices) { 72 | out$T0cor = suppressWarnings(stats::cov2cor(out$T0cov)) 73 | out$T0cor[is.na(out$T0cor)] <- 0 74 | } 75 | 76 | return(out) 77 | } 78 | -------------------------------------------------------------------------------- /R/ctTransforms.R: -------------------------------------------------------------------------------- 1 | fdtb <- function(b, A, dt) solve(A,fdtA(A,dt)[[1]]-diag(1,nrow(A))) %*% b 2 | 3 | fQinf <- function(A,G){ 4 | Ahatch=A %x% diag(1,nrow(A)) + 5 | diag(1,nrow(A)) %x% A 6 | Qinf<-matrix(-solve(Ahatch , c(G %*% t(G))), nrow=nrow(A)) 7 | try(dimnames(Qinf)<-dimnames(G)) 8 | return(Qinf) 9 | } 10 | 11 | fdtQ <- function(Qinf, dtA) Qinf - (dtA %*% Qinf %*% t(dtA )) 12 | 13 | fdtQe <- function(A, Q,dt=1){ 14 | d=nrow(A) 15 | bA <- matrix(0,d*2,d*2) 16 | bA[1:d,1:d] <- -(A) 17 | bA[1:d,(d+1):(d*2)] <- Q 18 | bA[(d+1):(d*2),(d+1):(d*2)] <- t(A) 19 | 20 | ebA <- expm(bA %x% dt) 21 | dtQ<-t(ebA[(d+1):(d*2),(d+1):(d*2)]) %*% ebA[1:d,(d+1):(d*2)] 22 | return(dtQ) 23 | } 24 | 25 | fAstd <- function(A, G){ 26 | d=nrow(A) 27 | asymDIFFUSION<-fQinf(A,G) 28 | standardiser <- rep(sqrt(diag(asymDIFFUSION)),each=d) / rep(sqrt(diag(asymDIFFUSION)),times=d) 29 | Astd<-A * standardiser 30 | try(dimnames(Astd)<-dimnames(A)) 31 | return(Astd) 32 | } 33 | 34 | fdtAstd <- function(A, G, times){ 35 | d=nrow(A) 36 | Qinf<-fQinf(A,G) 37 | standardiser <- rep(sqrt(diag(Qinf)),each=d) / rep(sqrt(diag(Qinf)),times=d) 38 | dtAstd<-lapply(times, function(x) expm::expm(A*x) * standardiser) 39 | return(dtAstd) 40 | } 41 | 42 | fdtA <- function(A, times){ 43 | d=nrow(A) 44 | Astd<-lapply(times, function(x) expm::expm(A*x)) 45 | return(Astd) 46 | } 47 | 48 | 49 | fAstd2 <- function(A, G,Jstep=1e-3){ 50 | d=nrow(A) 51 | J <- diag(Inf,d) 52 | Qinf <- fQinf(A,G) 53 | for(i in 1:d){ 54 | for(j in 1:d){ 55 | # if(i!=j){ 56 | As <- A 57 | As[i,j] <- As[i,j] + Jstep*sign(As[i,j]) 58 | Qinfs <- fQinf(As,G) 59 | # J[i,j] <- (sum(diag(t(chol(Qinfs))))-sum(diag(t(chol(Qinf)))))/Jstep 60 | J[i,j] <- (sum(diag(t(chol(Qinfs))))-sum(diag(t(chol(Qinf)))))/Jstep 61 | # } 62 | } 63 | } 64 | return(J) 65 | } 66 | 67 | 68 | # A <- matrix(c(-1,.1,0,0,-1,.1,.1,0,-1),3,3) 69 | # G <- matrix(c(1,0,0, 0,2,0, 0,0,.1),3,3) 70 | # fQinf(A,G) 71 | # # fdtAstd(A,G,1) 72 | # A 73 | # G 74 | # fAstd(A,G) 75 | # fAstd2(A,G) 76 | # 77 | # 78 | # m <- matrix(c(2,0,0, 0,2,2, 0,2,2),3,3) 79 | # sum(diag(chol(m))) 80 | 81 | -------------------------------------------------------------------------------- /R/ctdataupdate.R: -------------------------------------------------------------------------------- 1 | ctdataupdate<-function(forcerecompile=FALSE){ 2 | 3 | message(paste0('Updating from ',(getwd()),', continue T / F?')) 4 | continue <- readline() 5 | if(continue){ 6 | set.seed(1) 7 | 8 | Tpoints=10 9 | n.manifest=2 10 | n.TDpred=1 11 | n.TIpred=3 12 | n.latent=2 13 | n.subjects=30 14 | gm<-ctModel(type='omx', Tpoints=Tpoints,n.latent=n.latent, 15 | n.TDpred=n.TDpred, 16 | n.TIpred=n.TIpred, 17 | n.manifest=n.manifest, 18 | MANIFESTVAR=diag(0.5,2), 19 | TIPREDEFFECT=matrix(c(.5,0,0,-.7,0,2),nrow=2), 20 | TIPREDVAR=matrix(c(1,-.2,0, 0,1,0, 0,0,.5),nrow=3), 21 | TDPREDVAR=matrix(0,nrow=n.TDpred*(Tpoints),ncol=n.TDpred*(Tpoints)), 22 | TDPREDMEANS=matrix(round(exp(rnorm(n.TDpred*(Tpoints),-1.9,1)),0), 23 | nrow=n.TDpred*(Tpoints)), 24 | TDPREDEFFECT = matrix(c(1,-1),ncol=1), 25 | LAMBDA=diag(1,2), 26 | DRIFT=matrix(c(-.3,.2,0,-.2),nrow=2), 27 | DIFFUSION=matrix(c(2,1,0,2),2), 28 | CINT=matrix(c(0,0),nrow=2), 29 | T0MEANS=matrix(10,ncol=1,nrow=2), 30 | T0VAR=diag(1,2)) 31 | 32 | ctstantestdat<-ctGenerate(gm,n.subjects=n.subjects,burnin=3,logdtsd=.4,dtmean = .3) 33 | 34 | ctstantestdat[2,'Y1'] <- NA 35 | ctstantestdat[ctstantestdat[,'id']==2,'TI1'] <- NA 36 | ctstantestdat[2,'TD1'] <- NA 37 | 38 | save(ctstantestdat,file='.\\data\\ctstantestdat.rda') 39 | 40 | ## now in zzz.R 41 | checkm<-ctModel( 42 | type='ct', 43 | n.latent=2,n.TDpred=1,n.TIpred=1,n.manifest=2, 44 | MANIFESTVAR=matrix(c('merror',0,0,'merror'),2,2), 45 | MANIFESTMEANS=0, 46 | DRIFT=c('dr1','dr12','dr21||||TI1','dr22'), 47 | DIFFUSION=c('diff11',0,'diff21','diff22||||TI1'), 48 | CINT=matrix(c('cint1||||TI1','cint2||||TI1'),ncol=1), 49 | LAMBDA=diag(2),tipredDefault=FALSE) 50 | 51 | ctstantestfit<-ctStanFit(ctstantestdat,checkm,cores=1,inits=0, 52 | optimize = TRUE,optimcontrol=list(finishsamples=20,stochastic=T,tol=1e-5),priors=TRUE) 53 | 54 | ctstantestfit <- ctStanGenerateFromFit(ctstantestfit,nsamples = 20,fullposterior = TRUE,cores=1) 55 | 56 | save(ctstantestfit,file='.\\data\\ctstantestfit.rda') 57 | 58 | paths <- sort(Sys.glob(c("data/ctstantestfit.rda","data/ctstantestdat.rda"))) # 59 | tools::resaveRdaFiles(paths) 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /R/ctsmupdate.R: -------------------------------------------------------------------------------- 1 | ctsmupdate<-function(usecurrentwd=FALSE,scat=FALSE){ 2 | 3 | sunspots<-datasets::sunspot.year 4 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 5 | id <- 1 6 | time <- 1749:1924 7 | datalong <- cbind(id, time, sunspots) 8 | 9 | #setup model 10 | model <- ctModel(type='ct', n.latent=2, n.manifest=1, 11 | manifestNames='sunspots', 12 | latentNames=c('ss_level', 'ss_velocity'), 13 | LAMBDA=matrix(c( 1, 'ma1' ), nrow=1, ncol=2), 14 | DRIFT=matrix(c(-.0001, 'a21', 1, 'a22'), nrow=2, ncol=2), 15 | MANIFESTMEANS=matrix(c('m1'), nrow=1, ncol=1), 16 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 17 | MANIFESTVAR=diag(.001,1), 18 | T0VAR=matrix(c(1,0,0,1), nrow=2, ncol=2), #Because single subject 19 | DIFFUSION=matrix(c(.0001, 0, 0, "diffusion"), ncol=2, nrow=2)) 20 | 21 | #fit 22 | 23 | sm <- ctStanFit(datalong, model,fit=FALSE,gendata=FALSE,forcerecompile=TRUE)$stanmodeltext 24 | #replace multiple empty lines with single empty lines 25 | sm <- gsub("\\n+", "\n", sm) 26 | 27 | if(scat) scat(sm) 28 | 29 | stanc(model_code = sm,verbose = TRUE) 30 | 31 | smgen <- ctStanFit(datalong, model,fit=FALSE,gendata=TRUE,forcerecompile=TRUE)$stanmodeltext 32 | smgen <- gsub("\\n+", "\n", smgen) 33 | stanc(model_code = smgen,verbose = TRUE) 34 | 35 | 36 | 37 | message(paste0('Update files? T / F?')) 38 | continue <- readline() 39 | if(continue){ 40 | pkgdir=ifelse(usecurrentwd, paste0(getwd()),'~/../sync/CT-SEM/ctsem') 41 | pathbase <- ifelse(usecurrentwd, paste0(getwd(),'/inst/stan'),'~/../sync/CT-SEM/ctsem/inst/stan') 42 | 43 | file.rename(file.path(pathbase,'ctsm.stan'), file.path(pathbase,'ctsm.bak')) 44 | file.rename(file.path(pathbase,'ctsmgen.stan'), file.path(pathbase,'ctsmgen.bak')) 45 | sink(file=file.path(pathbase,'ctsm.stan')) 46 | cat(sm) 47 | sink() 48 | sink(file=file.path(pathbase,'ctsmgen.stan')) 49 | cat(smgen) 50 | sink() 51 | 52 | message(paste0('Remove compiled files? T / F?')) 53 | continue <- readline() 54 | if(continue){ #delete all files in src folder and remove folder 55 | srcpath <- ifelse(usecurrentwd, paste0(getwd(),'/src'),'~/../sync/CT-SEM/ctsem/src') 56 | unlink(srcpath,recursive=TRUE) 57 | } 58 | 59 | # rstantools::rstan_config(pkgdir = pkgdir) 60 | } 61 | 62 | 63 | 64 | } 65 | -------------------------------------------------------------------------------- /R/databasedTIpreds.R: -------------------------------------------------------------------------------- 1 | databasedTIpreds <- function(dlong,manifestNames, TIpredNames = NA, order=2){ 2 | 3 | dat <- sapply(c('sd','mean'), function(f){ 4 | func <- eval(parse(text=f)) 5 | sapply(manifestNames, function(vari) { 6 | y<-cbind(sapply(unique(dlong[,'id']), function(idi){ 7 | x<-func(dlong[dlong[,'id'] %in% idi,vari],na.rm=TRUE) 8 | names(x) <- idi 9 | return(x) 10 | },simplify = TRUE)) 11 | colnames(y) <- paste0(vari,'_',f) 12 | return(y) 13 | },simplify = TRUE) 14 | },simplify = "array") 15 | 16 | 17 | dat2<-matrix(dat,nrow=dim(dat)[1]) 18 | colnames(dat2) <- paste0('z_',dimnames(dat)[[2]], '_',rep(dimnames(dat)[[3]],each=length(dimnames(dat)[[2]]))) 19 | if(!is.na(TIpredNames[1])) { 20 | scaledTI <-dlong[match(unique(dlong[,'id']),dlong[,'id']) ,TIpredNames,drop=FALSE] 21 | colnames(scaledTI) <- paste0('z_',colnames(scaledTI)) 22 | originalTI <- dlong[match(unique(dlong[,'id']),dlong[,'id']) ,TIpredNames,drop=FALSE] 23 | dat2 <- cbind(dat2,scaledTI) 24 | } 25 | 26 | if(order > 1){ 27 | for(oi in 2:order){ 28 | dat2o <- scale(dat2)^order #scale and center before powering to reduce colinearity 29 | colnames(dat2o) <- paste0(colnames(dat2),'^',order) 30 | dat2 <- cbind(dat2,dat2o) 31 | } 32 | } 33 | 34 | 35 | TIpredNames=colnames(dat2) 36 | id<-unique(dlong[,'id']) 37 | dat3 <- cbind(id,scale(dat2),originalTI) 38 | 39 | 40 | dat3<-merge(x = dlong[,!colnames(dlong) %in% TIpredNames], y=dat3) 41 | return(list(dat=dat3, TIpredNames=TIpredNames)) 42 | } 43 | 44 | 45 | -------------------------------------------------------------------------------- /R/extract.ctStanFit.R: -------------------------------------------------------------------------------- 1 | #' Extract samples from a ctStanFit object 2 | #' 3 | #' @param object ctStanFit object, samples may be from Stan's HMC, or the importance sampling approach of ctsem. 4 | #' @param subjectMatrices Calculate subject specific system matrices? 5 | #' @param cores Only used if subjectMatrices = TRUE . For faster computation use more cores. 6 | #' @param nsamples either 'all' or an integer denoting number of random samples to extract. 7 | #' @param subjects either 'all', or an integer vector denoting subjects to extract. 8 | #' @return Array of posterior samples. 9 | #' @aliases extract 10 | #' @examples 11 | #' \donttest{ 12 | #' e = ctExtract(ctstantestfit) 13 | #' } 14 | #' @export 15 | ctExtract <- function(object,subjectMatrices=FALSE,cores=2,nsamples='all', subjects='all'){ 16 | if(!class(object) %in% c('ctStanFit', 'stanfit')) stop('Not a ctStanFit or stanfit object') 17 | 18 | 19 | 20 | if(length(object$stanfit$stanfit@sim)==0){ 21 | samps <- object$stanfit$rawposterior 22 | if(!nsamples %in% 'all') samps <- samps[sample(1:nrow(samps),nsamples),,drop=FALSE] 23 | if(subjectMatrices && object$standata$savesubjectmatrices==0){ 24 | if(!'all' %in% subjects) object$standata<- standatact_specificsubjects(standata = object$standata,subjects = subjects) 25 | out = stan_constrainsamples(sm = object$stanmodel,standata = object$standata, 26 | samples = samps, 27 | cores = cores,savescores = FALSE,savesubjectmatrices = subjectMatrices, 28 | dokalman = TRUE,onlyfirstrow = FALSE) 29 | } else out <- object$stanfit$transformedpars 30 | } 31 | 32 | if(length(object$stanfit$stanfit@sim)>0){ 33 | if(subjectMatrices & object$standata$savesubjectmatrices!=1){ 34 | samps <- t(stan_unconstrainsamples(object$stanfit$stanfit,standata=object$standata)) 35 | if(!nsamples %in% 'all') samps <- samps[sample(1:nrow(samps),nsamples),,drop=FALSE] 36 | out = stan_constrainsamples(sm = object$stanmodel,standata = object$standata, 37 | samples = samps, 38 | cores = cores,savescores = FALSE,savesubjectmatrices = subjectMatrices) 39 | } else out <- rstan::extract(object$stanfit$stanfit) 40 | } 41 | 42 | out$Ygen[out$Ygen==99999] <- NA 43 | 44 | # if(!is.null(out$rawpopc)){ 45 | # out$rawpopcov <- array(out$rawpopc[,4,,],dim=dim(out$rawpopc)[-2]) 46 | # out$rawpopcorr <- array(out$rawpopc[,3,,],dim=dim(out$rawpopc)[-2]) 47 | # out$rawpopcovchol <- array(out$rawpopc[,2,,],dim=dim(out$rawpopc)[-2]) 48 | # out$rawpopcovbase <- array(out$rawpopc[,1,,],dim=dim(out$rawpopc)[-2]) 49 | # } 50 | 51 | return(out) 52 | } 53 | -------------------------------------------------------------------------------- /R/isdiag.R: -------------------------------------------------------------------------------- 1 | #' Diagnostics for ctsem importance sampling 2 | #' 3 | #' @param fit Output from ctStanFit when optimize=TRUE and isloops > 0 4 | #' 5 | #' @return Nothing. Plots convergence of parameter mean estimates from initial Hessian based distribution to final sampling distribution. 6 | #' @export 7 | #' 8 | #' @examples 9 | #' \donttest{ 10 | #' #get data 11 | #' sunspots<-sunspot.year 12 | #' sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 13 | #' id <- 1 14 | #' time <- 1749:1924 15 | #' datalong <- cbind(id, time, sunspots) 16 | #' 17 | #' #setup model 18 | #' model <- ctModel(type='ct', 19 | #' manifestNames='sunspots', 20 | #' latentNames=c('ss_level', 'ss_velocity'), 21 | #' LAMBDA=matrix(c( -1, 'ma1 | log(exp(-param)+1)' ), nrow=1, ncol=2), 22 | #' DRIFT=matrix(c(0, 'a21', 1, 'a22'), nrow=2, ncol=2), 23 | #' MANIFESTMEANS=matrix(c('m1 | (param)*5+44'), nrow=1, ncol=1), 24 | #' CINT=matrix(c(0, 0), nrow=2, ncol=1), 25 | #' T0VAR=matrix(c(1,0,0,1), nrow=2, ncol=2), #Because single subject 26 | #' DIFFUSION=matrix(c(0.0001, 0, 0, "diffusion"), ncol=2, nrow=2)) 27 | #' 28 | #' #fit and plot importance sampling diagnostic 29 | #' fit <- ctStanFit(datalong, model,verbose=0, 30 | #' optimcontrol=list(is=TRUE, finishsamples=500),priors=TRUE) 31 | #' isdiag(fit) 32 | #' } 33 | 34 | isdiag <- function(fit){ 35 | iter=length(fit$stanfit$isdiags$cov) 36 | mcov <- fit$stanfit$isdiags$cov 37 | samplecov <- cov(fit$stanfit$rawposterior) 38 | means <- simplify2array(fit$stanfit$isdiags$means) 39 | means <- (means - means[,ncol(means)]) 40 | means <- t(means / sqrt(diag(samplecov))) 41 | 42 | # smeans <- matrix(apply(means,2,function(x) x))),byrow=TRUE,ncol=iter) 43 | matplot(means,type='l',main='Mean convergence',xlab='Sampling loop',ylab=' Z divergence relative to finish',xlim=c(0,iter*1.2)) 44 | 45 | legend('topright',bty='n',legend = paste0('par',1:ncol(means)),lty = 1:5,col=1:6,text.col=1:6,cex = .7) 46 | 47 | sds <- simplify2array(mcov) 48 | sds <- apply(sds,3,function(x) sqrt(diag(x))) 49 | sds <- t((sds - sds[,iter]) / sqrt(diag(samplecov))) 50 | matplot(sds,type='l',main='SD convergence',xlab='Sampling loop',ylab='Z divergence relative to finish',xlim=c(0,iter*1.2)) 51 | 52 | legend('topright',bty='n',legend = paste0('par',1:ncol(means)),lty = 1:5,col=1:6,text.col=1:6,cex = .7) 53 | 54 | 55 | 56 | 57 | } 58 | -------------------------------------------------------------------------------- /R/listOfMatrices.R: -------------------------------------------------------------------------------- 1 | listOfMatrices <- function(df,matnames=NA){ 2 | mats <- unique(df$matrix) 3 | mlist <- list() 4 | for(mi in mats){ 5 | mlist[[mi]] <- matrix(NA, max(df$row[df$matrix %in% mi]), max(df$col[df$matrix %in% mi])) 6 | for(ci in 1:max(df$col[df$matrix %in% mi])){ 7 | for(ri in 1:max(df$row[df$matrix %in% mi])){ 8 | if(is.na(df$value[df$matrix %in% mi & df$row == ri & df$col==ci])) { 9 | mlist[[mi]][ri,ci] <- df$param[df$matrix %in% mi & df$row == ri & df$col==ci] 10 | } else { 11 | mlist[[mi]][ri,ci] <- df$value[df$matrix %in% mi & df$row == ri & df$col==ci] 12 | } 13 | } 14 | } 15 | } 16 | 17 | if(!is.na(matnames[1])){ 18 | for(mi in matnames){ 19 | if(is.null(mlist[[mi]])) mlist[[mi]] <- matrix(NA,0,0) 20 | } 21 | } 22 | return(mlist) 23 | } 24 | -------------------------------------------------------------------------------- /R/plothelpers.R: -------------------------------------------------------------------------------- 1 | plotdensity2dby2 <- function(x1,y1,x2=NA,y2=NA,xlab,ylab,title, 2 | grouplab=c('Observed','Model'), 3 | grouppch=c(20,19), 4 | colours=c('blue','red'), 5 | group1samples = 300, 6 | group2samples=50000,resolution=100){ 7 | 8 | if(1==99) Source <- ..density.. <- ..level.. <- ..b <- y <- x <- ..ndensity.. <- ..nlevel.. <- NULL 9 | #remove missings 10 | 11 | nomiss <- intersect(which(!is.na(x1)),which(!is.na(y1))) 12 | y1 <- y1[nomiss] 13 | x1 <- x1[nomiss] 14 | 15 | 16 | 17 | if(length(y1) > group1samples) { 18 | datasample <- sample(1:length(y1),group1samples) 19 | y1 <- y1[datasample] 20 | x1 <- x1[datasample] 21 | } 22 | 23 | pd <- data.table(Source=grouplab[1], 24 | x=x1, 25 | y=y1) 26 | 27 | if(any(!is.na(x2))){ 28 | nomiss <- intersect(which(!is.na(x2)),which(!is.na(y2))) 29 | y2 <- y2[nomiss] 30 | x2 <- x2[nomiss] 31 | 32 | if(length(y2) > group2samples) { 33 | datasample <- sample(1:length(y2),group2samples) 34 | y2 <- y2[datasample] 35 | x2 <- x2[datasample] 36 | } 37 | 38 | 39 | pd <- rbind(pd,data.table(Source=grouplab[2], 40 | x=x2, 41 | y=y2)) 42 | } 43 | 44 | lims <- lapply(c('x','y'),function(b) sapply(grouplab,function (a) quantile(pd[Source==a,..b],c(.05,.95),na.rm=TRUE))) 45 | names(lims) <- c('x','y') 46 | lims <- lapply(lims, function(x) c(min(x[1,]),max(x[2,]))) 47 | lims <- lapply(lims,function(x) x + c(-1,1) *sd(x)/10) 48 | 49 | 50 | 51 | # pd$xd <- as.numeric(cut_width(pd$x, diff(range(pd$x))/30)) 52 | 53 | g<-ggplot(data=pd,aes(y=y,x=x,shape=Source,colour=Source)) 54 | 55 | if(all(!is.na(x2))) g <- g+ stat_density_2d(data = subset(pd, Source==grouplab[2]), 56 | geom="raster",interpolate=TRUE, 57 | aes(alpha=..ndensity..,fill = ..ndensity..), 58 | show.legend = FALSE, contour = FALSE,n = resolution, 59 | h=c(MASS::bandwidth.nrd(subset(pd, Source==grouplab[2])$x)*1.5, 60 | MASS::bandwidth.nrd(subset(pd, Source==grouplab[2])$y)*1.5) 61 | ) + 62 | scale_fill_gradient (low = "white", high = colours[2],guide='none') 63 | 64 | g <- g+ 65 | stat_density_2d(data = subset(pd, Source==grouplab[1]), 66 | aes(alpha=..nlevel..),linetype='dotted',show.legend = FALSE, contour = TRUE, 67 | h=c(MASS::bandwidth.nrd(subset(pd, Source==grouplab[1])$x)*1.5, 68 | MASS::bandwidth.nrd(subset(pd, Source==grouplab[1])$y)*1.5)) + 69 | coord_cartesian(xlim = lims$x, ylim = lims$y) + 70 | geom_point(data = subset(pd, Source==grouplab[1]),show.legend = TRUE) + 71 | labs(x=xlab,y=ylab,title = title, color = "Source", shape = "Source")+ 72 | theme_minimal() + 73 | scale_alpha(guide = 'none') + 74 | scale_colour_manual(values=setNames(colours, grouplab))+ 75 | scale_shape_manual(values=setNames(grouppch,grouplab)) + 76 | theme(legend.title = element_blank()) 77 | 78 | } 79 | -------------------------------------------------------------------------------- /R/priorcheck.R: -------------------------------------------------------------------------------- 1 | priorchecker <- function(sf,pars=c('rawpopmeans','rawpopsdbase','tipredeffectparams'),digits=2){ 2 | e=ctExtract(sf) 3 | funcs <- c(base::mean,stats::sd) 4 | pars=unlist(lapply(pars,function(x) if(!is.null(dim(e[[x]]))) x)) 5 | out=round(do.call(cbind,lapply(funcs, function(fn) do.call(c, 6 | lapply(pars, function(obji) apply(e[[obji]],2,fn,na.rm=TRUE)) ))),digits) 7 | rownames(out)=do.call(c,c(lapply(pars, function(obji) paste0(obji,'_',1:ncol(e[[obji]]))))) 8 | out=data.frame(out,do.call(c,c(lapply(pars, function(obji) 1:ncol(e[[obji]]))))) 9 | out=data.frame(out,do.call(c,c(lapply(pars, function(obji) rep(obji, ncol(e[[obji]]))))),stringsAsFactors = FALSE) 10 | colnames(out)=c('mean','sd', 'param', 'object') 11 | rownames(out) = getparnamesfromraw(priorcheck=out,sf=sf) 12 | return(out) 13 | } 14 | 15 | getparnamesfromraw <- function(priorcheck, sf){ 16 | newnames=rownames(priorcheck) 17 | for(ni in 1:nrow(priorcheck)){ 18 | if(priorcheck$object[ni] %in% 'rawpopmeans'){ 19 | newnames[ni]=paste0('rawpop_',sf$setup$popsetup$parname[sf$setup$popsetup$param %in% priorcheck$param[ni]][1]) 20 | } 21 | if(priorcheck$object[ni] %in% 'tipredeffectparams'){ 22 | newnames[ni]=paste0('rawtipredeffect_',paste0( 23 | which(sf$standata$TIPREDEFFECTsetup == priorcheck$param[ni],arr.ind = TRUE),collapse='_')) 24 | } 25 | } 26 | return(newnames) 27 | } 28 | 29 | priorcheckreport <- function(sf, meanlim = 2, sdlim= .2,digits=2){ 30 | p=priorchecker(sf) 31 | ps=sf$setup$popsetup 32 | p=p[abs(p$mean) > meanlim | p$sd > sdlim,] 33 | out<-list(priorcheck_note='The following posteriors exceeded arbitrary limits re normal(0,1) -- priors / transforms are likely somewhat informative. Not necessarily a problem.') 34 | out$priorcheck=p[,c('mean','sd')] 35 | 36 | # if(any(p$object %in% 'rawpopsdbase')){ 37 | # e=apply(ctExtract(sf,pars='rawpopsdprops')$rawpopsdprops,2,mean,na.rm=TRUE) 38 | # names(e) = ps$parname[match(x = 1:length(e),ps$param)] 39 | # e=e[e> 1/length(e) | e==max(e)] 40 | # out$priorcheck_sd_note = 'Population posterior variance exceeded check limits. Not necessarily a problem, but these parameters contribute most variance: ' 41 | # out$priorcheck_sd = round(e,digits) 42 | # } 43 | return(out) 44 | } 45 | 46 | -------------------------------------------------------------------------------- /R/sdpcor2cov.R: -------------------------------------------------------------------------------- 1 | #' sdcor2cov 2 | #' 3 | #' Converts a lower triangular matrix with standard deviations on the diagonal and partial correlations on 4 | #' lower triangle, to a covariance (or cholesky decomposed covariance) 5 | #' @param mat input square matrix with std dev on diagonal and lower tri of partial correlations. 6 | #' @param coronly if TRUE, ignores everything except the lower triangle and outputs correlation. 7 | #' @param cholesky Logical. To return the cholesky decomposition instead of full covariance, set to TRUE. 8 | #' @examples 9 | #' testmat <- diag(exp(rnorm(5,-3,2)),5) #generate arbitrary std deviations 10 | #' testmat[row(testmat) > col(testmat)] <- runif((5^2-5)/2, -1, 1) 11 | #' print(testmat) 12 | #' covmat <- sdpcor2cov(testmat) #convert to covariance 13 | #' cov2cor(covmat) #convert covariance to correlation 14 | #' @export 15 | sdpcor2cov <- function(mat, coronly=FALSE, cholesky=FALSE){ 16 | 17 | ndim = ncol(mat); 18 | mcholcor=diag(0,ndim); 19 | mcholcor[1,1]=1; 20 | 21 | if(ndim > 1){ 22 | for(coli in 1:ndim){ 23 | for(rowi in coli:ndim){ 24 | if(coli==1 && rowi > 1) mcholcor[rowi,coli] = mat[rowi,coli]; 25 | if(coli > 1){ 26 | if(rowi == coli) mcholcor[rowi,coli] = prod(sqrt(1-mat[rowi,1:(coli-1)]^2)); 27 | if(rowi > coli) mcholcor[rowi,coli] = mat[rowi,coli] * prod(sqrt(1-mat[rowi,1:(coli-1)]^2)); 28 | } 29 | } 30 | } 31 | } 32 | 33 | if(!coronly){ 34 | mscale=diag(diag(mat)) 35 | out= mscale %*% mcholcor 36 | } else out = mcholcor 37 | if(!cholesky) out = out %*% t(out) 38 | return(out); 39 | } 40 | 41 | -------------------------------------------------------------------------------- /R/stan_confidenceRegion.R: -------------------------------------------------------------------------------- 1 | 2 | # stan_confidenceRegion <-function(stanfit,parstrings,prefuncstring='(', joinfuncstring=' + ',postfuncstring=')'){ 3 | # mc=As.mcmc.list(stanfit) 4 | # mc=do.call(rbind,mc) 5 | # 6 | # pars <- lapply(parstrings,function(x) paste0(colnames(mc)[grep(x,colnames(mc),fixed=TRUE)])) 7 | # parsref <- lapply(parstrings,function(x) paste0('mc[,"',colnames(mc)[grep(x,colnames(mc),fixed=TRUE)],'"]')) 8 | # 9 | # # if(length(parstrings) > 1 & matchingindices==TRUE & !all(lapply(pars,length)==length(pars[[1]]))) stop ('matchingindices=TRUE but unequal numbers of parameters found matching parstrings') 10 | # 11 | # for(pari in 1:length(pars[[1]])){ 12 | # a <- cbind(eval(parse(text=paste0(prefuncstring, paste0(lapply(parsref,function(x) x[pari]),collapse=joinfuncstring),postfuncstring)))) 13 | # colnames(a) <- paste0(prefuncstring, paste0(lapply(pars,function(x) x[pari]),collapse=joinfuncstring),postfuncstring) 14 | # if(pari==1) out<-a else out <- cbind(out,a) 15 | # } 16 | # 17 | # return(out) 18 | # } 19 | -------------------------------------------------------------------------------- /R/stan_postcalc.R: -------------------------------------------------------------------------------- 1 | # #' Compute functions of matrices from samples of a stanfit object 2 | # #' 3 | # #' @param stanfit object of class stanfit. 4 | # #' @param object name of stan sub object from stanfit to use for calculations. 5 | # #' @param objectindices matrix of indices, with the number of columns matching 6 | # #' the number of dimensions of the object. 'all' computes \code{which( array(1,objdims)==1,arr.ind=TRUE)}, 7 | # #' where objdims is what would be returned by dim(object) if the object existed in the R environment. 8 | # #' @param calc string containing R calculation to evaluate, with the string 'object' in place of the actual object name. 9 | # #' @param summary if FALSE, a iterations * parameters matrix is returned, if TRUE, 10 | # #' rstan::monitor is first run on the output. 11 | # #' 12 | # #' @return matrix of values of the specified interactions at each iteration. 13 | # stan_postcalc <-function(stanfit,object,calc='object', objectindices='all', summary=TRUE){ 14 | # mc=As.mcmc.list(stanfit) 15 | # m=do.call(rbind,mc) 16 | # outdims = dim(stanfit@inits[[1]][[object]]) #complete 17 | # if(objectindices=='all') objectindices <- which( array(1,outdims)==1,arr.ind=TRUE) else { 18 | # if(ncol(as.matrix(objectindices))!= length(outdims)) stop('Number of columns of object indices must match number of dimensions in object') 19 | # } 20 | # objectindices = objectindices[,outdims!=1] #subset 21 | # outdims = outdims[outdims!=1] #subset 22 | # 23 | # out=array(apply(m,1,function(x) { 24 | # object = array(array(relist(x,skeleton = stanfit@inits[[1]])[[object]],dim=outdims)[objectindices],outdims) 25 | # ret = eval(parse(text=calc)) 26 | # } ),dim = c(outdims,nrow(m)) ) 27 | # 28 | # if(summary) { 29 | # parnames <- array(1,dim=outdims) 30 | # parnames <- which(parnames==1,arr.ind = TRUE) 31 | # parnames <- apply(parnames,1,function(x) paste0(x, collapse=', ')) 32 | # parnames <- paste0(object,'[',parnames,']') 33 | # out <- array(out,dim=c(prod(outdims), nrow(mc[[1]]), length(mc))) 34 | # 35 | # out <- aperm(out,c(2,3,1)) 36 | # dimnames(out)[[3]] <- parnames 37 | # out <- monitor(out,warmup=0,digits_summary = 2) 38 | # } 39 | # 40 | # return(out) 41 | # } 42 | 43 | -------------------------------------------------------------------------------- /R/stan_unconstrainsamples.R: -------------------------------------------------------------------------------- 1 | #' Convert samples from a stanfit object to the unconstrained scale 2 | #' 3 | #' @param fit stanfit object. 4 | #' @param standata only necessary if R session has been restarted since fitting model -- used to reinitialize 5 | #' stanfit object. 6 | #' 7 | #' @return Matrix containing columns of unconstrained parameters for each post-warmup iteration. 8 | #' @export 9 | #' 10 | #' @examples 11 | #' \donttest{ 12 | #' #get data 13 | #' sunspots<-sunspot.year 14 | #' sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 15 | #' id <- 1 16 | #' time <- 1749:1924 17 | #' datalong <- cbind(id, time, sunspots) 18 | #' 19 | #' #setup model 20 | #' ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 21 | #' manifestNames='sunspots', 22 | #' latentNames=c('ss_level', 'ss_velocity'), 23 | #' LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 24 | #' DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 25 | #' MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 26 | #' MANIFESTVAR=diag(0,1), #As per original spec 27 | #' CINT=matrix(c(0, 0), nrow=2, ncol=1), 28 | #' DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 29 | #' 30 | #' #fit 31 | #' ssfit <- ctStanFit(datalong, ssmodel, 32 | #' iter=200, chains=2,optimize=FALSE, priors=TRUE,control=list(max_treedepth=4)) 33 | #' umat <- stan_unconstrainsamples(ssfit$stanfit$stanfit) 34 | #' } 35 | stan_unconstrainsamples <- function(fit, standata=NA){ 36 | if(!'stanfit' %in% class(fit)) stop('not a stanfit object') 37 | npars <- try(get_num_upars(fit),silent=TRUE) #$stanmodel) 38 | 39 | if(class(npars)[1]=='try-error'){ #in case R has been restarted or similar 40 | if(any(!is.na(standata))){ 41 | newfit <- stan_reinitsf(fit@stanmodel,standata) 42 | } 43 | else stop('stanfit object must be reinitialized but no data is provided') 44 | } else newfit <- fit #no need for reinit 45 | 46 | cmat=as.matrix(fit) 47 | # clist=apply(cmat,1,function(x) relist(flesh = x,skeleton = fit@inits[[1]])) 48 | 49 | if(is.null(names(fit@inits[[1]]))) skel = fit@inits else skel=fit@inits[[1]] 50 | clist=apply(cmat,1,function(x) relistarrays(flesh=x,skeleton=skel)) 51 | 52 | ulist=matrix(unlist(lapply(clist,function(x) unconstrain_pars(newfit,x))),ncol=length(clist)) 53 | return(ulist) 54 | } 55 | -------------------------------------------------------------------------------- /R/stanmodels.R: -------------------------------------------------------------------------------- 1 | # Generated by rstantools. Do not edit by hand. 2 | 3 | # names of stan models 4 | stanmodels <- c("cov", "ctsm", "ctsmgen") 5 | 6 | # load each stan module 7 | Rcpp::loadModule("stan_fit4cov_mod", what = TRUE) 8 | Rcpp::loadModule("stan_fit4ctsm_mod", what = TRUE) 9 | Rcpp::loadModule("stan_fit4ctsmgen_mod", what = TRUE) 10 | 11 | # instantiate each stanmodel object 12 | stanmodels <- sapply(stanmodels, function(model_name) { 13 | # create C++ code for stan model 14 | stan_file <- if(dir.exists("stan")) "stan" else file.path("inst", "stan") 15 | stan_file <- file.path(stan_file, paste0(model_name, ".stan")) 16 | stanfit <- rstan::stanc_builder(stan_file, 17 | allow_undefined = TRUE, 18 | obfuscate_model_name = FALSE) 19 | stanfit$model_cpp <- list(model_cppname = stanfit$model_name, 20 | model_cppcode = stanfit$cppcode) 21 | # create stanmodel object 22 | methods::new(Class = "stanmodel", 23 | model_name = stanfit$model_name, 24 | model_code = stanfit$model_code, 25 | model_cpp = stanfit$model_cpp, 26 | mk_cppmodule = function(x) get(paste0("rstantools_model_", model_name))) 27 | }) 28 | -------------------------------------------------------------------------------- /R/tformshapes.R: -------------------------------------------------------------------------------- 1 | tformshapes <- function(singletext=FALSE,transform=NA,jacobian=FALSE, 2 | driftdiag=FALSE, parname='param',stan=FALSE){ 3 | out = c('param', 4 | '(log1p_exp(param))', 5 | '(exp(param))', 6 | '(1/(1+exp(-param)))', 7 | '((param)^3)', 8 | 'log1p(param)', #why is this here? results in NA's / warnings. 9 | 'meanscale', 10 | '1/(1+exp(-param))', 11 | 'exp(param)', 12 | '1/(1+exp(-param))-(exp(param)^2)/(1+exp(param))^2', 13 | '3*param^2', 14 | '1/(1+param)') 15 | 16 | tfvec=c(0:5,50:55) 17 | 18 | if(stan){ 19 | tfvec=tfvec[-1] 20 | out=out[-1] 21 | } 22 | 23 | out=gsub('param',parname,out,fixed=TRUE) 24 | 25 | if(!is.na(transform)&&transform!=0) out = out[tfvec == transform] 26 | if(!singletext) { 27 | out = paste0('if(transform==', tfvec,') param = ',out,';\n',collapse='') 28 | 29 | if(!stan) out <- paste0('param = parin * meanscale + inneroffset; \n ',out,' 30 | param=param*multiplier; 31 | if(transform < 49) param = param+offset;') 32 | if(stan) out <- paste0('if(meanscale!=1.0) param *= meanscale; 33 | if(inneroffset != 0.0) param += inneroffset; \n',out,' 34 | if(multiplier != 1.0) param *=multiplier; 35 | if(transform < 49 && offset != 0.0) param+=offset;') 36 | } 37 | if(singletext) out <- paste0('offset + multiplier*',gsub('param','(param*meanscale+inneroffset)',out)) 38 | 39 | out=gsub(' ','',out,fixed=TRUE) 40 | return(out) 41 | } 42 | 43 | tform <- function(parin, transform, multiplier, meanscale, offset, inneroffset, extratforms='',singletext=FALSE,jacobian=FALSE,driftdiag=FALSE){ 44 | param=parin 45 | if(!is.na(suppressWarnings(as.integer(transform)))) { 46 | out <- tformshapes(singletext=singletext,transform=as.integer(transform))#,jacobian=jacobian) 47 | if(!singletext) paste0(out,extratforms) 48 | if(singletext) { 49 | for(i in c('param','multiplier', 'meanscale', 'inneroffset','offset')){ 50 | irep = get(i) 51 | out <- gsub(pattern = i,replacement = irep,out) 52 | } 53 | } 54 | } 55 | # if(jacobian) transform <- transform + ifelse(driftdiag,60,50) 56 | if(is.na(suppressWarnings(as.integer(transform)))) out <- transform 57 | if(!singletext) out <- eval(parse(text=out)) 58 | return(out) 59 | } 60 | 61 | # Jtformshapes <- function(){ 62 | # fn=sapply(tformshapes(singletext = TRUE),function(x) Simplify(x)) 63 | # names(fn)=paste0('fn',1:length(fn)) 64 | # jacobianSymb(fn,variables = c('param')) 65 | # } 66 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | # Generated by rstantools. Do not edit by hand. 4 | "${R_HOME}/bin/Rscript" -e "rstantools::rstan_config()" 5 | -------------------------------------------------------------------------------- /configure.win: -------------------------------------------------------------------------------- 1 | # Generated by rstantools. Do not edit by hand. 2 | 3 | #! /bin/sh 4 | "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "rstantools::rstan_config()" 5 | # echo "PKG_CXXFLAGS += --param ggc-min-expand=10" >> src/Makevars.win 6 | -------------------------------------------------------------------------------- /ctsem.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | 17 | BuildType: Package 18 | PackageUseDevtools: Yes 19 | PackageInstallArgs: --with-keep.source --no-multiarch 20 | PackageBuildArgs: --compact-vignettes=both 21 | PackageCheckArgs: --as-cran --compact-vignettes=both 22 | PackageRoxygenize: rd,collate,namespace 23 | 24 | QuitChildProcessesOnExit: Yes 25 | -------------------------------------------------------------------------------- /data/AnomAuth.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/AnomAuth.rda -------------------------------------------------------------------------------- /data/Oscillating.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/Oscillating.rda -------------------------------------------------------------------------------- /data/ctExample1.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctExample1.rda -------------------------------------------------------------------------------- /data/ctExample1TIpred.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctExample1TIpred.rda -------------------------------------------------------------------------------- /data/ctExample2.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctExample2.rda -------------------------------------------------------------------------------- /data/ctExample3.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctExample3.rda -------------------------------------------------------------------------------- /data/ctExample4.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctExample4.rda -------------------------------------------------------------------------------- /data/ctstantestdat.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctstantestdat.rda -------------------------------------------------------------------------------- /data/ctstantestfit.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/ctstantestfit.rda -------------------------------------------------------------------------------- /data/datastructure.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/datastructure.rda -------------------------------------------------------------------------------- /data/longexample.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/data/longexample.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry(bibtype = "Article", 2 | title = "Hierarchical {{Bayesian}} continuous time dynamic modeling.", 3 | author = c(person(given = c("Charles", "C."), 4 | family = "Driver"), 5 | person(given = c("Manuel", "C."), 6 | family = "Voelkle")), 7 | journal = "Psychological Methods", 8 | year = "2018", 9 | volume = "23", 10 | number = "4", 11 | pages = "774-799", 12 | doi = "10.1037/met0000168", 13 | header = "To cite the current, hierarchical ctsem use:", 14 | ) 15 | 16 | 17 | bibentry(bibtype = "Article", 18 | title = "Continuous Time Structural Equation Modeling with {R} package {ctsem}", 19 | author = c(person(given = c("Charles", "C."), 20 | family = "Driver"), 21 | person(given = c("Johan", "H.", "L."), 22 | family = "Oud"), 23 | person(given = c("Manuel", "C."), 24 | family = "Voelkle")), 25 | journal = "Journal of Statistical Software", 26 | year = "2017", 27 | volume = "77", 28 | number = "5", 29 | pages = "1--35", 30 | doi = "10.18637/jss.v077.i05", 31 | header = "To cite the original ctsem use:", 32 | ) 33 | 34 | bibentry( 35 | bibtype = "incollection", 36 | title = "Hierarchical continuous time modeling", 37 | editor = "John F. Rauthmann", 38 | booktitle = "The Handbook of Personality Dynamics and Processes", 39 | publisher = "Academic Press", 40 | pages = "887-908", 41 | year = 2021, 42 | isbn = "978-0-12-813995-0", 43 | doi = "10.1016/B978-0-12-813995-0.00034-0", 44 | author = c("Charles C. Driver", "Manuel C. Voelkle"), 45 | header = "To cite the current manual use:", 46 | ) 47 | -------------------------------------------------------------------------------- /inst/include/stan_meta_header.hpp: -------------------------------------------------------------------------------- 1 | // Insert all #include statements here 2 | -------------------------------------------------------------------------------- /inst/stan/cov.stan: -------------------------------------------------------------------------------- 1 | functions{ 2 | 3 | matrix constraincorsqrt(matrix rawcor) { 4 | int d = rows(rawcor); 5 | matrix[d, d] mcholcor = rep_matrix(0, d, d); 6 | mcholcor[1, 1] = 1; 7 | if (d > 1) { 8 | for (coli in 1:d) { 9 | for (rowi in coli:d) { 10 | if (coli == 1 && rowi > 1) mcholcor[rowi, coli] = rawcor[rowi, coli]; 11 | if (coli > 1) { 12 | if (rowi == coli) mcholcor[rowi, coli] = prod(sqrt(1 - rawcor[rowi, 1:(coli - 1)]^2)); 13 | if (rowi > coli) mcholcor[rowi, coli] = rawcor[rowi, coli] * prod(sqrt(1 - rawcor[rowi, 1:(coli - 1)]^2)); 14 | } 15 | } 16 | } 17 | } 18 | return mcholcor; 19 | } 20 | 21 | 22 | } 23 | data{ 24 | int d; 25 | int n; 26 | matrix[n,d] dat; 27 | array[n,d] int obs; 28 | array[n] int nobs; 29 | real reg; 30 | int corpriortype; 31 | int indep; 32 | } 33 | parameters{ 34 | vector[d] mu; 35 | vector[d] logsd; 36 | vector[indep ? 0 : (d * d - d) %/% 2] rawcor; 37 | } 38 | transformed parameters{ 39 | matrix[d, d] mcor = diag_matrix(rep_vector(1,d)); 40 | matrix[d, d] mcorbase = rep_matrix(0, d, d); 41 | matrix[d,d] covm; 42 | matrix[d,d] cholm; 43 | //matrix[d,d] cholm = cholesky_decompose(covm); 44 | real corprior=0; 45 | real sdprior = normal_lpdf(logsd | mean(logsd), 10); 46 | vector[n] llrow=rep_vector(0,n); 47 | 48 | if(!indep){ 49 | int counter=0; 50 | for(i in 1:d){ 51 | for(j in 1:d){ 52 | if(i > j){ 53 | counter+=1; 54 | mcorbase[i,j]=inv_logit(rawcor[counter])*2-1; 55 | } 56 | } 57 | } 58 | //print(mcorbase); 59 | 60 | mcor=tcrossprod(constraincorsqrt(mcorbase)); 61 | //print(mcor); 62 | if(reg != 0){ 63 | if(corpriortype==1) corprior=normal_lpdf(rawcor| 0, 1); //mean(abs(rawcor)) 64 | if(corpriortype==2) corprior= normal_lpdf(to_vector(mcor) | 0, 1); 65 | if(corpriortype==3) corprior= normal_lpdf(to_vector(eigenvalues_sym(mcor)) | 0, 1); 66 | } 67 | } 68 | 69 | covm = quad_form_diag(mcor, log1p_exp(logsd)); 70 | cholm = cholesky_decompose(covm); 71 | 72 | for(i in 1:n){ 73 | if(nobs[i]>0){ 74 | llrow[i]= multi_normal_lpdf(dat[i,obs[i,1:nobs[i]]] | mu[obs[i,1:nobs[i]]], 75 | covm[obs[i,1:nobs[i]], obs[i,1:nobs[i]]]); 76 | } 77 | } 78 | } 79 | model{ 80 | target += sum(llrow); 81 | if(reg!=0) target+= reg*corprior + reg*sdprior; 82 | } 83 | -------------------------------------------------------------------------------- /inst/stan/include/license.stan: -------------------------------------------------------------------------------- 1 | /* 2 | ctsem is free software: you can redistribute it and/or modify 3 | it under the terms of the GNU General Public License as published by 4 | the Free Software Foundation, either version 3 of the License, or 5 | (at your option) any later version. 6 | 7 | ctsem is distributed in the hope that it will be useful, 8 | but WITHOUT ANY WARRANTY; without even the implied warranty of 9 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 10 | GNU General Public License for more details. 11 | 12 | You should have received a copy of the GNU General Public License 13 | along with ctsem. If not, see . 14 | */ 15 | -------------------------------------------------------------------------------- /man/AnomAuth.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{AnomAuth} 4 | \alias{AnomAuth} 5 | \title{AnomAuth} 6 | \format{ 7 | data frame with 2722 rows, 14 columns. Column Y1 represents anomia, 8 | Y2 Authoritarianism, dTx the time interval for measurement occasion x. 9 | } 10 | \source{ 11 | See \doi{10.1037/a0027543} for details. 12 | } 13 | \description{ 14 | A dataset containing panel data assessments of individuals Anomia and Authoritarianism. 15 | } 16 | -------------------------------------------------------------------------------- /man/Oscillating.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{Oscillating} 4 | \alias{Oscillating} 5 | \title{Oscillating} 6 | \format{ 7 | 200 by 21 matrix containing containing ctsem wide format data. 8 | 11 measurement occasions and 10 measurement intervals for each of 200 individuals 9 | } 10 | \source{ 11 | See \url{https://bpspsychub.onlinelibrary.wiley.com/doi/10.1111/j.2044-8317.2012.02043.x} 12 | } 13 | \description{ 14 | Simulated example dataset for the ctsem package. 15 | } 16 | -------------------------------------------------------------------------------- /man/ctACF.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctACF.R 3 | \name{ctACF} 4 | \alias{ctACF} 5 | \title{Continuous Time Autocorrelation Function (ctACF)} 6 | \usage{ 7 | ctACF( 8 | dat, 9 | varnames = "auto", 10 | ccfnames = "all", 11 | idcol = "id", 12 | timecol = "time", 13 | plot = TRUE, 14 | timestep = "auto", 15 | time.max = "auto", 16 | nboot = 100, 17 | scale = FALSE, 18 | center = FALSE, 19 | ... 20 | ) 21 | } 22 | \arguments{ 23 | \item{dat}{The input data in data frame or data table format.} 24 | 25 | \item{varnames}{Character vector of variable names in the data to compute the ACF for. 'auto' uses all columns that are not time / id.} 26 | 27 | \item{ccfnames}{Character vector of variable names in the data to compute cross correlation for. 'all' uses all variables in varnames, NA uses none.} 28 | 29 | \item{idcol}{The name of the column containing subject IDs (default is 'id').} 30 | 31 | \item{timecol}{The name of the column containing time values (default is 'time').} 32 | 33 | \item{plot}{A logical value indicating whether to create a plot (default is TRUE).} 34 | 35 | \item{timestep}{The time step for discretizing data. 'auto' to automatically determine 36 | the timestep based on data distribution (default is 'auto'). 37 | In this case the timestep is computed as half of the median for time intervals in the data.} 38 | 39 | \item{time.max}{The maximum time lag to compute the ACF (default is 10). If 'auto', is set to 10 times the 90th percentile interval in the data.} 40 | 41 | \item{nboot}{The number of bootstrap samples for confidence interva1l estimation (default is 100).} 42 | 43 | \item{scale}{if TRUE, scale variables based on within-subject standard deviation.} 44 | 45 | \item{center}{if TRUE, center variables based on within-subject mean.} 46 | 47 | \item{...}{additional arguments (such as demean=FALSE) to pass to the \code{stats::acf} function.} 48 | } 49 | \value{ 50 | If 'plot' is TRUE, the function returns a ggplot object of the ACF plot. If 'plot' is 51 | FALSE, it returns a data table with ACF estimates and confidence intervals. 52 | } 53 | \description{ 54 | This function computes an approximate continuous time autocorrelation function (ACF) for data 55 | containing multiple subjects and/or variables. 56 | } 57 | \details{ 58 | This function computes the continuous time ACF by discretizing the data and then 59 | performing bootstrapped ACF calculations to estimate the confidence intervals. It can create 60 | ACF plots with confidence intervals if 'plot' is set to TRUE. 61 | } 62 | \examples{ 63 | data.table::setDTthreads(1) #ignore this line 64 | # Example usage: 65 | head(ctstantestdat) 66 | ctACF(ctstantestdat,varnames=c('Y1'),idcol='id',timecol='time',nboot=5) 67 | 68 | } 69 | \seealso{ 70 | \code{\link{ctDiscretiseData}} 71 | } 72 | -------------------------------------------------------------------------------- /man/ctACFresiduals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctACF.R 3 | \name{ctACFresiduals} 4 | \alias{ctACFresiduals} 5 | \title{Calculate Continuous Time Autocorrelation Function (ACF) for Standardized Residuals of ctsem fit.} 6 | \usage{ 7 | ctACFresiduals(fit, ...) 8 | } 9 | \arguments{ 10 | \item{fit}{A fitted model object generated by the ctsem package.} 11 | 12 | \item{...}{Additional arguments to be passed to the \code{\link{ctACF}} function.} 13 | } 14 | \value{ 15 | A data table containing the continuous time ACF estimates for standardized residuals. 16 | } 17 | \description{ 18 | This function takes a fit object from ctsem and computes the continuous time autocorrelation 19 | function (ACF) on the standardized residuals. 20 | } 21 | \details{ 22 | This function first extracts the standardized residuals from the fit object using 23 | the \code{\link{ctStanKalman}} function. Then, it calculates the continuous time ACF for these residuals 24 | and returns the results as a data table. 25 | } 26 | \examples{ 27 | data.table::setDTthreads(1) #ignore this line 28 | # Example usage: 29 | ctACFresiduals(ctstantestfit, varnames='Y1',nboot=5) 30 | 31 | } 32 | \seealso{ 33 | \code{\link{ctStanKalman}} 34 | } 35 | -------------------------------------------------------------------------------- /man/ctAddSamples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stanoptimis.R 3 | \name{ctAddSamples} 4 | \alias{ctAddSamples} 5 | \title{Sample more values from an optimized ctstanfit object} 6 | \usage{ 7 | ctAddSamples(fit, nsamples, cores = 2) 8 | } 9 | \arguments{ 10 | \item{fit}{fit object} 11 | 12 | \item{nsamples}{number of samples desired} 13 | 14 | \item{cores}{number of cores to use} 15 | } 16 | \value{ 17 | fit object with extra samples 18 | } 19 | \description{ 20 | Sample more values from an optimized ctstanfit object 21 | } 22 | \examples{ 23 | \dontrun{ 24 | newfit <- ctAddSamples(ctstantestfit, 10, 1) 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /man/ctChisqTest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctCompare.R 3 | \name{ctChisqTest} 4 | \alias{ctChisqTest} 5 | \title{Chi Square test wrapper for ctStanFit objects.} 6 | \usage{ 7 | ctChisqTest(fit1, fit2) 8 | } 9 | \arguments{ 10 | \item{fit1}{One of the fits to be compared (better fit is assumed as base for comparison)} 11 | 12 | \item{fit2}{Second fit to be compared} 13 | } 14 | \value{ 15 | Numeric probability 16 | } 17 | \description{ 18 | Chi Square test wrapper for ctStanFit objects. 19 | } 20 | \examples{ 21 | \donttest{ 22 | df <- data.frame(id=1, time=1:length(sunspot.year), Y1=sunspot.year) 23 | 24 | m1 <- ctModel(type='dt', LAMBDA=diag(1),MANIFESTVAR=0) 25 | m2 <- ctModel(type='dt', LAMBDA=diag(1),MANIFESTVAR=0,DRIFT = .9) 26 | 27 | f1 <- ctStanFit(df,m1,cores=1) 28 | f2 <- ctStanFit(df,m2,cores=1) 29 | 30 | ctChisqTest(f1,f2) 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/ctCollapse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{ctCollapse} 4 | \alias{ctCollapse} 5 | \title{ctCollapse 6 | Easily collapse an array margin using a specified function.} 7 | \usage{ 8 | ctCollapse(inarray, collapsemargin, collapsefunc, plyr = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{inarray}{Input array of more than one dimension.} 12 | 13 | \item{collapsemargin}{Integers denoting which margins to collapse.} 14 | 15 | \item{collapsefunc}{function to use over the collapsing margin.} 16 | 17 | \item{plyr}{Whether to use plyr.} 18 | 19 | \item{...}{additional parameters to pass to collapsefunc.} 20 | } 21 | \description{ 22 | ctCollapse 23 | Easily collapse an array margin using a specified function. 24 | } 25 | \examples{ 26 | testarray <- array(rnorm(900,2,1),dim=c(100,3,3)) 27 | ctCollapse(testarray,1,mean) 28 | } 29 | -------------------------------------------------------------------------------- /man/ctDeintervalise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDeintervalise.R 3 | \name{ctDeintervalise} 4 | \alias{ctDeintervalise} 5 | \title{ctDeintervalise} 6 | \usage{ 7 | ctDeintervalise(datalong, id = "id", dT = "dT", startoffset = 0) 8 | } 9 | \arguments{ 10 | \item{datalong}{data to use, in ctsem long format (attained via function ctWideToLong)} 11 | 12 | \item{id}{character string denoting column of data containing numeric identifier for each subject.} 13 | 14 | \item{dT}{character string denoting column of data containing time interval preceding observations in that row.} 15 | 16 | \item{startoffset}{Number of units of time to offset by when converting.} 17 | } 18 | \description{ 19 | Converts intervals in ctsem long format data to absolute time 20 | } 21 | -------------------------------------------------------------------------------- /man/ctDensity.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{ctDensity} 4 | \alias{ctDensity} 5 | \title{ctDensity} 6 | \usage{ 7 | ctDensity(x, bw = "auto", plot = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{numeric vector on which to compute density.} 11 | 12 | \item{bw}{either 'auto' or a numeric indicating bandwidth.} 13 | 14 | \item{plot}{logical to indicate whether or not to plot the output.} 15 | 16 | \item{...}{Further args to density.} 17 | } 18 | \description{ 19 | Wrapper for base R density function that removes outliers and computes 'reasonable' bandwidth and x and y limits. 20 | Used for ctsem density plots. 21 | } 22 | \examples{ 23 | y <- ctDensity(exp(rnorm(80))) 24 | plot(y$density,xlim=y$xlim,ylim=y$ylim) 25 | 26 | #### Compare to base defaults: 27 | par(mfrow=c(1,2)) 28 | y=exp(rnorm(10000)) 29 | ctdens<-ctDensity(y) 30 | plot(ctdens$density, ylim=ctdens$ylim,xlim=ctdens$xlim) 31 | plot(density(y)) 32 | } 33 | -------------------------------------------------------------------------------- /man/ctDiscretiseData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDiscretiseData.R 3 | \name{ctDiscretiseData} 4 | \alias{ctDiscretiseData} 5 | \title{Discretise long format continuous time (ctsem) data to specific timestep.} 6 | \usage{ 7 | ctDiscretiseData( 8 | dlong, 9 | timestep, 10 | timecol = "time", 11 | idcol = "id", 12 | TDpredNames = NULL, 13 | TIpredNames = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{dlong}{Long format data} 18 | 19 | \item{timestep}{Positive real value to discretise} 20 | 21 | \item{timecol}{Name of column containing absolute (not intervals) time information.} 22 | 23 | \item{idcol}{Name of column containing subject id variable.} 24 | 25 | \item{TDpredNames}{Vector of column names of any time dependent predictors} 26 | 27 | \item{TIpredNames}{Vector of column names of any time independent predictors} 28 | } 29 | \value{ 30 | long format ctsem data. 31 | } 32 | \description{ 33 | Extends and rounds timing information so equal intervals, according to specified 34 | timestep, are achieved. NA's are inserted in other columns as necessary, 35 | any columns specified by TDpredNames or TIpredNames have zeroes rather than NA's 36 | inserted (because some estimation routines do not tolerate NA's in covariates). 37 | } 38 | \examples{ 39 | long <- ctDiscretiseData(dlong=ctstantestdat, timestep = .1, 40 | TDpredNames=c('TD1'),TIpredNames=c('TI1','TI2','TI3')) 41 | } 42 | -------------------------------------------------------------------------------- /man/ctDocs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsem-package.R 3 | \name{ctDocs} 4 | \alias{ctDocs} 5 | \title{Get documentation pdf for ctsem} 6 | \usage{ 7 | ctDocs() 8 | } 9 | \value{ 10 | Nothing. Opens a pdf. 11 | } 12 | \description{ 13 | Get documentation pdf for ctsem 14 | } 15 | \examples{ 16 | ctDocs() 17 | } 18 | -------------------------------------------------------------------------------- /man/ctExample1.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample1} 4 | \alias{ctExample1} 5 | \title{ctExample1} 6 | \format{ 7 | 100 by 17 matrix containing containing ctsem wide format data. 8 | 6 measurement occasions of leisure time and happiness and 5 measurement intervals for each of 100 individuals. 9 | } 10 | \description{ 11 | Simulated example dataset for the ctsem package 12 | } 13 | -------------------------------------------------------------------------------- /man/ctExample1TIpred.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample1TIpred} 4 | \alias{ctExample1TIpred} 5 | \title{ctExample1TIpred} 6 | \format{ 7 | 100 by 18 matrix containing containing ctsem wide format data. 8 | 6 measurement occasions of leisure time and happiness, 1 measurement of number of friends, 9 | and 5 measurement intervals for each of 100 individuals. 10 | } 11 | \description{ 12 | Simulated example dataset for the ctsem package 13 | } 14 | -------------------------------------------------------------------------------- /man/ctExample2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample2} 4 | \alias{ctExample2} 5 | \title{ctExample2} 6 | \format{ 7 | 100 by 18 matrix containing containing ctsem wide format data. 8 | 8 measurement occasions of leisure time and happiness, 9 | 7 measurement occasions of a money intervention dummy, 10 | and 7 measurement intervals for each of 50 individuals. 11 | } 12 | \description{ 13 | Simulated example dataset for the ctsem package 14 | } 15 | -------------------------------------------------------------------------------- /man/ctExample2level.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample2level} 4 | \alias{ctExample2level} 5 | \title{ctExample2level} 6 | \format{ 7 | 100 by 18 matrix containing ctsem wide format data. 8 | 8 measurement occasions of leisure time and happiness, 9 | 7 measurement occasions of a money intervention dummy, 10 | and 7 measurement intervals for each of 50 individuals. 11 | } 12 | \description{ 13 | Simulated example dataset for the ctsem package 14 | } 15 | -------------------------------------------------------------------------------- /man/ctExample3.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample3} 4 | \alias{ctExample3} 5 | \title{ctExample3} 6 | \format{ 7 | 1 by 399 matrix containing containing ctsem wide format data. 8 | 100 observations of variables Y1 and Y2 and 199 measurement intervals, for 1 subject. 9 | } 10 | \description{ 11 | Simulated example dataset for the ctsem package 12 | } 13 | -------------------------------------------------------------------------------- /man/ctExample4.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctExample4} 4 | \alias{ctExample4} 5 | \title{ctExample4} 6 | \format{ 7 | 20 by 79 matrix containing 20 observations of variables 8 | Y1, Y2, Y3, and 19 measurement intervals dTx, for each of 20 individuals. 9 | } 10 | \description{ 11 | Simulated example dataset for the ctsem package 12 | } 13 | -------------------------------------------------------------------------------- /man/ctExtract.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.ctStanFit.R 3 | \name{ctExtract} 4 | \alias{ctExtract} 5 | \alias{extract} 6 | \title{Extract samples from a ctStanFit object} 7 | \usage{ 8 | ctExtract( 9 | object, 10 | subjectMatrices = FALSE, 11 | cores = 2, 12 | nsamples = "all", 13 | subjects = "all" 14 | ) 15 | } 16 | \arguments{ 17 | \item{object}{ctStanFit object, samples may be from Stan's HMC, or the importance sampling approach of ctsem.} 18 | 19 | \item{subjectMatrices}{Calculate subject specific system matrices?} 20 | 21 | \item{cores}{Only used if subjectMatrices = TRUE . For faster computation use more cores.} 22 | 23 | \item{nsamples}{either 'all' or an integer denoting number of random samples to extract.} 24 | 25 | \item{subjects}{either 'all', or an integer vector denoting subjects to extract.} 26 | } 27 | \value{ 28 | Array of posterior samples. 29 | } 30 | \description{ 31 | Extract samples from a ctStanFit object 32 | } 33 | \examples{ 34 | \donttest{ 35 | e = ctExtract(ctstantestfit) 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /man/ctFit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsem-package.R 3 | \name{ctFit} 4 | \alias{ctFit} 5 | \title{ctFit function placeholder} 6 | \usage{ 7 | ctFit(...) 8 | } 9 | \arguments{ 10 | \item{...}{arguments to pass to ctFit, if ctsemOMX is loaded.} 11 | } 12 | \value{ 13 | message or fit object. 14 | } 15 | \description{ 16 | For the original ctsem OpenMx functionality, the package ctsemOMX should be loaded. 17 | } 18 | \examples{ 19 | \donttest{ 20 | data(AnomAuth) 21 | AnomAuthmodel <- ctModel(LAMBDA = matrix(c(1, 0, 0, 1), nrow = 2, ncol = 2), 22 | Tpoints = 5, n.latent = 2, n.manifest = 2, MANIFESTVAR=diag(0, 2), TRAITVAR = NULL) 23 | AnomAuthfit <- ctFit(AnomAuth, AnomAuthmodel) 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /man/ctFitAuto.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctFitAuto.R 3 | \name{ctFitAuto} 4 | \alias{ctFitAuto} 5 | \title{ctFitAuto} 6 | \usage{ 7 | ctFitAuto( 8 | m, 9 | dat, 10 | DRIFT = TRUE, 11 | DIFFUSION = TRUE, 12 | fast = FALSE, 13 | initialRestrictions = NA, 14 | individuals = FALSE, 15 | groupFreeThreshold = 0.5, 16 | cores = 2, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{m}{ctStan model object without time independent predictors.} 22 | 23 | \item{dat}{Data in long format} 24 | 25 | \item{DRIFT}{Logical, if TRUE, off diagonal drift parameters in the model are tested for inclusion} 26 | 27 | \item{DIFFUSION}{Logical, if TRUE, off diagonal diffusion parameters in the model are tested for inclusion} 28 | 29 | \item{fast}{Logical, if TRUE, do not compute uncertainty hessian / samples in individual level models.} 30 | 31 | \item{initialRestrictions}{Alternative to the DRIFT / DIFFUSION arguments -- specify explicitly which parameters should be fixed initially, vector of integers based on the $setup$matsetup element of the ctStanFit object, which gives the parameter numbers. Primarily for internal use.} 32 | 33 | \item{individuals}{Logical, if TRUE, fit individual level models and determine a group model based on the groupFreeThreshold argument.} 34 | 35 | \item{groupFreeThreshold}{Numeric, threshold for group model structure -- if a parameter improves fit in this proportion of individuals or greater, it is freed for all individuals.} 36 | 37 | \item{cores}{Number of CPU cores to use} 38 | 39 | \item{...}{Additional arguments passed to ctStanFit} 40 | } 41 | \value{ 42 | A ctStan fit object 43 | } 44 | \description{ 45 | Fit a ctStan model with automatic parameter selection 46 | } 47 | \details{ 48 | This function is used to automatically select parameters in a ctStan model. Any specified DRIFT / DIFFUSION matrix off diagonals are only included if they significantly improve the likelihood, based on an estimated likelihood ratio test (relying on the Hessian). 49 | } 50 | \examples{ 51 | #' \dontrun{ 52 | testmodel <- ctstantestfit$ctstanmodelbase 53 | testmodel$pars$TI1_effect <- NULL 54 | testmodel$n.TIpred <- 0 55 | testmodel$TIpredNames <- NULL 56 | testfit <- ctFitAuto(testmodel, dat = ctstantestdat, DRIFT = TRUE, DIFFUSION = TRUE) 57 | summary(testfit) 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /man/ctFitAutoGroupModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctFitAuto.R 3 | \name{ctFitAutoGroupModel} 4 | \alias{ctFitAutoGroupModel} 5 | \title{ctFitAutoGroupModel} 6 | \usage{ 7 | ctFitAutoGroupModel( 8 | m, 9 | dat, 10 | cores, 11 | DRIFT = TRUE, 12 | DIFFUSION = TRUE, 13 | groupFreeThreshold = 0.5, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{m}{ctStan model object without time independent predictors.} 19 | 20 | \item{dat}{Data in long format} 21 | 22 | \item{cores}{Number of CPU cores to use} 23 | 24 | \item{DRIFT}{Logical, if TRUE, off diagonal drift parameters in the model are tested for inclusion} 25 | 26 | \item{DIFFUSION}{Logical, if TRUE, off diagonal diffusion parameters in the model are tested for inclusion} 27 | 28 | \item{groupFreeThreshold}{Numeric, threshold for group free parameter selection. Default is .5} 29 | 30 | \item{...}{Additional arguments passed to ctStanFit} 31 | } 32 | \value{ 33 | A list containing a list of ctStan fit objects for each subject, and a group model 34 | } 35 | \description{ 36 | Fit a ctStan model with automatic parameter selection for multiple subjects 37 | } 38 | \details{ 39 | This function is used to automatically select parameters in a ctStan model. Any specified DRIFT / DIFFUSION matrix off diagonals are only included if they significantly improve the likelihood, based on an estimated likelihood ratio test (relying on the Hessian). Subjects are fit one by one, and a group model is determined based on the groupFreeThreshold parameter -- when the proportion of subjects with a parameter free is above this threshold, the parameter is freed in the group model. 40 | } 41 | \examples{ 42 | \dontrun{ 43 | testmodel <- ctstantestfit$ctstanmodelbase 44 | testmodel$pars$TI1_effect <- NULL 45 | testmodel$n.TIpred <- 0 46 | testmodel$TIpredNames <- NULL 47 | testfit <- ctFitAutoGroupModel(testmodel, dat = ctstantestdat, cores=2, DRIFT = TRUE, DIFFUSION = TRUE) 48 | ctModelLatex(testfit$groupModel) 49 | lapply(testfit$fits,function(x) print(ctStanContinuousPars(x)$DRIFT)) 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /man/ctFitCovCheck.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctCheckFit.R 3 | \name{ctFitCovCheck} 4 | \alias{ctFitCovCheck} 5 | \title{ctCheckFit} 6 | \usage{ 7 | ctFitCovCheck(fit, cor = FALSE) 8 | } 9 | \arguments{ 10 | \item{fit}{ctStanFit object.} 11 | 12 | \item{cor}{Logical. If TRUE, the correlation matrix is used instead of the covariance matrix.} 13 | } 14 | \value{ 15 | data.table containing quantiles of the model implied covariance matrix based on generated samples of data, the sample covariance matrix values, and the difference between the two. 16 | } 17 | \description{ 18 | Visual model fit diagnostics for ctsem fit objects. 19 | } 20 | \examples{ 21 | \dontrun{ 22 | check <- ctCheckFit(ctstantestfit,cor=TRUE) 23 | plot.ctFitCovCheck(check,maxlag=3) 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /man/ctFitMultiModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctFitMultiModel.R 3 | \name{ctFitMultiModel} 4 | \alias{ctFitMultiModel} 5 | \title{Fit and summarise a list of ctsem models} 6 | \usage{ 7 | ctFitMultiModel( 8 | mlist, 9 | datalong, 10 | prefix = "", 11 | type = "ct", 12 | cores = 2, 13 | summaryOutput = TRUE, 14 | saveFits = TRUE, 15 | summaryArgs = list(), 16 | cv = FALSE, 17 | cvArgs = list(), 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{mlist}{Named list of models} 23 | 24 | \item{datalong}{ctsem long format data} 25 | 26 | \item{prefix}{prefix for output files.} 27 | 28 | \item{type}{'ct' for continuous time or 'dt' for discrete time} 29 | 30 | \item{cores}{number of cpu cores to use} 31 | 32 | \item{summaryOutput}{Generate summary output into ctSummary folder? Large datasets can take some time.} 33 | 34 | \item{saveFits}{Save fit objects to working directory?} 35 | 36 | \item{summaryArgs}{Additional arguments for ctSummarise.} 37 | 38 | \item{cv}{Perform k-fold cross validation?} 39 | 40 | \item{cvArgs}{Additional arguments for ctLOO function used for cross validation.} 41 | 42 | \item{...}{Additional arguments for ctStanFit.} 43 | } 44 | \value{ 45 | List containing a named list of model fits ($fits), and a compare object ($compare) 46 | } 47 | \description{ 48 | Fit and summarise a list of ctsem models 49 | } 50 | \examples{ 51 | \dontrun{ 52 | sunspots<-data.frame(id=1, 53 | time=do.call(seq,(lapply(attributes(sunspot.year)$tsp,function(x) x))), 54 | sunspots=sunspot.year) 55 | 56 | ssmodel1 <- ctModel(type='omx', manifestNames='sunspots', Tpoints=3, 57 | latentNames=c('ss_level', 'ss_velocity'), 58 | LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 59 | DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 60 | MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 61 | MANIFESTVAR=diag(0,1), #As per original spec 62 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 63 | DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 64 | 65 | ssmodel2 <- ssmodel1 66 | ssmodel2$LAMBDA[2] <- 0 67 | 68 | fits<-ctFitMultiModel(list(m1=ssmodel1,m2=ssmodel2),datalong = sunspots, 69 | summaryOutput = FALSE, saveFits = FALSE, cores=1, cv=TRUE, cvArgs=list(folds=5)) 70 | print(fits$compare) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /man/ctGenerate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctGenerate.R 3 | \name{ctGenerate} 4 | \alias{ctGenerate} 5 | \title{ctGenerate} 6 | \usage{ 7 | ctGenerate( 8 | ctmodelobj, 9 | n.subjects = 100, 10 | burnin = 0, 11 | dtmean = 1, 12 | logdtsd = 0, 13 | dtmat = NA, 14 | wide = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{ctmodelobj}{ctsem model object from \code{\link{ctModel}}.} 19 | 20 | \item{n.subjects}{Number of subjects to output.} 21 | 22 | \item{burnin}{Number of initial time points to discard (to simulate stationary data)} 23 | 24 | \item{dtmean}{Positive numeric. Average time interval (delta T) to use.} 25 | 26 | \item{logdtsd}{Numeric. Standard deviation for variability of the time interval.} 27 | 28 | \item{dtmat}{Either NA, or numeric matrix of n.subjects rows and Tpoints-1 columns, 29 | containing positive numeric values for all time intervals between measurements. 30 | If not NA, dtmean and logdtsd are ignored.} 31 | 32 | \item{wide}{Logical. Output in wide format?} 33 | } 34 | \description{ 35 | This function generates data according to the specified ctsem model object. 36 | } 37 | \details{ 38 | Covariance related matrices are treated as Cholesky factors. 39 | TRAITTDPREDCOV and TIPREDCOV matrices are not accounted for, at present. 40 | The first 1:n.TDpred rows and columns of TDPREDVAR are used for generating 41 | tdpreds at each time point. 42 | } 43 | \examples{ 44 | #generate data for 2 process model, each process measured by noisy indicator, 45 | #stable individual differences in process levels. 46 | 47 | generatingModel<-ctModel(Tpoints=8,n.latent=2,n.TDpred=0,n.TIpred=0,n.manifest=2, 48 | MANIFESTVAR=diag(.1,2), 49 | LAMBDA=diag(1,2), 50 | DRIFT=matrix(c(-.2,-.05,-.1,-.1),nrow=2), 51 | TRAITVAR=matrix(c(.5,.2,0,.8),nrow=2), 52 | DIFFUSION=matrix(c(1,.2,0,4),2), 53 | CINT=matrix(c(1,0),nrow=2), 54 | T0MEANS=matrix(0,ncol=1,nrow=2), 55 | T0VAR=diag(1,2)) 56 | 57 | data<-ctGenerate(generatingModel,n.subjects=15,burnin=10) 58 | } 59 | -------------------------------------------------------------------------------- /man/ctIndplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctIndplot.R 3 | \name{ctIndplot} 4 | \alias{ctIndplot} 5 | \title{ctIndplot} 6 | \usage{ 7 | ctIndplot( 8 | datawide, 9 | n.manifest, 10 | Tpoints, 11 | n.subjects = "all", 12 | colourby = "variable", 13 | vars = "all", 14 | opacity = 1, 15 | varnames = NULL, 16 | xlab = "Time", 17 | ylab = "Value", 18 | type = "b", 19 | start = 0, 20 | legend = TRUE, 21 | legendposition = "topright", 22 | new = TRUE, 23 | jittersd = 0.05, 24 | ... 25 | ) 26 | } 27 | \arguments{ 28 | \item{datawide}{ctsem wide format data} 29 | 30 | \item{n.manifest}{Number of manifest variables in data structure} 31 | 32 | \item{Tpoints}{Number of discrete time points per case in data structure} 33 | 34 | \item{n.subjects}{Number of subjects to randomly select for plotting, or character vector 'all'.} 35 | 36 | \item{colourby}{set plot colours by "subject" or "variable"} 37 | 38 | \item{vars}{either 'all' or a numeric vector specifying which manifest variables to plot.} 39 | 40 | \item{opacity}{Opacity of plot lines} 41 | 42 | \item{varnames}{vector of variable names for legend (defaults to NULL)} 43 | 44 | \item{xlab}{X axis label.} 45 | 46 | \item{ylab}{Y axis label.} 47 | 48 | \item{type}{character specifying plot type, as per usual base R plot commands. 49 | Defaults to 'b', both points and lines.} 50 | 51 | \item{start}{Measurement occasion to start plotting from - defaults to T0.} 52 | 53 | \item{legend}{Logical. Plot a legend?} 54 | 55 | \item{legendposition}{Where to position the legend.} 56 | 57 | \item{new}{logical. If TRUE, creates a new plot, otherwise overlays on current plot.} 58 | 59 | \item{jittersd}{positive numeric indicating standard deviation of noise to add to observed 60 | data for plotting purposes.} 61 | 62 | \item{...}{additional plotting parameters.} 63 | } 64 | \description{ 65 | Convenience function to simply plot individuals trajectories from ctsem wide format data 66 | } 67 | \examples{ 68 | 69 | data(ctExample1) 70 | ctIndplot(ctExample1,n.subjects=1, n.manifest=2,Tpoints=6, colourby='variable') 71 | 72 | } 73 | -------------------------------------------------------------------------------- /man/ctIntervalise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctIntervalise.R 3 | \name{ctIntervalise} 4 | \alias{ctIntervalise} 5 | \title{Converts absolute times to intervals for wide format ctsem panel data} 6 | \usage{ 7 | ctIntervalise( 8 | datawide, 9 | Tpoints, 10 | n.manifest, 11 | n.TDpred = 0, 12 | n.TIpred = 0, 13 | imputedefs = F, 14 | manifestNames = "auto", 15 | TDpredNames = "auto", 16 | TIpredNames = "auto", 17 | digits = 5, 18 | mininterval = 0.001, 19 | individualRelativeTime = TRUE, 20 | startoffset = 0 21 | ) 22 | } 23 | \arguments{ 24 | \item{datawide}{Wide format data, containing absolute time measurements, 25 | to convert to interval time scale. 26 | See \code{\link{ctLongToWide}} to easily convert long format data.} 27 | 28 | \item{Tpoints}{Maximum number of discrete time points (waves of data, or measurement occasions) 29 | for an individual in the input data structure.} 30 | 31 | \item{n.manifest}{number of manifest variables per time point in the data.} 32 | 33 | \item{n.TDpred}{number of time dependent predictors in the data structure.} 34 | 35 | \item{n.TIpred}{number of time independent predictors in the data structure.} 36 | 37 | \item{imputedefs}{if TRUE, impute time intervals based on the measurement occasion (i.e. column) 38 | they are in, if FALSE (default), set related observations to NA. 39 | FALSE is recommended unless you are certain that the imputed value 40 | (mean of the relevant time column) is appropriate. 41 | Noise and bias in estimates will result if wrongly set to TRUE.} 42 | 43 | \item{manifestNames}{vector of character strings giving variable names of manifest 44 | indicator variables (without _Tx suffix for measurement occasion).} 45 | 46 | \item{TDpredNames}{vector of character strings giving variable names of time 47 | dependent predictor variables (without _Tx suffix for measurement occasion).} 48 | 49 | \item{TIpredNames}{vector of character strings giving variable names of time 50 | independent predictor variables.} 51 | 52 | \item{digits}{How many digits to round to for interval calculations.} 53 | 54 | \item{mininterval}{set to lower than any possible observed measurement interval, 55 | but above 0 - this is used for filling NA values where necessary and has no 56 | impact on estimates when set in the correct range. 57 | (If all observed intervals are greater than 1, mininterval=1 may be a good choice)} 58 | 59 | \item{individualRelativeTime}{if TRUE (default), the first measurement for each individual is 60 | assumed to be taken at time 0, and all other times are adjusted accordingly. 61 | If FALSE, new columns for an initial wave are created, consisting only of observations 62 | which occurred at the earliest observation time of the entire sample.} 63 | 64 | \item{startoffset}{if 0 (default) uses earliest observation as start time. 65 | If greater than 0, all first observations are NA, with distance of 66 | startoffset to first recorded observation.} 67 | } 68 | \description{ 69 | Converts absolute times to intervals for wide format ctsem panel data 70 | } 71 | \details{ 72 | Time column must be numeric! 73 | } 74 | \examples{ 75 | wideexample <- ctLongToWide(datalong = ctstantestdat, id = "id", 76 | time = "time", manifestNames = c("Y1", "Y2"), 77 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3")) 78 | 79 | #Then convert the absolute times to intervals, using the Tpoints reported from the prior step. 80 | wide <- ctIntervalise(datawide = wideexample, Tpoints = 10, n.manifest = 2, 81 | n.TDpred = 1, n.TIpred = 3, manifestNames = c("Y1", "Y2"), 82 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3") ) 83 | 84 | print(wide) 85 | } 86 | -------------------------------------------------------------------------------- /man/ctKalman.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctKalman.R 3 | \name{ctKalman} 4 | \alias{ctKalman} 5 | \title{ctKalman} 6 | \usage{ 7 | ctKalman( 8 | fit, 9 | timerange = "asdata", 10 | timestep = "auto", 11 | subjects = fit$standata$idmap[1, 1], 12 | removeObs = FALSE, 13 | plot = FALSE, 14 | standardisederrors = FALSE, 15 | realid = TRUE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{fit}{fit object as generated by \code{\link{ctStanFit}}.} 21 | 22 | \item{timerange}{Either 'asdata' to just use the observed data range, or a numeric vector of length 2 denoting start and end of time range, 23 | allowing for estimates outside the range of observed data. Ranges smaller than the observed data are ignored.} 24 | 25 | \item{timestep}{Either 'asdata' to just use the observed data 26 | (which also requires 'asdata' for timerange) or a positive numeric value 27 | indicating the time step to use for interpolating values. Lower values give a more accurate / smooth representation, 28 | but take a little more time to calculate.} 29 | 30 | \item{subjects}{vector of integers denoting which subjects (from 1 to N) to plot predictions for.} 31 | 32 | \item{removeObs}{Logical or integer. If TRUE, observations (but not covariates) 33 | are set to NA, so only expectations based on parameters and covariates are returned. If a positive integer N, 34 | every N observations are retained while others are set NA for computing model expectations -- useful for observing prediction performance 35 | forward further in time than one observation.} 36 | 37 | \item{plot}{Logical. If TRUE, plots output instead of returning it. 38 | See \code{\link{plot.ctKalmanDF}} 39 | (Stan based fit) for the possible arguments.} 40 | 41 | \item{standardisederrors}{if TRUE, also include standardised error output (based on covariance 42 | per time point).} 43 | 44 | \item{realid}{use original (not necessarily integer sequence) subject id's? Otherwise use integers 1:N.} 45 | 46 | \item{...}{additional arguments to pass to \code{\link{plot.ctKalmanDF}}.} 47 | } 48 | \value{ 49 | Returns a list containing matrix objects etaprior, etaupd, etasmooth, y, yprior, 50 | yupd, ysmooth, prederror, time, loglik, with values for each time point in each row. 51 | eta refers to latent states and y to manifest indicators - y itself is thus just 52 | the input data. 53 | Covariance matrices etapriorcov, etaupdcov, etasmoothcov, ypriorcov, yupdcov, ysmoothcov, 54 | are returned in a row * column * time array. 55 | Some outputs are unavailable for ctStan fits at present. 56 | If plot=TRUE, nothing is returned but a plot is generated. 57 | } 58 | \description{ 59 | Outputs predicted, updated, and smoothed estimates of manifest indicators and latent states, 60 | with covariances, for specific subjects from data fit with \code{\link{ctStanFit}}, 61 | based on either the mode (if optimized) or mean (if sampled) of parameter distribution. 62 | } 63 | \examples{ 64 | \donttest{ 65 | 66 | #Basic 67 | ctKalman(ctstantestfit, timerange=c(0,60), plot=TRUE) 68 | 69 | #Multiple subjects, y and yprior, showing plot arguments 70 | plot1<-ctKalman(ctstantestfit, timerange=c(0,60), timestep=.1, plot=TRUE, 71 | subjects=2:3, 72 | kalmanvec=c('y','yprior'), 73 | errorvec=c(NA,'ypriorcov')) #'auto' would also have achieved this 74 | 75 | #modify plot as per normal with ggplot 76 | print(plot1+ggplot2::coord_cartesian(xlim=c(0,10))) 77 | 78 | #or generate custom plot from scratch:#' 79 | k=ctKalman(ctstantestfit, timerange=c(0,60), timestep=.1, subjects=2:3) 80 | library(ggplot2) 81 | ggplot(k[k$Element \%in\% 'yprior',], 82 | aes(x=Time, y=value,colour=Subject,linetype=Row)) + 83 | geom_line() + 84 | theme_bw() 85 | 86 | } 87 | } 88 | -------------------------------------------------------------------------------- /man/ctLOO.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctLOO.R 3 | \name{ctLOO} 4 | \alias{ctLOO} 5 | \title{K fold cross validation for ctStanFit objects} 6 | \usage{ 7 | ctLOO( 8 | fit, 9 | folds = 10, 10 | cores = 2, 11 | parallelFolds = FALSE, 12 | tol = 1e-05, 13 | subjectwise = ifelse(length(unique(fit$standata$subject)) >= folds, TRUE, FALSE), 14 | keepfirstobs = FALSE, 15 | leaveOutN = NA, 16 | refit = TRUE, 17 | casewiseApproximation = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{fit}{ctStanfit object} 22 | 23 | \item{folds}{Number of cross validation splits to use -- 10 folds implies that the 24 | model is re-fit 10 times, each time to a data set with 1/10 of the observations randomly removed.} 25 | 26 | \item{cores}{Number of processor cores to use.} 27 | 28 | \item{parallelFolds}{compute folds in parallel or use cores to finish single folds faster. 29 | parallelFolds will use folds times as much memory.} 30 | 31 | \item{tol}{tolerance for optimisation of refitted samples, can generally be more relaxed than the tolerance used for fitting initially.} 32 | 33 | \item{subjectwise}{drop random subjects instead of data rows?} 34 | 35 | \item{keepfirstobs}{do not drop first observation (more stable estimates)} 36 | 37 | \item{leaveOutN}{if a positive integer is given, the folds argument is ignored and 38 | instead the folds are calculated by leaving out every Nth row from the data when fitting. 39 | Leaving 2 out would result in 3 folds (starting at rows 1,2,3), each containing one third of the data.} 40 | 41 | \item{refit}{if FALSE, do not optimise parameters for the new data set, 42 | just compute the likelihoods etc from the original parameters} 43 | 44 | \item{casewiseApproximation}{if TRUE, use a bootstrapped gradient contributions approach to approximate the cross validation parameters -- much faster but less reliable.} 45 | } 46 | \value{ 47 | list 48 | } 49 | \description{ 50 | K fold cross validation for ctStanFit objects 51 | } 52 | \examples{ 53 | \donttest{ 54 | ctLOO(ctstantestfit) 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /man/ctLongToWide.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctLongtowide.r 3 | \name{ctLongToWide} 4 | \alias{ctLongToWide} 5 | \title{ctLongToWide 6 | Restructures time series / panel data from long format to wide format for ctsem analysis} 7 | \usage{ 8 | ctLongToWide( 9 | datalong, 10 | id, 11 | time, 12 | manifestNames, 13 | TDpredNames = NULL, 14 | TIpredNames = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{datalong}{dataset in long format, including subject/id column, observation time 19 | (or change in observation time, with 0 for first observation) column, 20 | indicator (manifest / observed) variables, 21 | any time dependent predictors, and any time independent predictors.} 22 | 23 | \item{id}{character string giving column name of the subject/id column} 24 | 25 | \item{time}{character string giving column name of the time columnn} 26 | 27 | \item{manifestNames}{vector of character strings giving column names of manifest indicator variables} 28 | 29 | \item{TDpredNames}{vector of character strings giving column names of time dependent predictor variables} 30 | 31 | \item{TIpredNames}{vector of character strings giving column names of time independent predictor variables} 32 | } 33 | \description{ 34 | ctLongToWide 35 | Restructures time series / panel data from long format to wide format for ctsem analysis 36 | } 37 | \details{ 38 | Time column must be numeric 39 | } 40 | \examples{ 41 | wideexample <- ctLongToWide(datalong = ctstantestdat, id = "id", 42 | time = "time", manifestNames = c("Y1", "Y2"), 43 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3")) 44 | 45 | #Then convert the absolute times to intervals, using the Tpoints reported from the prior step. 46 | wide <- ctIntervalise(datawide = wideexample, Tpoints = 10, n.manifest = 2, 47 | n.TDpred = 1, n.TIpred = 3, manifestNames = c("Y1", "Y2"), 48 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3") ) 49 | 50 | print(wide) 51 | } 52 | \seealso{ 53 | \code{\link{ctIntervalise}} 54 | } 55 | -------------------------------------------------------------------------------- /man/ctModelHigherOrder.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctModelHigherOrder.R 3 | \name{ctModelHigherOrder} 4 | \alias{ctModelHigherOrder} 5 | \title{Raise the order of a ctsem model object of type 'omx'.} 6 | \usage{ 7 | ctModelHigherOrder( 8 | ctm, 9 | indices, 10 | diffusion = TRUE, 11 | crosseffects = FALSE, 12 | cint = FALSE, 13 | explosive = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{ctm}{ctModel} 18 | 19 | \item{indices}{Vector of integers, which latents to raise the order of.} 20 | 21 | \item{diffusion}{Shift the diffusion parameters / values to the higher order?} 22 | 23 | \item{crosseffects}{Shift cross coupling parameters of the DRIFT matrix to the higher order?} 24 | 25 | \item{cint}{shift continuous intercepts to higher order?} 26 | 27 | \item{explosive}{Allow explosive (non equilibrium returning) processes?} 28 | } 29 | \value{ 30 | extended ctModel 31 | } 32 | \description{ 33 | Raise the order of a ctsem model object of type 'omx'. 34 | } 35 | \examples{ 36 | om <- ctModel(LAMBDA=diag(1,2),DRIFT=0, 37 | MANIFESTMEANS=0,type='omx',Tpoints=4) 38 | 39 | om <- ctModelHigherOrder(om,1:2) 40 | print(om$DRIFT) 41 | 42 | m <- ctStanModel(om) 43 | print(m$pars) 44 | } 45 | -------------------------------------------------------------------------------- /man/ctModelLatex.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctModelLatex.R 3 | \name{ctModelLatex} 4 | \alias{ctModelLatex} 5 | \title{Generate and optionally compile latex equation of subject level ctsem model.} 6 | \usage{ 7 | ctModelLatex( 8 | x, 9 | matrixnames = TRUE, 10 | digits = 3, 11 | linearise = class(x) \%in\% "ctStanFit", 12 | textsize = "normalsize", 13 | folder = tempdir(), 14 | filename = paste0("ctsemTex", as.numeric(Sys.time())), 15 | tex = TRUE, 16 | equationonly = FALSE, 17 | compile = TRUE, 18 | open = TRUE, 19 | includeNote = TRUE, 20 | minimal = FALSE 21 | ) 22 | } 23 | \arguments{ 24 | \item{x}{ctsem model object or ctStanFit object.} 25 | 26 | \item{matrixnames}{Logical. If TRUE, includes ctsem matrix names such as DRIFT and DIFFUSION under the matrices.} 27 | 28 | \item{digits}{Precision of decimals for numeric values.} 29 | 30 | \item{linearise}{Logical. Show the linearised normal approximation for subject parameters and 31 | covariate effects, or the raw parameters?} 32 | 33 | \item{textsize}{Standard latex text sizes -- 34 | tiny scriptsize footnotesize small normalsize large Large LARGE huge Huge. 35 | Useful if output overflows page.} 36 | 37 | \item{folder}{Character string specifying folder to save to, defaults to temporary directory, use "./" for working directory.} 38 | 39 | \item{filename}{filename, without suffix, to output .tex and .pdf files too.} 40 | 41 | \item{tex}{Save .tex file? Otherwise latex is simply returned within R as a string.} 42 | 43 | \item{equationonly}{Logical. If TRUE, output is only the latex relevant to the equation, not a compileable document.} 44 | 45 | \item{compile}{Compile to .pdf? (Depends on \code{tex = TRUE})} 46 | 47 | \item{open}{Open after compiling? (Depends on \code{compile = TRUE})} 48 | 49 | \item{includeNote}{Include text describing matrix transformations and subject notation? 50 | triangular matrices (which results in a covariance or Cholesky matrix) is shown -- 51 | the latter is a more direct representation of the model, while the former is often simpler to convey.} 52 | 53 | \item{minimal}{if TRUE, outputs reduced form version displaying matrix dimensions and equation structure only.} 54 | } 55 | \value{ 56 | character string of latex code. Side effects include saving a .tex, .pdf, and displaying the pdf. 57 | } 58 | \description{ 59 | Generate and optionally compile latex equation of subject level ctsem model. 60 | } 61 | \examples{ 62 | ctmodel <- ctModel(type='ct', 63 | n.latent=2, n.manifest=1, 64 | manifestNames='sunspots', 65 | latentNames=c('ss_level', 'ss_velocity'), 66 | LAMBDA=matrix(c( 1, 'ma1' ), nrow=1, ncol=2), 67 | DRIFT=matrix(c(0, 1, 'a21', 'a22'), nrow=2, ncol=2, byrow=TRUE), 68 | MANIFESTMEANS=matrix(c('m1'), nrow=1, ncol=1), 69 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 70 | DIFFUSION=matrix(c( 71 | 0, 0, 72 | 0, "diffusion"), ncol=2, nrow=2, byrow=TRUE)) 73 | 74 | l=ctModelLatex(ctmodel,compile=FALSE, open=FALSE) 75 | cat(l) 76 | } 77 | -------------------------------------------------------------------------------- /man/ctPlotArray.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctPlotArray.R 3 | \name{ctPlotArray} 4 | \alias{ctPlotArray} 5 | \title{Plots three dimensional y values for quantile plots} 6 | \usage{ 7 | ctPlotArray( 8 | input, 9 | grid = FALSE, 10 | add = FALSE, 11 | colvec = "auto", 12 | lwdvec = "auto", 13 | ltyvec = "auto", 14 | typevec = "auto", 15 | plotcontrol = list(ylab = "Array values", xaxs = "i"), 16 | legend = TRUE, 17 | legendcontrol = list(), 18 | polygon = TRUE, 19 | polygonalpha = 0.1, 20 | polygoncontrol = list(steps = 25) 21 | ) 22 | } 23 | \arguments{ 24 | \item{input}{list containing 3 dimensional array to use for Y values, \code{$y} 25 | and vector of corresponding x values \code{$x}.} 26 | 27 | \item{grid}{Logical. Plot with a grid?} 28 | 29 | \item{add}{Logical. If TRUE, plotting is overlayed on current plot, without creating new plot.} 30 | 31 | \item{colvec}{color vector of same length as 2nd margin.} 32 | 33 | \item{lwdvec}{lwd vector of same length as 2nd margin.} 34 | 35 | \item{ltyvec}{lty vector of same length as 2nd margin.} 36 | 37 | \item{typevec}{type vector of same length as 2nd margin.} 38 | 39 | \item{plotcontrol}{list of arguments to pass to plot.} 40 | 41 | \item{legend}{Logical. Draw a legend?} 42 | 43 | \item{legendcontrol}{list of arguments to pass to \code{\link[graphics]{legend}}.} 44 | 45 | \item{polygon}{Logical. Draw the uncertainty polygon?} 46 | 47 | \item{polygonalpha}{Numeric, multiplier for alpha (transparency) of the 48 | uncertainty polygon.} 49 | 50 | \item{polygoncontrol}{list of arguments to pass to \code{\link{ctPoly}}} 51 | } 52 | \value{ 53 | Nothing. Generates plots. 54 | } 55 | \description{ 56 | 1st margin of $Y sets line values, 2nd sets variables, 3rd quantiles. 57 | } 58 | \examples{ 59 | \donttest{#' 60 | input<-ctStanTIpredeffects(ctstantestfit, plot=FALSE, whichpars='CINT', 61 | nsamples=10,nsubjects=10) 62 | 63 | ctPlotArray(input=input) 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /man/ctPoly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{ctPoly} 4 | \alias{ctPoly} 5 | \title{Plots uncertainty bands with shading} 6 | \usage{ 7 | ctPoly(x, y, ylow, yhigh, steps = 20, ...) 8 | } 9 | \arguments{ 10 | \item{x}{x values} 11 | 12 | \item{y}{y values} 13 | 14 | \item{ylow}{lower limits of y} 15 | 16 | \item{yhigh}{upper limits of y} 17 | 18 | \item{steps}{number of polygons to overlay - higher integers lead to 19 | smoother changes in transparency between y and yhigh / ylow.} 20 | 21 | \item{...}{arguments to pass to polygon()} 22 | } 23 | \value{ 24 | Nothing. Adds a polygon to existing plot. 25 | } 26 | \description{ 27 | Plots uncertainty bands with shading 28 | } 29 | \examples{ 30 | plot(0:100,sqrt(0:100),type='l') 31 | ctPoly(x=0:100, y=sqrt(0:100), 32 | yhigh=sqrt(0:100) - runif(101), 33 | ylow=sqrt(0:100) + runif(101), 34 | col=adjustcolor('red',alpha.f=.1)) 35 | } 36 | -------------------------------------------------------------------------------- /man/ctPostPredData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanPostPredict.R 3 | \name{ctPostPredData} 4 | \alias{ctPostPredData} 5 | \title{Create a data.table to compare data generated from a ctsem fit with the original data.} 6 | \usage{ 7 | ctPostPredData(fit, residuals = F) 8 | } 9 | \arguments{ 10 | \item{fit}{A fitted ctsem model.} 11 | 12 | \item{residuals}{If set to TRUE, includes residuals in the comparison.} 13 | } 14 | \value{ 15 | A data table containing the comparison between generated and original data. 16 | } 17 | \description{ 18 | This function allows for easy comparison of data generated from a fitted ctsem model 19 | with the original data used to fit the model. It provides options to include residuals 20 | in the comparison. 21 | } 22 | \examples{ 23 | data_comparison <- ctPostPredData(ctstantestfit) 24 | 25 | } 26 | \seealso{ 27 | Other ctsem functions for model fitting and analysis. 28 | } 29 | -------------------------------------------------------------------------------- /man/ctPostPredPlots.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanPostPredict.R 3 | \name{ctPostPredPlots} 4 | \alias{ctPostPredPlots} 5 | \title{Create diagnostic plots to assess the goodness-of-fit for a ctsem model.} 6 | \usage{ 7 | ctPostPredPlots(fit) 8 | } 9 | \arguments{ 10 | \item{fit}{A fitted ctsem model.} 11 | } 12 | \description{ 13 | This function generates a set of diagnostic plots to assess the goodness-of-fit for 14 | a fitted ctsem model. 15 | } 16 | \details{ 17 | The function calculates various statistics and creates visualizations to evaluate 18 | how well the generated data matches the original data used to fit the model. The plots 19 | included are as follows: 20 | - A scatter plot comparing observed values and the median of generated data. 21 | - A plot showing the proportion of observed data outside the 95% confidence interval 22 | - A density plot of the proportion of observed data greater than the generated data. 23 | - A time series plot of the proportion of observed data greater than generated data. 24 | } 25 | \examples{ 26 | ctPostPredPlots(ctstantestfit) 27 | 28 | } 29 | \seealso{ 30 | Other ctsem functions for model fitting and analysis. 31 | } 32 | -------------------------------------------------------------------------------- /man/ctPredictTIP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctKalman.R 3 | \name{ctPredictTIP} 4 | \alias{ctPredictTIP} 5 | \title{ctPredictTIP} 6 | \usage{ 7 | ctPredictTIP( 8 | sf, 9 | tipreds = "all", 10 | subject = 1, 11 | timestep = "auto", 12 | doDynamics = TRUE, 13 | plot = TRUE, 14 | quantiles = c(0.16, 0.5, 0.84), 15 | discreteTimeQuantiles = c(0.025, 0.5, 0.975), 16 | showUncertainty = TRUE, 17 | TIPvalues = NA 18 | ) 19 | } 20 | \arguments{ 21 | \item{sf}{A fitted ctStanFit object from the ctsem package.} 22 | 23 | \item{tipreds}{A character vector specifying which time independent predictors to use. Default is 'all', which uses all time independent predictors in the model.} 24 | 25 | \item{subject}{An integer value specifying the internal ctsem subject ID (mapping visible under myfit$setup$idmap) for which predictions are made. 26 | This is relevant only when time dependent predictors are also included in the model.} 27 | 28 | \item{timestep}{A numeric value specifying the time step for predictions. Default is 'auto', which tries to automatically determine an appropriate time step.} 29 | 30 | \item{doDynamics}{A logical value indicating whether to plot the effects of time independent predictors on the dynamics of the system. Default is TRUE. 31 | Can be problematic for systems with many dimensions.} 32 | 33 | \item{plot}{A logical value indicating whether to ggplot the results instead of returning a data.frame of predictions. Default is TRUE.} 34 | 35 | \item{quantiles}{A numeric vector specifying the quantiles of the time independent predictors to plot. Default is 1SD either side and the median, c(.32,.5,.68).} 36 | 37 | \item{discreteTimeQuantiles}{a numeric vector of length 3 specifying the quantiles of the discrete time points to plot, when 38 | showUncertainty is TRUE.} 39 | 40 | \item{showUncertainty}{A logical value indicating whether to plot the uncertainty of the predictions. Default is TRUE.} 41 | 42 | \item{TIPvalues}{An nvalue * nTIpred numeric matrix specifying the fixed values for each time independent predictor effect to plot. 43 | Default is NA, which instead relies on the quantiles specified in the quantiles argument.} 44 | } 45 | \value{ 46 | If plot is TRUE, a list of ggplot objects showing the estimated effects of covariate moderators. Otherwise, a data frame with the predictions. 47 | } 48 | \description{ 49 | Outputs the estimated effect of time independent predictors (covariate moderators) on the expected observations. 50 | } 51 | \details{ 52 | This function estimates the effects of covariate moderators on the expected process 53 | and observations for a specified subject in a dynamic system. The covariate moderators are defined at the specified quantiles, 54 | and their effects on the trajectory are plotted or returned as a data frame. 55 | } 56 | \examples{ 57 | # Example usage: 58 | ctPredictTIP(ctstantestfit, tipreds='all', doDynamics=FALSE, plot=TRUE) 59 | } 60 | -------------------------------------------------------------------------------- /man/ctResiduals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctACF.R 3 | \name{ctResiduals} 4 | \alias{ctResiduals} 5 | \title{Extract Standardized Residuals from a ctsem Fit} 6 | \usage{ 7 | ctResiduals(fit) 8 | } 9 | \arguments{ 10 | \item{fit}{A fitted model object generated by the ctsem package.} 11 | } 12 | \value{ 13 | A data table containing the standardized residuals for each subject and time point. 14 | } 15 | \description{ 16 | This function takes a fit object from the ctsem package and extracts the standardized residuals. 17 | } 18 | \details{ 19 | This function uses the \code{\link{ctStanKalman}} function to calculate the standardized residuals 20 | and then extracts and formats them as a data table. The standardized residuals represent the differences 21 | between the observed and predicted values, divided by the standard errors of the observations. 22 | } 23 | \examples{ 24 | data.table::setDTthreads(1) #ignore this line 25 | # Example usage: 26 | residuals <- ctResiduals(ctstantestfit) 27 | 28 | } 29 | \seealso{ 30 | \code{\link{ctStanKalman}} 31 | } 32 | -------------------------------------------------------------------------------- /man/ctStanContinuousPars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanContinuousPars.R 3 | \name{ctStanContinuousPars} 4 | \alias{ctStanContinuousPars} 5 | \title{ctStanContinuousPars} 6 | \usage{ 7 | ctStanContinuousPars( 8 | fit, 9 | calcfunc = quantile, 10 | calcfuncargs = list(probs = 0.5), 11 | timeinterval = 1 12 | ) 13 | } 14 | \arguments{ 15 | \item{fit}{fit object from \code{\link{ctStanFit}}} 16 | 17 | \item{calcfunc}{Function to apply over samples, must return a single value. 18 | By default the median over all samples is returned using the \code{\link[stats]{quantile}} function, 19 | but one might also be interested in the \code{\link[base]{mean}} or \code{\link[stats]{sd}}, for instance.} 20 | 21 | \item{calcfuncargs}{A list of additional parameters to pass to calcfunc. 22 | For instance, with the default of calcfunc = quantile, 23 | the probs argument is needed to ensure only a single value is returned.} 24 | 25 | \item{timeinterval}{time interval for discrete time parameter matrix computation.} 26 | } 27 | \description{ 28 | Returns the continuous time parameter matrices of a ctStanFit fit object 29 | } 30 | \examples{ 31 | \donttest{ 32 | #posterior median over all subjects (also reflects mean of unconstrained pars) 33 | ctStanContinuousPars(ctstantestfit) 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /man/ctStanDiscretePars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDiscretePars.R 3 | \name{ctStanDiscretePars} 4 | \alias{ctStanDiscretePars} 5 | \title{ctStanDiscretePars} 6 | \usage{ 7 | ctStanDiscretePars( 8 | ctstanfitobj, 9 | subjects = "popmean", 10 | times = seq(from = 0, to = 10, by = 0.1), 11 | nsamples = 200, 12 | observational = FALSE, 13 | standardise = FALSE, 14 | cov = FALSE, 15 | plot = FALSE, 16 | cores = 2, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{ctstanfitobj}{model fit from \code{\link{ctStanFit}}} 22 | 23 | \item{subjects}{Either 'popmean', to use the population mean parameter, or a vector of integers denoting which 24 | subjects.} 25 | 26 | \item{times}{Numeric vector of positive values, discrete time parameters will be calculated for each. If the fit 27 | object is a discrete time model, these should be positive integers.} 28 | 29 | \item{nsamples}{Number of samples from the stanfit to use for plotting. Higher values will 30 | increase smoothness / accuracy, at cost of plotting speed. Values greater than the total 31 | number of samples will be set to total samples.} 32 | 33 | \item{observational}{Logical. If TRUE, outputs expected change in processes *conditional on observing* a 1 unit change in each -- 34 | this change is correlated according to the DIFFUSION matrix. If FALSE, outputs expected regression values -- also interpretable as 35 | an independent 1 unit change on each process, giving the expected response under a 1 unit experimental impulse.} 36 | 37 | \item{standardise}{Logical. If TRUE, output is standardised according to expected total within subject variance, given by the 38 | asymDIFFUSIONcov matrix.} 39 | 40 | \item{cov}{Logical. If TRUE, covariances are returned instead of regression coefficients.} 41 | 42 | \item{plot}{Logical. If TRUE, ggplots output using \code{\link{ctStanDiscreteParsPlot}} 43 | instead of returning output.} 44 | 45 | \item{cores}{Number of cpu cores to use for computing subject matrices. 46 | If subject matrices were saved during fiting, not used.} 47 | 48 | \item{...}{additional plotting arguments to control \code{\link{ctStanDiscreteParsPlot}}} 49 | } 50 | \description{ 51 | Calculate model implied regressions for a sequence of time intervals (if ct) or steps (if dt) based on 52 | a ctStanFit object, for specified subjects. Wrap with print() when used inside for loops! 53 | } 54 | \details{ 55 | If plot=TRUE, the function will return a ggplot2 object 56 | (and hence needs to be printed if intended to display within a loop). 57 | This can be modified by the various ggplot2 functions, or displayed using print(x). 58 | } 59 | \examples{ 60 | data.table::setDTthreads(1) #ignore this line 61 | ctStanDiscretePars(ctstantestfit,times=seq(.5,4,.1), 62 | plot=TRUE,indices='CR') 63 | 64 | #modify plot 65 | require(ggplot2) 66 | g=ctStanDiscretePars(ctstantestfit,times=seq(.5,4,.1), 67 | plot=TRUE,indices='CR') 68 | g= g+ labs(title='Cross effects') 69 | print(g) 70 | } 71 | -------------------------------------------------------------------------------- /man/ctStanDiscreteParsPlot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDiscretePars.R 3 | \name{ctStanDiscreteParsPlot} 4 | \alias{ctStanDiscreteParsPlot} 5 | \title{ctStanDiscreteParsPlot} 6 | \usage{ 7 | ctStanDiscreteParsPlot( 8 | x, 9 | indices = "all", 10 | quantiles = c(0.025, 0.5, 0.975), 11 | latentNames = "auto", 12 | ylab = "Coefficient", 13 | xlab = "Time interval", 14 | ylim = NA, 15 | facets = NA, 16 | splitSubjects = TRUE, 17 | colour = "Effect", 18 | title = "auto", 19 | polygonalpha = 0.1, 20 | ggcode = FALSE 21 | ) 22 | } 23 | \arguments{ 24 | \item{x}{list object returned from \code{\link{ctStanDiscretePars}}.} 25 | 26 | \item{indices}{Either a string specifying type of plot to create, or an n by 2 27 | matrix specifying which indices of the output matrix to plot. 28 | 'AR' specifies all diagonals, for discrete time autoregression parameters. 29 | 'CR' specifies all off-diagonals,for discrete time cross regression parameters. 30 | 'all' plots all AR and CR effects at once.} 31 | 32 | \item{quantiles}{numeric vector of length 3, with values between 0 and 1, specifying which quantiles to plot. 33 | The default plots 95\% credible intervals and the posterior median at 50\%.} 34 | 35 | \item{latentNames}{Vector of character strings denoting names for the latent variables. 36 | 'auto' just uses eta1 eta2 etc.} 37 | 38 | \item{ylab}{y label.} 39 | 40 | \item{xlab}{x label.} 41 | 42 | \item{ylim}{Custom ylim.} 43 | 44 | \item{facets}{May be 'Subject' or 'Effect'.} 45 | 46 | \item{splitSubjects}{if TRUE, subjects are plotted separately, if FALSE they are combined.} 47 | 48 | \item{colour}{Character string denoting how colour varies. 'Effect' or 'Subject'.} 49 | 50 | \item{title}{Character string. 'auto' generates automatically, NULL can be used to disable title.} 51 | 52 | \item{polygonalpha}{Numeric between 0 and 1 to multiply the alpha of 53 | the fill.} 54 | 55 | \item{ggcode}{if TRUE, returns a list containing the data.table to plot, and a character string that can be 56 | evaluated (with the necessary arguments such as ylab etc filled in). For modifying plots.} 57 | } 58 | \value{ 59 | A ggplot2 object. This can be modified by the various ggplot2 functions, or displayed using print(x). 60 | } 61 | \description{ 62 | Plots model implied regression strengths at specified times for 63 | continuous time models fit with ctStanFit. 64 | } 65 | \examples{ 66 | data.table::setDTthreads(1) #ignore this line 67 | x <- ctStanDiscretePars(ctstantestfit) 68 | ctStanDiscreteParsPlot(x, indices='CR') 69 | 70 | #to modify plot: 71 | g <- ctStanDiscreteParsPlot(x, indices='CR') + 72 | ggplot2::labs(title='My ggplot modification') 73 | print(g) 74 | 75 | } 76 | -------------------------------------------------------------------------------- /man/ctStanFitUpdate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanFit.R 3 | \name{ctStanFitUpdate} 4 | \alias{ctStanFitUpdate} 5 | \title{Update a ctStanFit object} 6 | \usage{ 7 | ctStanFitUpdate(oldfit, data = NA, recompile = FALSE, refit = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{oldfit}{fit object to be upgraded} 11 | 12 | \item{data}{replacement long format data object} 13 | 14 | \item{recompile}{whether to force a recompile -- safer but slower and usually unnecessary.} 15 | 16 | \item{refit}{if TRUE, refits the model using the old estimates as a starting point. Only applicable for 17 | optimized fits, not sampling.} 18 | 19 | \item{...}{extra arguments to pass to ctStanFit} 20 | } 21 | \value{ 22 | updated ctStanFit object. 23 | } 24 | \description{ 25 | Either to include different data, or because you have upgraded ctsem and the internal data structure has changed. 26 | } 27 | \examples{ 28 | newfit <- ctStanFitUpdate(ctstantestfit,refit=FALSE) 29 | } 30 | -------------------------------------------------------------------------------- /man/ctStanGenerate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanGenerate.R 3 | \name{ctStanGenerate} 4 | \alias{ctStanGenerate} 5 | \title{Generate data from a ctstanmodel object} 6 | \usage{ 7 | ctStanGenerate( 8 | cts, 9 | datastruct = NA, 10 | is = FALSE, 11 | fullposterior = TRUE, 12 | nsamples = 200, 13 | parsonly = FALSE, 14 | cores = 2 15 | ) 16 | } 17 | \arguments{ 18 | \item{cts}{\code{\link{ctStanModel}} , or \code{\link{ctStanFit}},object.} 19 | 20 | \item{datastruct}{long format data structure as used by ctsem. 21 | Not used if cts is a ctStanFit object.} 22 | 23 | \item{is}{If optimizing, follow up with importance sampling?} 24 | 25 | \item{fullposterior}{Generate from the full posterior or just the (unconstrained) mean?} 26 | 27 | \item{nsamples}{How many samples to generate?} 28 | 29 | \item{parsonly}{If TRUE, only return samples of raw parameters, don't generate data.} 30 | 31 | \item{cores}{Number of cpu cores to use.} 32 | } 33 | \value{ 34 | List contining Y, and array of nsamples by data rows by manifest variables, 35 | and llrow, an array of nsamples by data rows log likelihoods. 36 | } 37 | \description{ 38 | Generate data from a ctstanmodel object 39 | } 40 | \examples{ 41 | \donttest{ 42 | #generate and plot samples from prior predictive 43 | priorpred <- ctStanGenerate(cts = ctstantestfit,cores=2,nsamples = 50) 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /man/ctStanGenerateFromFit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanGenerateFromFit.R 3 | \name{ctStanGenerateFromFit} 4 | \alias{ctStanGenerateFromFit} 5 | \title{Add a \code{$generated} object to ctstanfit object, with random data generated from posterior of ctstanfit object} 6 | \usage{ 7 | ctStanGenerateFromFit( 8 | fit, 9 | nsamples = 200, 10 | fullposterior = FALSE, 11 | verboseErrors = FALSE, 12 | cores = 2 13 | ) 14 | } 15 | \arguments{ 16 | \item{fit}{ctstanfit object} 17 | 18 | \item{nsamples}{Positive integer specifying number of datasets to generate.} 19 | 20 | \item{fullposterior}{Logical indicating whether to sample from the full posterior (original nsamples) or the posterior mean.} 21 | 22 | \item{verboseErrors}{if TRUE, print verbose output when errors in generation encountered.} 23 | 24 | \item{cores}{Number of cpu cores to use.} 25 | } 26 | \value{ 27 | Matrix of generated data -- one dataset per iteration, according to original time and missingness structure. 28 | } 29 | \description{ 30 | Add a \code{$generated} object to ctstanfit object, with random data generated from posterior of ctstanfit object 31 | } 32 | \examples{ 33 | gen <- ctStanGenerateFromFit(ctstantestfit, nsamples=3,fullposterior=TRUE,cores=1) 34 | plot(gen$generated$Y[3,,2],type='l') #Third random data sample, 2nd manifest var, all time points. 35 | } 36 | -------------------------------------------------------------------------------- /man/ctStanKalman.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanKalman.R 3 | \name{ctStanKalman} 4 | \alias{ctStanKalman} 5 | \title{Get Kalman filter estimates from a ctStanFit object} 6 | \usage{ 7 | ctStanKalman( 8 | fit, 9 | nsamples = NA, 10 | pointest = TRUE, 11 | collapsefunc = NA, 12 | cores = 1, 13 | subjects = 1:max(fit$standata$subject), 14 | timestep = "asdata", 15 | maxtime = "asdata", 16 | standardisederrors = FALSE, 17 | subjectpars = TRUE, 18 | tformsubjectpars = TRUE, 19 | indvarstates = FALSE, 20 | removeObs = F, 21 | ... 22 | ) 23 | } 24 | \arguments{ 25 | \item{fit}{fit object from \code{\link{ctStanFit}}.} 26 | 27 | \item{nsamples}{either NA (to extract all) or a positive integer from 1 to maximum samples in the fit.} 28 | 29 | \item{pointest}{If TRUE, uses the posterior mode as the single sample.} 30 | 31 | \item{collapsefunc}{function to apply over samples, such as \code{mean}} 32 | 33 | \item{cores}{Integer number of cpu cores to use. Only needed if savescores was set to FALSE when fitting.} 34 | 35 | \item{subjects}{integer vector of subjects to compute for.} 36 | 37 | \item{timestep}{Either a positive numeric value, 'asdata' to use the times in the dataset, or 'auto' to select 38 | a timestep automatically (resulting in some interpolation but not excessive computation).} 39 | 40 | \item{maxtime}{only relevant if timestep is not 'asdata'. Positive numeric denoting max time for computations.} 41 | 42 | \item{standardisederrors}{If TRUE, computes standardised errors for prior, upd, smooth conditions.} 43 | 44 | \item{subjectpars}{if TRUE, state estimates are not returned, instead, predictions of each subjects parameters 45 | are returned, for parameters that had random effects specified.} 46 | 47 | \item{tformsubjectpars}{if FALSE, subject level parameters are returned in raw, pre transformation form.} 48 | 49 | \item{indvarstates}{if TRUE, do not remove indvarying states from output} 50 | 51 | \item{removeObs}{Logical or integer. If TRUE, observations (but not covariates) 52 | are set to NA, so only expectations based on parameters and covariates are returned. If a positive integer N, 53 | every N observations are retained while others are set NA for computing model expectations -- useful for observing prediction performance 54 | forward further in time than one observation.} 55 | 56 | \item{...}{additional arguments to collpsefunc.} 57 | } 58 | \value{ 59 | list containing Kalman filter elements, each element in array of 60 | iterations, data row, variables. llrow is the log likelihood for each row of data. 61 | } 62 | \description{ 63 | Get Kalman filter estimates from a ctStanFit object 64 | } 65 | \examples{ 66 | k=ctStanKalman(ctstantestfit,subjectpars=TRUE,collapsefunc=mean) 67 | } 68 | -------------------------------------------------------------------------------- /man/ctStanModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanModel.R 3 | \name{ctStanModel} 4 | \alias{ctStanModel} 5 | \title{Convert a frequentist (omx) ctsem model specification to Bayesian (Stan).} 6 | \usage{ 7 | ctStanModel(ctmodelobj, type = "ct", tipredDefault = TRUE) 8 | } 9 | \arguments{ 10 | \item{ctmodelobj}{ctsem model object of type 'omx' (default)} 11 | 12 | \item{type}{either 'ct' for continuous time, or 'dt' for discrete time.} 13 | 14 | \item{tipredDefault}{Logical. TRUE sets any parameters with unspecified time independent 15 | predictor effects to have effects estimated, FALSE fixes the effect to zero unless individually specified.} 16 | } 17 | \value{ 18 | List object of class ctStanModel, with random effects specified for any intercept type parameters 19 | (T0MEANS, MANIFESTMEANS, and or CINT), and time independent predictor effects for all parameters. Adjust these 20 | after initial specification by directly editing the \code{pars} subobject, so \code{model$pars} . 21 | } 22 | \description{ 23 | Convert a frequentist (omx) ctsem model specification to Bayesian (Stan). 24 | } 25 | \examples{ 26 | model <- ctModel(type='omx', Tpoints=50, 27 | n.latent=2, n.manifest=1, 28 | manifestNames='sunspots', 29 | latentNames=c('ss_level', 'ss_velocity'), 30 | LAMBDA=matrix(c( 1, 'ma1' ), nrow=1, ncol=2), 31 | DRIFT=matrix(c(0, 1, 'a21', 'a22'), nrow=2, ncol=2, byrow=TRUE), 32 | MANIFESTMEANS=matrix(c('m1'), nrow=1, ncol=1), 33 | # MANIFESTVAR=matrix(0, nrow=1, ncol=1), 34 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 35 | DIFFUSION=matrix(c( 36 | 0, 0, 37 | 0, "diffusion"), ncol=2, nrow=2, byrow=TRUE)) 38 | 39 | stanmodel=ctStanModel(model) 40 | 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/ctStanParnames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDiscretePars.R 3 | \name{ctStanParnames} 4 | \alias{ctStanParnames} 5 | \title{ctStanParnames} 6 | \usage{ 7 | ctStanParnames(x, substrings = c("pop_", "popsd")) 8 | } 9 | \arguments{ 10 | \item{x}{ctStanFit object} 11 | 12 | \item{substrings}{vector of character strings, parameter names of the stan model 13 | containing any of these strings will be returned. Useful strings may be 'pop_' for 14 | population means, 'popsd' for population standard deviations, 15 | or specific combinations such as 'pop_DRIFT' for the population 16 | means of temporal dynamics parameters} 17 | } 18 | \value{ 19 | vector of character strings. 20 | } 21 | \description{ 22 | Gets internal stan parameter names of a ctStanFit object sampled via stan based on specified substrings. 23 | } 24 | \examples{ 25 | \donttest{ 26 | sunspots<-sunspot.year 27 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 28 | id <- 1 29 | time <- 1749:1924 30 | datalong <- cbind(id, time, sunspots) 31 | 32 | #setup model 33 | ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 34 | manifestNames='sunspots', 35 | latentNames=c('ss_level', 'ss_velocity'), 36 | LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 37 | DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 38 | MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 39 | MANIFESTVAR=diag(0,1), #As per original spec 40 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 41 | DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 42 | 43 | #fit 44 | ssfit <- ctStanFit(datalong, ssmodel, iter=2, 45 | optimize=FALSE, chains=1) 46 | ctStanParnames(ssfit,substrings=c('pop_','popsd')) 47 | } 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/ctStanPlotPost.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanPlotPost.R 3 | \name{ctStanPlotPost} 4 | \alias{ctStanPlotPost} 5 | \title{ctStanPlotPost} 6 | \usage{ 7 | ctStanPlotPost( 8 | obj, 9 | rows = "all", 10 | npp = 6, 11 | priorwidth = TRUE, 12 | smoothness = 1, 13 | priorsamples = 10000, 14 | plot = TRUE, 15 | wait = FALSE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{obj}{fit or model object as generated by \code{\link{ctStanFit}}, 21 | \code{\link{ctModel}}, or \code{\link{ctStanModel}}.} 22 | 23 | \item{rows}{vector of integers denoting which rows of obj$setup$popsetup to plot priors for. 24 | Character string 'all' plots all rows with parameters to be estimated.} 25 | 26 | \item{npp}{Integer number of parameters to show per page.} 27 | 28 | \item{priorwidth}{if TRUE, plots will be scaled to show bulk of both the prior 29 | and posterior distributions. If FALSE, scale is based only on the posterior.} 30 | 31 | \item{smoothness}{Positive numeric -- multiplier to modify smoothness of density plots, higher is smoother but 32 | can cause plots to exceed natural boundaries, such as standard deviations below zero.} 33 | 34 | \item{priorsamples}{number of samples from prior to use. More is slower.} 35 | 36 | \item{plot}{Logical, if FALSE, ggplot objects are returned in a list instead of plotting.} 37 | 38 | \item{wait}{If true, user is prompted to continue before plotting next graph. 39 | If false, graphs are plotted one after another without waiting.} 40 | 41 | \item{...}{Parameters to pass to ctStanFit. \code{cores = x} will speed things up, 42 | where x is the number of cpu cores to use.} 43 | } 44 | \description{ 45 | Plots prior and posterior distributions of model parameters in a ctStanModel or ctStanFit object. 46 | } 47 | \examples{ 48 | \donttest{ 49 | ctStanPlotPost(ctstantestfit, rows=3:4) 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /man/ctStanPostPredict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanPostPredict.R 3 | \name{ctStanPostPredict} 4 | \alias{ctStanPostPredict} 5 | \title{Compares model implied density and values to observed, for a ctStanFit object.} 6 | \usage{ 7 | ctStanPostPredict( 8 | fit, 9 | diffsize = 1, 10 | jitter = 0.02, 11 | wait = TRUE, 12 | probs = c(0.025, 0.5, 0.975), 13 | datarows = "all", 14 | nsamples = 500, 15 | resolution = 100, 16 | plot = TRUE 17 | ) 18 | } 19 | \arguments{ 20 | \item{fit}{ctStanFit object.} 21 | 22 | \item{diffsize}{Integer > 0. Number of discrete time lags to use for data viz.} 23 | 24 | \item{jitter}{Positive numeric between 0 and 1, if TRUE, jitters empirical data by specified proportion of std dev.} 25 | 26 | \item{wait}{Logical, if TRUE and \code{plot=TRUE}, waits for input before plotting next plot.} 27 | 28 | \item{probs}{Vector of length 3 containing quantiles to plot -- should be rising numeric values between 0 and 1.} 29 | 30 | \item{datarows}{integer vector specifying rows of data to plot. Otherwise 'all' uses all data.} 31 | 32 | \item{nsamples}{Number of datasets to generate for comparisons, if fit object does not contain generated 33 | data already.} 34 | 35 | \item{resolution}{Positive integer, the number of rows and columns to split plots into for shading.} 36 | 37 | \item{plot}{logical. If FALSE, a list of ggplot objects is returned.} 38 | } 39 | \value{ 40 | If plot=FALSE, an array containing quantiles of generated data. If plot=TRUE, nothing, only plots. 41 | 42 | if plot=TRUE, nothing is returned and plots are created. Otherwise, a list containing ggplot objects is returned 43 | and may be customized as desired. 44 | } 45 | \description{ 46 | Compares model implied density and values to observed, for a ctStanFit object. 47 | } 48 | \details{ 49 | This function relies on the data generated during each iteration of fitting to approximate the 50 | model implied distributions -- thus, when limited iterations are available, the approximation will be worse. 51 | } 52 | \examples{ 53 | \donttest{#' 54 | ctStanPostPredict(ctstantestfit,wait=FALSE, diffsize=2,resolution=100) 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /man/ctStanSubjectPars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.ctStanFit.R 3 | \name{ctStanSubjectPars} 4 | \alias{ctStanSubjectPars} 5 | \title{Extract an array of subject specific parameters from a ctStanFit object.} 6 | \usage{ 7 | ctStanSubjectPars(fit, pointest = TRUE, cores = 2, nsamples = "all") 8 | } 9 | \arguments{ 10 | \item{fit}{fit object} 11 | 12 | \item{pointest}{if TRUE, returns only the set of individual difference parameters 13 | based on the max a posteriori estimate (or the median if sampling approaches were used).} 14 | 15 | \item{cores}{Number of cores to use.} 16 | 17 | \item{nsamples}{Number of samples to calculate parameters for. Not used if pointest=TRUE.} 18 | } 19 | \value{ 20 | an nsamples by nsubjects by nparams array. 21 | } 22 | \description{ 23 | Extract an array of subject specific parameters from a ctStanFit object. 24 | } 25 | \details{ 26 | This function returns the estimates of individual parameters, taking into account any 27 | covariates and random effects. 28 | } 29 | \examples{ 30 | indpars <- ctStanSubjectPars(ctstantestfit) 31 | dimnames(indpars) 32 | plot(indpars[1,,'cint1'],indpars[1,,'cint2']) 33 | } 34 | -------------------------------------------------------------------------------- /man/ctStanUpdModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctStanModelWriter.R 3 | \name{ctStanUpdModel} 4 | \alias{ctStanUpdModel} 5 | \title{Update an already compiled and fit ctStanFit object} 6 | \usage{ 7 | ctStanUpdModel(fit, datalong, ctstanmodel, ...) 8 | } 9 | \arguments{ 10 | \item{fit}{ctStanFit object} 11 | 12 | \item{datalong}{data as normally passed to \code{\link{ctStanFit}}} 13 | 14 | \item{ctstanmodel}{model as normally passed to \code{\link{ctStanFit}}} 15 | 16 | \item{...}{extra args for \code{\link{ctStanFit}}} 17 | } 18 | \description{ 19 | Allows one to change data and or model elements that don't require recompiling, then re fit. 20 | } 21 | -------------------------------------------------------------------------------- /man/ctWideNames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{ctWideNames} 4 | \alias{ctWideNames} 5 | \title{ctWideNames 6 | sets default column names for wide ctsem datasets. Primarily intended for internal ctsem usage.} 7 | \usage{ 8 | ctWideNames( 9 | n.manifest, 10 | Tpoints, 11 | n.TDpred = 0, 12 | n.TIpred = 0, 13 | manifestNames = "auto", 14 | TDpredNames = "auto", 15 | TIpredNames = "auto" 16 | ) 17 | } 18 | \arguments{ 19 | \item{n.manifest}{number of manifest variables per time point in the data.} 20 | 21 | \item{Tpoints}{Maximum number of discrete time points (waves of data, or measurement occasions) 22 | for an individual in the input data structure.} 23 | 24 | \item{n.TDpred}{number of time dependent predictors in the data structure.} 25 | 26 | \item{n.TIpred}{number of time independent predictors in the data structure.} 27 | 28 | \item{manifestNames}{vector of character strings giving column names of manifest indicator variables} 29 | 30 | \item{TDpredNames}{vector of character strings giving column names of time dependent predictor variables} 31 | 32 | \item{TIpredNames}{vector of character strings giving column names of time independent predictor variables} 33 | } 34 | \description{ 35 | ctWideNames 36 | sets default column names for wide ctsem datasets. Primarily intended for internal ctsem usage. 37 | } 38 | -------------------------------------------------------------------------------- /man/ctWideToLong.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctWideToLong.R 3 | \name{ctWideToLong} 4 | \alias{ctWideToLong} 5 | \title{ctWideToLong 6 | Convert ctsem wide to long format} 7 | \usage{ 8 | ctWideToLong( 9 | datawide, 10 | Tpoints, 11 | n.manifest, 12 | n.TDpred = 0, 13 | n.TIpred = 0, 14 | manifestNames = "auto", 15 | TDpredNames = "auto", 16 | TIpredNames = "auto" 17 | ) 18 | } 19 | \arguments{ 20 | \item{datawide}{ctsem wide format data} 21 | 22 | \item{Tpoints}{number of measurement occasions in data} 23 | 24 | \item{n.manifest}{number of manifest variables} 25 | 26 | \item{n.TDpred}{number of time dependent predictors} 27 | 28 | \item{n.TIpred}{number of time independent predictors} 29 | 30 | \item{manifestNames}{Character vector of manifest variable names.} 31 | 32 | \item{TDpredNames}{Character vector of time dependent predictor names.} 33 | 34 | \item{TIpredNames}{Character vector of time independent predictor names.} 35 | } 36 | \description{ 37 | ctWideToLong 38 | Convert ctsem wide to long format 39 | } 40 | \details{ 41 | Names must account for *all* the columns in the data - i.e. do not leave certain variables out 42 | just because you do not need them. 43 | } 44 | \examples{ 45 | #create wide data 46 | wideexample <- ctLongToWide(datalong = ctstantestdat, id = "id", 47 | time = "time", manifestNames = c("Y1", "Y2"), 48 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3")) 49 | 50 | wide <- ctIntervalise(datawide = wideexample, Tpoints = 10, n.manifest = 2, 51 | n.TDpred = 1, n.TIpred = 3, manifestNames = c("Y1", "Y2"), 52 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2","TI3") ) 53 | 54 | #Then convert to long format 55 | longexample <- ctWideToLong(datawide = wideexample, Tpoints=10, 56 | n.manifest=2, manifestNames = c("Y1", "Y2"), 57 | n.TDpred=1, TDpredNames = "TD1", 58 | n.TIpred=3, TIpredNames = c("TI1", "TI2","TI3")) 59 | 60 | #Then convert the time intervals to absolute time 61 | long <- ctDeintervalise(datalong = longexample, id='id', dT='dT') 62 | head(long,22) 63 | 64 | 65 | } 66 | -------------------------------------------------------------------------------- /man/ctsem-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsem-package.R 3 | \docType{package} 4 | \name{ctsem-package} 5 | \alias{ctsem} 6 | \alias{ctsem-package} 7 | \title{ctsem} 8 | \description{ 9 | ctsem is an R package for continuous time structural equation modelling of panel (N > 1) 10 | and time series (N = 1) data, using either a frequentist or Bayesian approach, or middle 11 | ground forms like maximum a posteriori. 12 | 13 | The general workflow begins by specifying a model using the \code{\link{ctModel}} function, 14 | in which the \code{type} of model is also specified. Then the model is fit to data using 15 | \code{\link{ctStanFit}}. The ctFit function which allows for fitting using the OpenMx / SEM form, 16 | as described in the original JSS ctsem paper, can now be found in the ctsemOMX package. 17 | The omx forms are no longer in 18 | development and for most purposes, the newer stan based forms are more robust and flexible. 19 | For examples, see \code{\link{ctStanFit}}. 20 | For citation info, please run \code{citation('ctsem')} . 21 | } 22 | \references{ 23 | https://www.jstatsoft.org/article/view/v077i05 24 | 25 | Driver, C. C., & Voelkle, M. C. (2018). Hierarchical Bayesian continuous time dynamic modeling. 26 | Psychological Methods. Advance online publication.http://dx.doi.org/10.1037/met0000168 27 | 28 | Stan Development Team (2018). RStan: the R interface to Stan. R package version 2.17.3. http://mc-stan.org 29 | 30 | #' @keywords internal 31 | } 32 | \seealso{ 33 | Useful links: 34 | \itemize{ 35 | \item \url{https://github.com/cdriveraus/ctsem} 36 | } 37 | 38 | } 39 | \author{ 40 | \strong{Maintainer}: Charles Driver \email{charles.driver2@uzh.ch} [copyright holder] 41 | 42 | Authors: 43 | \itemize{ 44 | \item Manuel Voelkle [copyright holder] 45 | \item Han Oud [copyright holder] 46 | } 47 | 48 | Other contributors: 49 | \itemize{ 50 | \item Trustees of Columbia University [copyright holder] 51 | } 52 | 53 | } 54 | -------------------------------------------------------------------------------- /man/ctstantestdat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctstantestdat} 4 | \alias{ctstantestdat} 5 | \title{ctstantestdat} 6 | \format{ 7 | matrix 8 | } 9 | \description{ 10 | Generated dataset for testing \code{\link{ctStanFit}} from ctsem package. 11 | } 12 | -------------------------------------------------------------------------------- /man/ctstantestfit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{ctstantestfit} 4 | \alias{ctstantestfit} 5 | \title{ctstantestfit} 6 | \format{ 7 | ctStanFit object 8 | } 9 | \description{ 10 | Dummy fit for testing functions from ctsem package. 11 | } 12 | -------------------------------------------------------------------------------- /man/datastructure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{datastructure} 4 | \alias{datastructure} 5 | \title{datastructure} 6 | \format{ 7 | 2 by 15 matrix containing containing ctsem wide format data. 8 | 3 measurement occasions of manifest variables Y1 and Y2, 9 | 2 measurement occasions of time dependent predictor TD1, 10 | 2 measurement intervals dTx, and 2 time independent predictors 11 | TI1 and TI2, for 2 individuals. 12 | } 13 | \description{ 14 | Simulated example dataset for the ctsem package 15 | } 16 | -------------------------------------------------------------------------------- /man/inv_logit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{inv_logit} 4 | \alias{inv_logit} 5 | \title{Inverse logit} 6 | \usage{ 7 | inv_logit(x) 8 | } 9 | \arguments{ 10 | \item{x}{value to calculate the inverse logit for.} 11 | } 12 | \description{ 13 | Maps the stan function so the same code works in R. 14 | } 15 | \examples{ 16 | inv_logit(-3) 17 | } 18 | -------------------------------------------------------------------------------- /man/isdiag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/isdiag.R 3 | \name{isdiag} 4 | \alias{isdiag} 5 | \title{Diagnostics for ctsem importance sampling} 6 | \usage{ 7 | isdiag(fit) 8 | } 9 | \arguments{ 10 | \item{fit}{Output from ctStanFit when optimize=TRUE and isloops > 0} 11 | } 12 | \value{ 13 | Nothing. Plots convergence of parameter mean estimates from initial Hessian based distribution to final sampling distribution. 14 | } 15 | \description{ 16 | Diagnostics for ctsem importance sampling 17 | } 18 | \examples{ 19 | \donttest{ 20 | #get data 21 | sunspots<-sunspot.year 22 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 23 | id <- 1 24 | time <- 1749:1924 25 | datalong <- cbind(id, time, sunspots) 26 | 27 | #setup model 28 | model <- ctModel(type='ct', 29 | manifestNames='sunspots', 30 | latentNames=c('ss_level', 'ss_velocity'), 31 | LAMBDA=matrix(c( -1, 'ma1 | log(exp(-param)+1)' ), nrow=1, ncol=2), 32 | DRIFT=matrix(c(0, 'a21', 1, 'a22'), nrow=2, ncol=2), 33 | MANIFESTMEANS=matrix(c('m1 | (param)*5+44'), nrow=1, ncol=1), 34 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 35 | T0VAR=matrix(c(1,0,0,1), nrow=2, ncol=2), #Because single subject 36 | DIFFUSION=matrix(c(0.0001, 0, 0, "diffusion"), ncol=2, nrow=2)) 37 | 38 | #fit and plot importance sampling diagnostic 39 | fit <- ctStanFit(datalong, model,verbose=0, 40 | optimcontrol=list(is=TRUE, finishsamples=500),priors=TRUE) 41 | isdiag(fit) 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /man/log1p_exp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsemUtils.R 3 | \name{log1p_exp} 4 | \alias{log1p_exp} 5 | \title{log1p_exp} 6 | \usage{ 7 | log1p_exp(x) 8 | } 9 | \arguments{ 10 | \item{x}{value to use.} 11 | } 12 | \description{ 13 | Maps the stan function so the same code works in R. 14 | } 15 | \examples{ 16 | log1p_exp(-3) 17 | } 18 | -------------------------------------------------------------------------------- /man/longexample.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctDataHelp.R 3 | \name{longexample} 4 | \alias{longexample} 5 | \title{longexample} 6 | \format{ 7 | 7 by 8 matrix containing ctsem long format data, for two subjects, 8 | with three manifest variables Y1, Y2, Y3, 9 | one time dependent predictor TD1, two time independent predictors TI1 and TI2, 10 | and absolute timing information Time. 11 | } 12 | \description{ 13 | Simulated example dataset for the ctsem package 14 | } 15 | -------------------------------------------------------------------------------- /man/plot.ctFitCovCheck.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctCheckFit.R 3 | \name{plot.ctFitCovCheck} 4 | \alias{plot.ctFitCovCheck} 5 | \title{plot.ctFitCovCheck} 6 | \usage{ 7 | \method{plot}{ctFitCovCheck}(checkfit, maxlag = 10) 8 | } 9 | \arguments{ 10 | \item{checkfit}{Output from ctFitCovCheck.} 11 | 12 | \item{maxlag}{Maximum lag to plot.} 13 | } 14 | \value{ 15 | ggplot object. 16 | } 17 | \description{ 18 | Plot the results of ctFitCovCheck. 19 | } 20 | \examples{ 21 | \dontrun{ 22 | plot.ctFitCovCheck(ctCheckFit(ctstantestfit,cor=TRUE),maxlag=3) 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /man/plot.ctKalmanDF.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctKalman.R 3 | \name{plot.ctKalmanDF} 4 | \alias{plot.ctKalmanDF} 5 | \title{Plots Kalman filter output from ctKalman.} 6 | \usage{ 7 | \method{plot}{ctKalmanDF}( 8 | x, 9 | subjects = unique(x$Subject), 10 | kalmanvec = c("y", "yprior"), 11 | errorvec = "auto", 12 | errormultiply = 1.96, 13 | plot = TRUE, 14 | elementNames = NA, 15 | polygonsteps = 10, 16 | polygonalpha = 0.1, 17 | facets = "Variable", 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{x}{Output from \code{\link{ctKalman}}. In general it is easier to call 23 | \code{\link{ctKalman}} directly with the \code{plot=TRUE} argument, which calls this function.} 24 | 25 | \item{subjects}{vector of integers denoting which subjects (from 1 to N) to plot predictions for.} 26 | 27 | \item{kalmanvec}{string vector of names of any elements of the output you wish to plot, 28 | the defaults of 'y' and 'ysmooth' plot the original data, 'y', 29 | and the estimates of the 'true' value of y given all data. Replacing 'y' by 'eta' will 30 | plot latent states instead (though 'eta' alone does not exist) and replacing 'smooth' 31 | with 'upd' or 'prior' respectively plots updated (conditional on all data up to current time point) 32 | or prior (conditional on all previous data) estimates.} 33 | 34 | \item{errorvec}{vector of names indicating which kalmanvec elements to plot uncertainty bands for. 35 | 'auto' plots all possible.} 36 | 37 | \item{errormultiply}{Numeric denoting the multiplication factor of the std deviation of errorvec objects. 38 | Defaults to 1.96, for 95\% intervals.} 39 | 40 | \item{plot}{if FALSE, plots are not generated and the ggplot object is simply returned invisibly.} 41 | 42 | \item{elementNames}{if NA, all relevant object elements are included -- e.g. if yprior is in the kalmanvec 43 | argument, all manifest variables are plotted, and likewise for latent states if etasmooth was specified. 44 | Alternatively, a character vector specifying the manifest and latent names to plot explicitly can be specified.} 45 | 46 | \item{polygonsteps}{Number of steps to use for uncertainty band shading.} 47 | 48 | \item{polygonalpha}{Numeric for the opacity of the uncertainty region.} 49 | 50 | \item{facets}{when multiple subjects are included in multivariate plots, the default is to facet plots 51 | by variable type. This can be set to NA for no facets, or "Subject" for facetting by subject.} 52 | 53 | \item{...}{not used.} 54 | } 55 | \value{ 56 | A ggplot2 object. Side effect -- Generates plots. 57 | } 58 | \description{ 59 | Plots Kalman filter output from ctKalman. 60 | } 61 | \examples{ 62 | ### Get output from ctKalman 63 | x<-ctKalman(ctstantestfit,subjects=2,timestep=.01) 64 | 65 | ### Plot with plot.ctKalmanDF 66 | plot(x, subjects=2) 67 | 68 | ###Single step procedure: 69 | ctKalman(ctstantestfit,subjects=2, 70 | kalmanvec=c('y','yprior'), 71 | elementNames=c('Y1','Y2'), 72 | plot=TRUE,timestep=.01) 73 | } 74 | -------------------------------------------------------------------------------- /man/plot.ctStanFit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.ctStanFit.R 3 | \name{plot.ctStanFit} 4 | \alias{plot.ctStanFit} 5 | \alias{ctStanPlot} 6 | \title{plot.ctStanFit} 7 | \usage{ 8 | \method{plot}{ctStanFit}(x, types = "all", wait = TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{x}{Fit object from \code{\link{ctStanFit}}.} 12 | 13 | \item{types}{Vector of character strings defining which plots to create. 14 | 'all' plots all possible types, including: 'regression', 'kalman', 15 | 'priorcheck', 'trace', 'density','intervals'.} 16 | 17 | \item{wait}{Logical. Pause between plots?} 18 | 19 | \item{...}{Arguments to pass through to the specific plot functions. Bewar of clashes 20 | may occur if types='all'. For details see the specific functions generating each type of plot.} 21 | } 22 | \value{ 23 | Nothing. Generates plots. 24 | } 25 | \description{ 26 | Plots for ctStanFit objects 27 | } 28 | \details{ 29 | This function is just a wrapper calling the necessary functions for plotting - it 30 | may be simpler in many cases to access those directly. They are: 31 | \code{\link{ctStanDiscretePars}},\code{\link{ctKalman}}, 32 | \code{\link{ctStanPlotPost}},\code{stan_trace}, 33 | \code{stan_dens},\code{stan_plot} 34 | rstan offers many plotting possibilities not available here, to use that functionality 35 | one must simply call the relevant rstan plotting function. Use \code{x$stanfit} as the stan fit object 36 | (where x is the name of your ctStanFit object). Because a ctStanFit object has many 37 | parameters, the additional argument \code{pars=ctStanParnames(x,'pop_')} is recommended. 38 | This denotes population means, but see \code{\link{ctStanParnames}} for 39 | other options. 40 | } 41 | \examples{ 42 | \donttest{ 43 | plot(ctstantestfit,types=c('regression','kalman','priorcheck'), wait=FALSE) 44 | } 45 | } 46 | -------------------------------------------------------------------------------- /man/plot.ctStanModel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.ctStanModel.R 3 | \name{plot.ctStanModel} 4 | \alias{plot.ctStanModel} 5 | \title{Prior plotting} 6 | \usage{ 7 | \method{plot}{ctStanModel}( 8 | x, 9 | rows = "all", 10 | wait = FALSE, 11 | nsamples = 1e+06, 12 | rawpopsd = "marginalise", 13 | inddifdevs = c(-1, 1), 14 | inddifsd = 0.1, 15 | plot = TRUE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{ctStanModel object as generated by \code{\link{ctModel}} with type='ct' or 'dt'.} 21 | 22 | \item{rows}{vector of integers denoting which rows of ctstanmodel$pars to plot priors for. 23 | Character string 'all' plots all rows with parameters to be estimated.} 24 | 25 | \item{wait}{If true, user is prompted to continue before plotting next graph.} 26 | 27 | \item{nsamples}{Numeric. Higher values increase fidelity (smoothness / accuracy) of density plots, at cost of speed.} 28 | 29 | \item{rawpopsd}{Either 'marginalise' to sample from the specified (in the ctstanmodel) 30 | prior distribution for the raw population standard deviation, or a numeric value to use for the raw population standard deviation 31 | for all subject level prior plots - the plots in dotted blue or red.} 32 | 33 | \item{inddifdevs}{numeric vector of length 2, setting the means for the individual differences distributions.} 34 | 35 | \item{inddifsd}{numeric, setting the standard deviation of the population means used to generate individual 36 | difference distributions.} 37 | 38 | \item{plot}{If FALSE, ouputs list of GGplot objects that can be further modified.} 39 | 40 | \item{...}{not used.} 41 | } 42 | \description{ 43 | Plots priors for free model parameters in a ctStanModel. 44 | } 45 | \details{ 46 | Plotted in black is the prior for the population mean. In red and blue are the subject level priors that result 47 | given that the population mean is estimated as 1 std deviation above the mean of the prior, or 1 std deviation below. 48 | The distributions around these two points are then obtained by marginalising over the prior for the raw population std deviation - 49 | so the red and blue distributions do not represent any specific subject level prior, but rather characterise the general amount 50 | and shape of possible subject level priors at the specific points of the population mean prior. 51 | } 52 | \examples{ 53 | model <- ctModel(type='ct', 54 | manifestNames='sunspots', 55 | latentNames=c('ss_level', 'ss_velocity'), 56 | LAMBDA=matrix(c( 1, 'ma1' ), nrow=1, ncol=2), 57 | DRIFT=matrix(c(0, 1, 'a21', 'a22'), nrow=2, ncol=2, byrow=TRUE), 58 | MANIFESTMEANS=matrix(c('m1'), nrow=1, ncol=1), 59 | # MANIFESTVAR=matrix(0, nrow=1, ncol=1), 60 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 61 | DIFFUSION=matrix(c( 62 | 0, 0, 63 | 0, "diffusion"), ncol=2, nrow=2, byrow=TRUE)) 64 | 65 | plot(model,rows=8) 66 | } 67 | -------------------------------------------------------------------------------- /man/plotctACF.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctACF.R 3 | \name{plotctACF} 4 | \alias{plotctACF} 5 | \title{Plot an approximate continuous-time ACF object from ctACF} 6 | \usage{ 7 | plotctACF( 8 | ctacfobj, 9 | df = "auto", 10 | quantiles = c(0.025, 0.5, 0.975), 11 | separateLearnRates = FALSE, 12 | reducedXlim = 1, 13 | estimateSpline = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{ctacfobj}{object} 18 | 19 | \item{df}{df for the basis spline.} 20 | 21 | \item{quantiles}{quantiles to plot.} 22 | 23 | \item{separateLearnRates}{if TRUE, estimate the learning rate for the quantile splines for each combination of variables. Slower but theoretically more accurate.} 24 | 25 | \item{reducedXlim}{if non-zero, n timesteps are removed from the upper and lower end of the x range 26 | where the spline estimates are less likely to be reasonable.} 27 | 28 | \item{estimateSpline}{if TRUE, quantile spline regression is used, otherwise the samples are simply plotted as lines and the other arguments here are not used.} 29 | } 30 | \value{ 31 | a ggplot object 32 | } 33 | \description{ 34 | Plot an approximate continuous-time ACF object from ctACF 35 | } 36 | \examples{ 37 | data.table::setDTthreads(1) #ignore this line 38 | # Example usage: 39 | head(ctstantestdat) 40 | ac=ctACF(ctstantestdat,varnames=c('Y1'),idcol='id',timecol='time',timestep=.5,nboot=5,plot=FALSE) 41 | plotctACF(ac, reducedXlim=0) 42 | } 43 | -------------------------------------------------------------------------------- /man/sdpcor2cov.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sdpcor2cov.R 3 | \name{sdpcor2cov} 4 | \alias{sdpcor2cov} 5 | \title{sdcor2cov} 6 | \usage{ 7 | sdpcor2cov(mat, coronly = FALSE, cholesky = FALSE) 8 | } 9 | \arguments{ 10 | \item{mat}{input square matrix with std dev on diagonal and lower tri of partial correlations.} 11 | 12 | \item{coronly}{if TRUE, ignores everything except the lower triangle and outputs correlation.} 13 | 14 | \item{cholesky}{Logical. To return the cholesky decomposition instead of full covariance, set to TRUE.} 15 | } 16 | \description{ 17 | Converts a lower triangular matrix with standard deviations on the diagonal and partial correlations on 18 | lower triangle, to a covariance (or cholesky decomposed covariance) 19 | } 20 | \examples{ 21 | testmat <- diag(exp(rnorm(5,-3,2)),5) #generate arbitrary std deviations 22 | testmat[row(testmat) > col(testmat)] <- runif((5^2-5)/2, -1, 1) 23 | print(testmat) 24 | covmat <- sdpcor2cov(testmat) #convert to covariance 25 | cov2cor(covmat) #convert covariance to correlation 26 | } 27 | -------------------------------------------------------------------------------- /man/stanWplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stanWplot.R 3 | \name{stanWplot} 4 | \alias{stanWplot} 5 | \title{Runs stan, and plots sampling information while sampling.} 6 | \usage{ 7 | stanWplot(object, iter = 2000, chains = 4, ...) 8 | } 9 | \arguments{ 10 | \item{object}{stan model object} 11 | 12 | \item{iter}{Number of iterations} 13 | 14 | \item{chains}{Number of chains} 15 | 16 | \item{...}{All the other regular arguments to stan()} 17 | } 18 | \description{ 19 | Runs stan, and plots sampling information while sampling. 20 | } 21 | \details{ 22 | On windows, requires Rtools installed and able to be found by pkgbuild::rtools_path() 23 | } 24 | \examples{ 25 | library(rstan) 26 | #### example 1 27 | scode <- " 28 | parameters { 29 | real y[2]; 30 | } 31 | model { 32 | y[1] ~ normal(0, .5); 33 | y[2] ~ double_exponential(0, 2); 34 | } 35 | " 36 | #Uncomment the following lines -- launches rscript not compatible with cran check. 37 | #sm <- stan_model(model_code = scode) 38 | #fit1 <- stanWplot(object = sm,iter = 100000,chains=2,cores=1) 39 | } 40 | -------------------------------------------------------------------------------- /man/stan_checkdivergences.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stan_checkdivergences.R 3 | \name{stan_checkdivergences} 4 | \alias{stan_checkdivergences} 5 | \title{Analyse divergences in a stanfit object} 6 | \usage{ 7 | stan_checkdivergences(sf, nupars = "all") 8 | } 9 | \arguments{ 10 | \item{sf}{stanfit object.} 11 | 12 | \item{nupars}{either the string 'all', or an integer reflecting how many pars 13 | (from first to nupars) to use.} 14 | } 15 | \value{ 16 | A list of four matrices. $locationsort and $sdsort contian the bivariate interactions of 17 | unconstrained parameters, sorted by either the relative location of any divergences, or the relative standard deviation. 18 | $locationmeans and $sdmeans collapse across the bivariate interactions to return the means for each parameter. 19 | } 20 | \description{ 21 | Analyse divergences in a stanfit object 22 | } 23 | \examples{ 24 | \donttest{ 25 | sunspots<-sunspot.year 26 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 27 | id <- 1 28 | time <- 1749:1924 29 | datalong <- cbind(id, time, sunspots) 30 | 31 | #setup model 32 | ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 33 | manifestNames='sunspots', 34 | latentNames=c('ss_level', 'ss_velocity'), 35 | LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 36 | DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 37 | MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 38 | MANIFESTVAR=diag(0,1), #As per original spec 39 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 40 | DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 41 | 42 | #fit 43 | ssfit <- ctStanFit(datalong, ssmodel, iter=2, 44 | optimize=FALSE, chains=1) 45 | 46 | stan_checkdivergences(ssfit$stanfit$stanfit) #stan object 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /man/stan_reinitsf.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stanoptimis.R 3 | \name{stan_reinitsf} 4 | \alias{stan_reinitsf} 5 | \title{Quickly initialise stanfit object from model and data} 6 | \usage{ 7 | stan_reinitsf(model, data, fast = FALSE) 8 | } 9 | \arguments{ 10 | \item{model}{stanmodel} 11 | 12 | \item{data}{standata} 13 | 14 | \item{fast}{Use cut down form for speed} 15 | } 16 | \value{ 17 | stanfit object 18 | } 19 | \description{ 20 | Quickly initialise stanfit object from model and data 21 | } 22 | \examples{ 23 | sf <- stan_reinitsf(ctstantestfit$stanmodel,ctstantestfit$standata) 24 | } 25 | -------------------------------------------------------------------------------- /man/stan_unconstrainsamples.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stan_unconstrainsamples.R 3 | \name{stan_unconstrainsamples} 4 | \alias{stan_unconstrainsamples} 5 | \title{Convert samples from a stanfit object to the unconstrained scale} 6 | \usage{ 7 | stan_unconstrainsamples(fit, standata = NA) 8 | } 9 | \arguments{ 10 | \item{fit}{stanfit object.} 11 | 12 | \item{standata}{only necessary if R session has been restarted since fitting model -- used to reinitialize 13 | stanfit object.} 14 | } 15 | \value{ 16 | Matrix containing columns of unconstrained parameters for each post-warmup iteration. 17 | } 18 | \description{ 19 | Convert samples from a stanfit object to the unconstrained scale 20 | } 21 | \examples{ 22 | \donttest{ 23 | #get data 24 | sunspots<-sunspot.year 25 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 26 | id <- 1 27 | time <- 1749:1924 28 | datalong <- cbind(id, time, sunspots) 29 | 30 | #setup model 31 | ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 32 | manifestNames='sunspots', 33 | latentNames=c('ss_level', 'ss_velocity'), 34 | LAMBDA=matrix(c( 1, 'ma1| log(1+(exp(param)))' ), nrow=1, ncol=2), 35 | DRIFT=matrix(c(0, 'a21 | -log(1+exp(param))', 1, 'a22'), nrow=2, ncol=2), 36 | MANIFESTMEANS=matrix(c('m1|param * 10 + 44'), nrow=1, ncol=1), 37 | MANIFESTVAR=diag(0,1), #As per original spec 38 | CINT=matrix(c(0, 0), nrow=2, ncol=1), 39 | DIFFUSION=matrix(c(0, 0, 0, "diffusion"), ncol=2, nrow=2)) 40 | 41 | #fit 42 | ssfit <- ctStanFit(datalong, ssmodel, 43 | iter=200, chains=2,optimize=FALSE, priors=TRUE,control=list(max_treedepth=4)) 44 | umat <- stan_unconstrainsamples(ssfit$stanfit$stanfit) 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /man/standatact_specificsubjects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stanoptimis.R 3 | \name{standatact_specificsubjects} 4 | \alias{standatact_specificsubjects} 5 | \title{Adjust standata from ctsem to only use specific subjects} 6 | \usage{ 7 | standatact_specificsubjects(standata, subjects, timestep = NA) 8 | } 9 | \arguments{ 10 | \item{standata}{standata} 11 | 12 | \item{subjects}{vector of subjects} 13 | 14 | \item{timestep}{ignored at present} 15 | } 16 | \value{ 17 | list of updated structure 18 | } 19 | \description{ 20 | Adjust standata from ctsem to only use specific subjects 21 | } 22 | \examples{ 23 | d <- standatact_specificsubjects(ctstantestfit$standata, 1:2) 24 | } 25 | -------------------------------------------------------------------------------- /man/summary.ctStanFit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary.ctStanFit.R 3 | \name{summary.ctStanFit} 4 | \alias{summary.ctStanFit} 5 | \title{summary.ctStanFit} 6 | \usage{ 7 | \method{summary}{ctStanFit}( 8 | object, 9 | timeinterval = 1, 10 | digits = 4, 11 | parmatrices = TRUE, 12 | priorcheck = TRUE, 13 | residualcov = TRUE, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{object}{fit object from \code{\link{ctStanFit}}, of class ctStanFit.} 19 | 20 | \item{timeinterval}{positive numeric indicating time interval to use for discrete time parameter calculations 21 | reported in summary.} 22 | 23 | \item{digits}{integer denoting number of digits to report.} 24 | 25 | \item{parmatrices}{if TRUE, also return additional parameter matrices -- can be slow to compute 26 | for large models with many samples.} 27 | 28 | \item{priorcheck}{Whether or not to use \code{ctsem:::priorchecking} to compare posterior mean and sd to prior mean and sd.} 29 | 30 | \item{residualcov}{Whether or not to show standardised residual covariance. Takes a little longer to compute.} 31 | 32 | \item{...}{Additional arguments to pass to \code{ctsem:::priorcheckreport}, such as \code{meanlim}, or \code{sdlim}.} 33 | } 34 | \value{ 35 | List containing summary items. 36 | } 37 | \description{ 38 | Summarise a ctStanFit object that was fit using \code{\link{ctStanFit}}. 39 | } 40 | \examples{ 41 | summary(ctstantestfit) 42 | } 43 | -------------------------------------------------------------------------------- /man/test_isclose.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ctsem-package.R 3 | \name{test_isclose} 4 | \alias{test_isclose} 5 | \title{Tests if 2 values are close to each other} 6 | \usage{ 7 | test_isclose(..., tol = 1e-08) 8 | } 9 | \arguments{ 10 | \item{...}{values to compare} 11 | 12 | \item{tol}{tolerance} 13 | } 14 | \value{ 15 | Logical or testthat output. 16 | } 17 | \description{ 18 | Tests if 2 values are close to each other 19 | } 20 | \examples{ 21 | test_isclose(1,1.0000001, tol=1e-4) 22 | } 23 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(ctsem) 3 | pdf(NULL) 4 | test_check("ctsem") 5 | -------------------------------------------------------------------------------- /tests/testthat/ctBinaryBinaryMix.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | library(ctsem) 3 | library(testthat) 4 | 5 | context("ctBinaryBinaryMix") #develop some expectations here! 6 | 7 | test_that("ctBinaryBinaryMix1", { 8 | set.seed( 1234 ) 9 | cores=2 10 | 11 | invlog=function (x) exp(x)/(1 + exp(x)) 12 | 13 | #gen data 14 | gm <- ctModel(DRIFT= c(-.2, .2, 15 | 0,-.1), 16 | DIFFUSION=c(.3,0, 17 | 0,.4), 18 | CINT=c(.1,.1), 19 | # TRAITVAR=diag(.3,2), #old approach to allow individual variation 20 | LAMBDA= diag(1,2), 21 | n.latent=2,n.manifest=2,Tpoints=200) 22 | 23 | d=ctGenerate(gm,n.subjects = 50,logdtsd=.1,dtmean = .1,burnin = 20) 24 | d[,gm$manifestNames[1]] <- rbinom(nrow(d),size=1,prob=invlog(d[,gm$manifestNames[1]])) 25 | d=data.frame(d) 26 | for(i in 1:10){ 27 | d[[paste0('b',i)]] <- rbinom(nrow(d),size=1,prob=invlog(d[,gm$manifestNames[2]])) 28 | } 29 | 30 | # plot(invlog(d[,gm$manifestNames[2]])[1:100],type='l',col=2) 31 | # points( apply(d[,paste0('b',1:10)],1,function(x) mean(x))[1:100],type='l') 32 | 33 | MANIFESTVAR = diag(c(1,rep(0,10)),11) 34 | MANIFESTVAR[1]='mvar1' 35 | m <- ctModel(type='stanct', 36 | manifestNames = c('Y1',paste0('b',1:10)), 37 | LAMBDA=rbind(diag(1,2),cbind(rep(0,9),rep(1,9))), 38 | MANIFESTMEANS = 0, 39 | MANIFESTVAR = MANIFESTVAR, 40 | CINT=c('CINT1','cint2')) 41 | m$manifesttype[1:11]=1 #set type to binary 42 | m$pars$indvarying=F 43 | 44 | #fit with integration (linearised approximation) 45 | f <- ctStanFit( datalong = d, ctstanmodel = m,cores=cores,plot=10) 46 | 47 | #test if the estimated model pars 95% confidence intervals contain true pars 48 | lowmats <- ctStanContinuousPars(f,calcfuncargs = list(probs=.025)) 49 | upmats <- ctStanContinuousPars(f,calcfuncargs = list(probs=.975)) 50 | 51 | gmn <- ctsem:::ctModeltoNumeric(gm) 52 | gmn$DIFFUSIONcov <- tcrossprod(gmn$DIFFUSION) 53 | 54 | mats <- c('DRIFT','DIFFUSIONcov','CINT') 55 | for(i in 1:length(mats)){ 56 | expect_true(all(lowmats[[mats[i]]] < gmn[[mats[i]]] & upmats[[mats[i]]] > gmn[[mats[i]]])) 57 | } 58 | 59 | }) 60 | 61 | } 62 | -------------------------------------------------------------------------------- /tests/testthat/ctBinaryGaussianMix.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | library(ctsem) 3 | library(testthat) 4 | 5 | context("ctBinaryGaussianMix") #develop some expectations here! 6 | 7 | test_that("ctBinaryGaussianMix1", { 8 | set.seed( 1234 ) 9 | cores=2 10 | 11 | invlog=function (x) exp(x)/(1 + exp(x)) 12 | 13 | #gen data 14 | gm <- ctModel(DRIFT= c(-.2, .2, 15 | 0,-.1), 16 | DIFFUSION=c(.3,0, 17 | 0,.4), 18 | CINT=c(.1,.1), 19 | # TRAITVAR=diag(.3,2), #old approach to allow individual variation 20 | LAMBDA= diag(1,2), 21 | n.latent=2,n.manifest=2,Tpoints=50) 22 | 23 | d=ctGenerate(gm,n.subjects = 50,logdtsd=.2,dtmean = .2,burnin = 20) 24 | d[,gm$manifestNames[1]] <- d[,gm$manifestNames[1]] + rnorm(nrow(d),0,.2) 25 | d=data.frame(d) 26 | for(i in 1:10){ 27 | d[[paste0('b',i)]] <- rbinom(nrow(d),size=1,prob=invlog(d[,gm$manifestNames[2]])) 28 | } 29 | 30 | # plot(invlog(d[,gm$manifestNames[2]])[1:100],type='l',col=2) 31 | # points( apply(d[,paste0('b',1:10)],1,function(x) mean(x))[1:100],type='l') 32 | 33 | MANIFESTVAR = diag(c(1,rep(0,10)),11) 34 | MANIFESTVAR[1]='mvar1' 35 | m <- ctModel(type='stanct', 36 | manifestNames = c('Y1',paste0('b',1:10)), 37 | LAMBDA=rbind(diag(1,2),cbind(rep(0,9),rep(1,9))), 38 | MANIFESTMEANS = 0, 39 | MANIFESTVAR = MANIFESTVAR, 40 | CINT=c('CINT1','cint2')) 41 | m$manifesttype[2:11]=1 #set type to binary 42 | m$pars$indvarying=F 43 | 44 | #fit with integration (linearised approximation) 45 | f <- ctStanFit( datalong = d, ctstanmodel = m,cores=cores,plot=10) 46 | 47 | #test if the estimated model pars 95% confidence intervals contain true pars 48 | lowmats <- ctStanContinuousPars(f,calcfuncargs = list(probs=.025)) 49 | upmats <- ctStanContinuousPars(f,calcfuncargs = list(probs=.975)) 50 | 51 | gmn <- ctsem:::ctModeltoNumeric(gm) 52 | gmn$DIFFUSIONcov <- tcrossprod(gmn$DIFFUSION) 53 | 54 | mats <- c('DRIFT','DIFFUSIONcov','CINT') 55 | for(i in 1:length(mats)){ 56 | expect_true(all(lowmats[[mats[i]]] < gmn[[mats[i]]] & upmats[[mats[i]]] > gmn[[mats[i]]])) 57 | } 58 | 59 | }) 60 | 61 | } 62 | -------------------------------------------------------------------------------- /tests/testthat/test-bivariatetrait_hmc.R: -------------------------------------------------------------------------------- 1 | if(F){ 2 | library(ctsem) 3 | gm <- ctModel(LAMBDA=diag(2), #diagonal factor loading, 2 latents 2 observables 4 | Tpoints = 7, 5 | DRIFT=matrix(c(-1,.5,0,-1),2,2), #temporal dynamics 6 | MANIFESTVAR=diag(.2,2), #measurement error 7 | TRAITVAR = diag(.5,2), #stable latent intercept variance (cholesky factor) 8 | DIFFUSION=diag(2)) #within person covariance 9 | 10 | ctModelLatex(gm) #to view latex system equations 11 | 12 | #when generating data, free pars are set to 0 13 | d <- data.frame(ctGenerate(ctmodelobj = gm,n.subjects = 100,logdtsd = .1, 14 | burnin = 20,dtmean = 1)) 15 | 16 | 17 | d$Y2 <- d$Y2 + rnorm(nrow(d),0,.2) #gaussian measurement error 18 | # d$Y2binary <-rbinom(n = nrow(d),size = 1, #create binary data based on the latent 19 | # prob = ctsem::inv_logit(d$Y2)) 20 | d$Y1 <- d$Y1 + rnorm(nrow(d),0,.2) #gaussian measurement error 21 | 22 | m <- ctModel(LAMBDA=diag(2),type='omx',TRAITVAR='auto',Tpoints=7, 23 | manifestNames = c('Y1','Y2')) 24 | ms <- ctStanModel(m) 25 | 26 | system.time({f <- ctStanFit(datalong = d,ctstanmodel = ms,cores=2,priors = F)}) 27 | 28 | library(ctsemOMX) 29 | system.time({fo<-ctsemOMX::ctFit(ctmodelobj = m,dat = d,stationary = NULL)}) 30 | 31 | s=summary(f) 32 | s 33 | 34 | f2 <- ctStanFit(datalong = d,ctstanmodel = m,cores=6,optimize=F,chains=4,intoverpop = F) 35 | s2=summary(f2) 36 | f3 <- ctStanFit(datalong = d,ctstanmodel = m,cores=6,optimize=F,chains=4,intoverpop = F,intoverstates = F) 37 | s3=summary(f3) 38 | } 39 | -------------------------------------------------------------------------------- /tests/testthat/test-bootHessian.R: -------------------------------------------------------------------------------- 1 | if(FALSE){ 2 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 3 | 4 | 5 | # library(future) 6 | # library(data.table) 7 | # plan(strategy = 'multisession',workers=10) 8 | 9 | testfunc <- function(i){ 10 | message(i) 11 | nsubjects=200 12 | t0m <- 10+rnorm(nsubjects) 13 | cint <- t0m/2+rnorm(nsubjects) 14 | # cor(t0m,cint) 15 | for(subi in 1:nsubjects){ 16 | gm <- suppressMessages(ctModel(Tpoints=10, 17 | LAMBDA=matrix(1), 18 | DRIFT= -1, 19 | T0MEANS = t0m[subi], 20 | DIFFUSION=.5, 21 | MANIFESTVAR = 0.5, 22 | T0VAR = 0, 23 | MANIFESTMEANS = 0, 24 | CINT=cint[subi])) 25 | 26 | dd <- suppressMessages(data.frame(ctGenerate(ctmodelobj = gm,n.subjects = 1, 27 | burnin = 0,dtmean = 1,logdtsd = 0))) 28 | dd$id <- subi 29 | if(subi==1) d <- dd else d <- rbind(d,dd) 30 | } 31 | 32 | m <- ctModel(type='ct',LAMBDA=matrix(1),CINT='cint',MANIFESTMEANS=0) 33 | # m$pars$indvarying=F 34 | 35 | f <- ctStanFit(datalong = d,ctstanmodel = m,cores=1,priors=TRUE,optimcontrol=list(carefulfit=F,stochastic=F,finishsamples=5000)) 36 | s=summary(f) 37 | # print(s) 38 | 39 | scores=t(ctsem:::scorecalc(standata = f$standata,est = f$stanfit$rawest,stanmodel = f$stanmodel,subjectsonly = T,cores=1)) 40 | 41 | fc <- ctStanFit(datalong = d,ctstanmodel = m,cores=1,priors=TRUE,optimcontrol=list(carefulfit=F,stochastic=F,finishsamples=5000,bootstrapUncertainty=F)) 42 | sc=summary(fc) 43 | # print(sc) 44 | 45 | # print(sc$popmeans) 46 | # print(s$popmeans) 47 | colnames(sc$popmeans) <- paste0(colnames(sc$popmeans),'c') 48 | colnames(sc$rawpopcorr) <- paste0(colnames(sc$rawpopcorr),'c') 49 | colnames(sc$popsd) <- paste0(colnames(sc$popsd),'c') 50 | dt=data.frame(rbind(s$popmeans,s$popsd,s$rawpopcorr[,1:5]),rbind(sc$popmeans,sc$popsd,sc$rawpopcorr[,1:5])) 51 | rownames(dt)=c(rownames(s$popmeans),paste0('popsd_',rownames(s$popsd)),rownames(s$rawpopcorr)) 52 | return(dt) 53 | } 54 | 55 | out <- list() 56 | for(i in 1:100){ 57 | out[[i]] <- future(testfunc(i)) 58 | } 59 | out <- value(out) 60 | 61 | 62 | truepars <- out[[1]][,'mean',drop=FALSE] 63 | truepars[] <- c(10,-1,2,.5,5,1,1.116,.45) 64 | 65 | out <- lapply(1:length(out),function(o) data.frame(run=o,par=rownames(out[[o]]),out[[o]])) 66 | outdt <- rbindlist(out) 67 | outdtb <- data.frame(outdt)[,colnames(outdt)[!grepl('c$',colnames(outdt))]] 68 | outdtc <- data.frame(outdt)[,c('run','par',colnames(outdt)[grepl('c$',colnames(outdt))])] 69 | colnames(outdtc)=gsub('c$','',colnames(outdtc)) 70 | outdt <- rbind(data.table(type='bootstrap',outdtb),data.table(type='classic',outdtc)) 71 | outdt <- melt(outdt,id.vars = c('type','par','run')) 72 | require(ggplot2) 73 | ggplot(outdt[variable %in% c('X97.5.','X2.5.','X50.'),],aes(x=variable,y=value,col=type,group=interaction(run,type)))+ 74 | geom_jitter(alpha=.5,width=.2,height=0)+geom_line(alpha=.2)+theme_bw()+ 75 | geom_hline(aes(yintercept=value),data=data.frame(par=rownames(truepars),value=truepars$mean))+ 76 | facet_wrap(vars(par),scales = 'free') 77 | 78 | 79 | covered <- lapply(out,function(x) data.table( 80 | b= truepars > x$`X2.5.` & truepars < x$`X97.5.`, 81 | c= truepars > x$`X2.5.c` & truepars < x$`X97.5.c`)) 82 | 83 | coverage <- as.matrix(covered[[1]]) 84 | for(i in 1:nrow(coverage)){ 85 | for(j in 1:ncol(coverage)){ 86 | coverage[i,j]<-sum(sapply(covered,function(x) as.matrix(x)[i,j]))/length(out) 87 | } 88 | } 89 | rownames(coverage) <- rownames(truepars) 90 | # print(coverage) 91 | 92 | 93 | 94 | } 95 | } 96 | -------------------------------------------------------------------------------- /tests/testthat/test-corrcheck.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | library(ctsem) 3 | library(testthat) 4 | cores=2 5 | 6 | # context("corrCheck") 7 | 8 | #anomauth 9 | test_that("corrCheck", { 10 | set.seed(1) 11 | gm <- ctModel(LAMBDA = diag(1,3),DRIFT=diag(-1,3), 12 | T0VAR=matrix(c(5,-5,-5,0,1,-1,0,0,2),3,3), 13 | MANIFESTTRAITVAR=matrix(c(2,-1,-1, 0,1,1,0,0,2),3,3), 14 | DIFFUSION=matrix(c(2,1,1,0,4,-2,0,0,2),3,3),Tpoints=30) 15 | d <- ctGenerate(ctmodelobj = gm,n.subjects = 600,burnin = 0) 16 | 17 | m <- ctModel(LAMBDA = diag(1,3),DRIFT=diag(-1,3),type='ct', 18 | # MANIFESTMEANS = 0, 19 | MANIFESTVAR = 0) 20 | 21 | f <- ctStanFit(datalong = d,ctstanmodel = m,priors=T,verbose=0,cores=cores) 22 | 23 | p <- ctStanContinuousPars(f) 24 | 25 | diffcov <- p$DIFFUSIONcov 26 | diffcor <- cov2cor(p$DIFFUSIONcov) 27 | ediffcov <- tcrossprod(gm$DIFFUSION) 28 | ediffcor <- cov2cor(tcrossprod(gm$DIFFUSION)) 29 | 30 | s=summary(f) 31 | s$rawpopcorr 32 | f$stanfit$transformedparsfull$rawpopcorr[1,,] 33 | tcrossprod(gm$MANIFESTTRAITVAR) 34 | cov2cor(tcrossprod(gm$MANIFESTTRAITVAR)) 35 | 36 | #check diagonal of 1's for corr 37 | test_isclose(diag(f$stanfit$transformedparsfull$rawpopcorr[1,,]), 38 | rep(1,nrow(f$stanfit$transformedparsfull$rawpopcorr[1,,])),tol=1e-3) 39 | 40 | #cov check 41 | test_isclose(f$stanfit$transformedparsfull$popcov[1,4:6,4:6], 42 | tcrossprod(gm$MANIFESTTRAITVAR),tol=1) 43 | 44 | #cor check 45 | test_isclose(f$stanfit$transformedparsfull$rawpopcorr[1,4:6,4:6], 46 | cov2cor(tcrossprod(gm$MANIFESTTRAITVAR)),tol=.1) 47 | 48 | 49 | }) 50 | 51 | if(FALSE) test_that("corrCheckHighDim", { 52 | set.seed(1) 53 | 54 | cmat <- diag(.5,10) + 1 55 | cmat=t(chol(cmat %*% t(cmat))) 56 | 57 | cmat2 <- diag(.5,10) + 1 58 | cmat2[5:10,] <- cmat2[5:10,] * -1 59 | cmat2=t(chol(cmat2 %*% t(cmat2))) 60 | cov2cor(tcrossprod(cmat2)) 61 | 62 | gm <- ctModel(LAMBDA = diag(1,10),DRIFT=diag(-1,10), 63 | T0VAR=cmat, 64 | DIFFUSION=diag(1,10),Tpoints=2) 65 | d1 <- data.frame(ctGenerate(ctmodelobj = gm,n.subjects = 1000,burnin = 0)) 66 | 67 | gm <- ctModel(LAMBDA = diag(1,10),DRIFT=diag(-1,10), 68 | T0VAR=cmat2, 69 | DIFFUSION=diag(1,10),Tpoints=2) 70 | d2 <- data.frame(ctGenerate(ctmodelobj = gm,n.subjects = 1000,burnin = 0)) 71 | 72 | d2$id <- d2$id + 2000 73 | d <- rbind(d1,d2) 74 | d$TI1 <- 0 75 | d$TI1[d$id > 2000] <- 1 76 | 77 | 78 | 79 | 80 | m <- ctModel(LAMBDA = diag(1,10),DRIFT=diag(-1,10),type='dt', 81 | # MANIFESTMEANS = 0, 82 | DIFFUSION=diag(1,10),T0MEANS=0, 83 | TIpredNames = 'TI1', 84 | MANIFESTMEANS=0, 85 | MANIFESTVAR = 0) 86 | 87 | f <- ctStanFit(datalong = d,ctstanmodel = m,priors=TRUE,cores=cores,verbose=0) 88 | 89 | p <- ctStanContinuousPars(f) 90 | 91 | t0cov <- p$T0cov 92 | t0cor <- cov2cor(t0cov) 93 | et0cov <- tcrossprod(gm$T0VAR) 94 | et0cor <- cov2cor(tcrossprod(gm$T0VAR)) 95 | 96 | f$stanfit$rawposterior=f$stanfit$rawposterior[1:5,] 97 | 98 | e=ctExtract(f,subjectMatrices = T,cores=1) 99 | cov2cor(e$subj_T0cov[1,1,,]) 100 | cov2cor(e$subj_T0cov[1,301,,]) 101 | 102 | 103 | #cov check 104 | test_isclose(cov2cor(e$subj_T0cov[1,1001,,]), 105 | cov2cor(tcrossprod(cmat2)),tol=.005) 106 | 107 | #cor check 108 | test_isclose(cov2cor(e$subj_T0cov[1,1,,]), 109 | cov2cor(tcrossprod(cmat)),tol=.005) 110 | 111 | 112 | }) 113 | } 114 | 115 | -------------------------------------------------------------------------------- /tests/testthat/test-ctRaschExampleTest.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | library(ctsem) 3 | library(testthat) 4 | 5 | context("ctRasch") #develop some expectations here! 6 | 7 | test_that("ctRasch1", { 8 | set.seed( 1234 ) 9 | cores=2 10 | 11 | invlog=function (x) exp(x)/(1 + exp(x)) 12 | n.manifest=7 13 | 14 | #gen data 15 | gm <- ctModel(DRIFT=-.3, DIFFUSION=.3, CINT=.1, 16 | TRAITVAR=diag(.3,1), #old approach to allow individual variation 17 | LAMBDA= rep(1,each=n.manifest), 18 | n.latent=1,n.manifest=n.manifest,Tpoints=20, 19 | MANIFESTMEANS=c(0,rep(c(.5,-.5),each=(n.manifest-1)/2)),T0MEANS=-.3,T0VAR=.5) 20 | 21 | d=ctGenerate(gm,n.subjects = 20,logdtsd=.2) 22 | d[,gm$manifestNames] <- rbinom(nrow(d)*gm$n.manifest,size=1,prob=invlog(d[,gm$manifestNames])) 23 | 24 | #model to fit 25 | m <- ctModel( n.latent = 1, 26 | n.manifest = n.manifest, 27 | MANIFESTMEANS = c(0,paste0('m',2:n.manifest,'|param|FALSE')), #set prior to N(0,1), disable individual variation 28 | LAMBDA = rep(1,n.manifest), 29 | DIFFUSION='diff|log1p_exp(2*param)', 30 | T0MEANS='t0m|param|TRUE|.2', 31 | CINT = 'b|param|TRUE|1', #use standard normal for mean prior, individual variation = TRUE (default), default scale for sd 32 | type = "ct" ) 33 | 34 | md <- ctModel( n.latent = 1, 35 | n.manifest = n.manifest, 36 | MANIFESTMEANS = c(0,paste0('m',2:n.manifest,'|param|FALSE')), #set prior to N(0,1), disable individual variation 37 | LAMBDA = rep(1,n.manifest), 38 | DIFFUSION='diff|log1p_exp(2*param)', 39 | T0MEANS='t0m|param|TRUE|.2', 40 | CINT = 'b|param|TRUE|1', #use standard normal for mean prior, individual variation = TRUE (default), default scale for sd 41 | type = "dt" ) 42 | 43 | m$manifesttype[]=md$manifesttype[]=1 #set type to binary 44 | 45 | #fit with integration (linearised approximation) 46 | ro <- ctStanFit( datalong = d, 47 | ctstanmodel = m,cores=cores, 48 | # plot=10,verbose=0, 49 | intoverstates = T,priors=F, 50 | optimize=T,intoverpop=T)#,optimcontrol=list(stochastic=F)) 51 | so=summary(ro) 52 | 53 | 54 | rod <- ctStanFit( datalong = d, 55 | ctstanmodel = md,cores=cores, 56 | # plot=10,verbose=0, 57 | intoverstates = T,priors=F, 58 | optimize=T,intoverpop=T)#,optimcontrol=list(stochastic=F)) 59 | sod=summary(rod) 60 | 61 | #fit without integration 62 | r <- ctStanFit( datalong = d, 63 | #fit=FALSE, #set this to skip fitting and just get the standata and stanmodel objects 64 | ctstanmodel = m, 65 | iter = 300,verbose=0, 66 | control=list(max_treedepth=8), 67 | priors=TRUE, 68 | chains = cores,plot=FALSE, 69 | intoverstates = FALSE, 70 | optimize=FALSE,intoverpop=FALSE) 71 | s=summary(r) 72 | 73 | a=cbind(s$popmeans[order(rownames(s$popmeans)),1,drop=FALSE],so$popmeans[order(rownames(so$popmeans)),1]) 74 | colnames(a)=NULL 75 | # print(a) 76 | 77 | test_isclose( 78 | s$popmeans[order(rownames(s$popmeans)),1], 79 | so$popmeans[order(rownames(so$popmeans)),1],tol=.2) 80 | 81 | }) 82 | 83 | } 84 | -------------------------------------------------------------------------------- /tests/testthat/test-fixedvalsunspot.R: -------------------------------------------------------------------------------- 1 | if(1==0){ 2 | library(ctsem) 3 | 4 | sunspot<-sunspot.year 5 | sunspot<-sunspot[50: (length(sunspot)-(1988-1924))] 6 | id <- 1 7 | time <- 1749:1924 8 | datalong <- cbind(id, time, sunspot) 9 | 10 | TT=176 11 | 12 | model1 <- ctModel(type='omx', n.latent = 2, n.manifest = 1, Tpoints = TT, 13 | LAMBDA = matrix(c(1, .6), nrow = 1, ncol = 2,byrow=TRUE), 14 | manifestNames = 'sunspot', 15 | DRIFT = matrix(c( 16 | 0, 1, 17 | -.3, -.35 18 | ),nrow =2, ncol = 2,byrow=TRUE), 19 | MANIFESTMEANS = matrix(c(46),nrow=1,ncol=1), 20 | MANIFESTVAR = matrix(c( 21 | 0), nrow=1, ncol=1), 22 | CINT =matrix(c(0,0),nrow=2,ncol=1), 23 | T0MEANS=matrix(c(0,0),nrow=2,ncol=1), 24 | T0VAR=diag(10,2), 25 | PARS=matrix('p'), 26 | DIFFUSION=matrix(c(0,0, 27 | 0,16),ncol=2,nrow=2,byrow=TRUE)) 28 | 29 | 30 | 31 | summary(fit1$mxobj) 32 | sqrt(fit1$mxobj$DIFFUSION$values[2,2]) 33 | 34 | 35 | sm <- ctStanModel(model1) 36 | 37 | ssfit<-ctStanFit(datalong=datalong, ctstanmodel=sm, forcerecompile = T, 38 | verbose=0,optimize=T,#optimcontrol=list(estonly=T), 39 | # nlcontrol=list(nldynamics=F, nlmeasurement=F,ukffull=1,ukfspread=1e-1), 40 | chains=1,priors=TRUE) 41 | 42 | } 43 | 44 | -------------------------------------------------------------------------------- /tests/testthat/test-intervalise.R: -------------------------------------------------------------------------------- 1 | library(ctsem) 2 | library(testthat) 3 | 4 | context("intervalise") 5 | 6 | test_that("intervals", { 7 | data('longexample') 8 | 9 | #Then convert to wide format 10 | wideexample <- ctLongToWide(datalong = longexample, id = "id", 11 | time = "time", manifestNames = c("Y1", "Y2", "Y3"), 12 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2")) 13 | 14 | #Then convert the absolute times to intervals, using the Tpoints reported from the prior step. 15 | wide <- ctIntervalise(datawide = wideexample, Tpoints = 4, n.manifest = 3, 16 | n.TDpred = 1, n.TIpred = 2, manifestNames = c("Y1", "Y2", "Y3"), 17 | TDpredNames = "TD1", TIpredNames = c("TI1", "TI2") ) 18 | 19 | dt <- matrix(t(diff(t(wideexample[,paste0('T',0:2)]))), nrow=2,ncol=2, 20 | dimnames = list(c("1", "2"), c("dT1", "dT2"))) 21 | dt[1,2] = .001 22 | expect_equal(wide[,c('dT1','dT2')], dt) 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-knownFits.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | 3 | 4 | context("knownFits") 5 | 6 | #anomauth 7 | test_that("anomauth", { 8 | 9 | 10 | if( .Machine$sizeof.pointer != 4){ 11 | library(ctsem) 12 | library(testthat) 13 | 14 | cores=2 15 | #library(ctsem);cores=12 16 | 17 | data(AnomAuth) 18 | AnomAuthmodel<-ctModel(LAMBDA=matrix(c(1, 0, 0, 1), nrow=2, ncol=2), 19 | n.latent=2,n.manifest=2, 20 | MANIFESTVAR=diag(0,2), 21 | Tpoints=5) 22 | 23 | sm1 <- ctStanModel(AnomAuthmodel) 24 | sm1$pars$indvarying<- FALSE 25 | a=Sys.time() 26 | # sink('bad.txt') 27 | sf=ctStanFit(ctDeintervalise(ctWideToLong(AnomAuth,Tpoints = AnomAuthmodel$Tpoints,n.manifest = 2)), 28 | ctstanmodel = sm1, optimize=TRUE,verbose=0,savescores = FALSE,cores=cores) 29 | # sink() 30 | print(Sys.time()-a) 31 | test_isclose(23415.929,-2*sf$stanfit$optimfit$value,tol=.01) 32 | anoms=summary(sf) 33 | anoms$popmeans['mm_Y1','sd'] 34 | test_isclose(.036,anoms$popmeans['mm_Y1','sd'],tol=.01) 35 | } 36 | 37 | }) 38 | 39 | 40 | 41 | test_that("oscillator", { 42 | data("Oscillating") 43 | 44 | inits <- c(-39.5, -.5, .1, 1, 0, 1, 0.05, .9) 45 | names(inits) <- c("crosseffect","autoeffect", "diffusion", 46 | "T0var11", "T0var21", "T0var22","m1", "m2") 47 | 48 | oscillatingm <- ctModel(n.latent = 2, n.manifest = 1, Tpoints = 11, 49 | MANIFESTVAR = matrix(c(0), nrow = 1, ncol = 1), 50 | LAMBDA = matrix(c(1, 0), nrow = 1, ncol = 2), 51 | T0MEANS = matrix(c('m1', 'm2'), nrow = 2, ncol = 1), 52 | T0VAR = matrix(c("T0var11", "T0var21", 0, "T0var22"), nrow = 2, ncol = 2), 53 | DRIFT = matrix(c(1e-5, "crosseffect", 1, "autoeffect"), nrow = 2, ncol = 2), 54 | CINT = matrix(0, ncol = 1, nrow = 2), 55 | DIFFUSION = matrix(c(0, 0, 0, "diffusion"), nrow = 2, ncol = 2))#, 56 | # startValues = inits) 57 | 58 | if( .Machine$sizeof.pointer != 4){ 59 | oscillatingm$DRIFT[2,1]="crosseffect|-log1p(exp(-param))-1e-5" 60 | sm <- ctStanModel(oscillatingm) 61 | sm$pars$indvarying<- FALSE 62 | sf=ctStanFit(ctDeintervalise(ctWideToLong(Oscillating,Tpoints = oscillatingm$Tpoints,n.manifest = 1)), 63 | cores=2,verbose=0, 64 | # optimcontrol=list(carefulfit=T), 65 | ctstanmodel = sm, optimize=TRUE,savescores = FALSE,priors=FALSE) 66 | expect_equal(-3461.936,-2*sf$stanfit$optimfit$value,tolerance=.01) 67 | 68 | } 69 | 70 | }) 71 | 72 | } 73 | -------------------------------------------------------------------------------- /tests/testthat/test-nonlinearVlinear.R: -------------------------------------------------------------------------------- 1 | if(1==99 && .Machine$sizeof.pointer != 4){ #test is no longer useful with everything done via nonlinear 2 | library(ctsem) 3 | library(testthat) 4 | set.seed(1) 5 | 6 | context("nonlinearcheck") 7 | 8 | test_that("simplenonlinearcheck", { 9 | sunspots<-sunspot.year 10 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 11 | id <- 1 12 | time <- 1749:1924 13 | datalong <- cbind(id, time, sunspots) 14 | 15 | #setup model 16 | ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 17 | # n.TDpred = 1, 18 | manifestNames='sunspots', 19 | latentNames=c('ss_level', 'ss_velocity'), 20 | LAMBDA=matrix(c( 1, 'ma1|log1p(exp(param))'), nrow=1, ncol=2), 21 | DRIFT=matrix(c(0, 'a21|-log1p(exp(param))', 1, 'a22'), nrow=2, ncol=2), 22 | TDPREDEFFECT=matrix(c('tdeffect',0),2), 23 | MANIFESTMEANS=matrix(c('mm|param*10+44'), nrow=1, ncol=1), 24 | MANIFESTVAR=diag(0,1), 25 | T0VAR=matrix(c(1,0,0,1), nrow=2, ncol=2), #Because single subject 26 | DIFFUSION=matrix(c(0, 0, 0, 'diff'), ncol=2, nrow=2)) 27 | 28 | #td preds for testing only -- no real effect 29 | TD1 <- 0 30 | datalong <- cbind(datalong,TD1) 31 | datalong[seq(10,150,10),'TD1'] = 1 32 | 33 | ssfitnl <- ctStanFit(datalong, ssmodel, iter=300, cores=1,optimize=T,verbose=0,maxtimestep = .3, priors=TRUE,deoptim=FALSE) 34 | ssfitl <- ctStanFit(datalong, ssmodel, iter=300, chains=1,optimize=T,verbose=0,priors=TRUE) 35 | 36 | ssfitnlm <- ctStanFit(datalong, ssmodel, iter=300, chains=1,optimize=T,verbose=0,maxtimestep = 2,fit=T,priors=TRUE) 37 | 38 | #output 39 | # snl=summary(ssfitnl) 40 | # snlm=summary(ssfitnlm) 41 | # sl=summary(ssfitl) 42 | 43 | # expect_equal(snl$popmeans[,'mean'], sl$popmeans[,'mean']) 44 | expect_equal(ssfitnl$stanfit$rawest,ssfitl$stanfit$rawest,tol=1e-2) 45 | expect_equal(ssfitnl$stanfit$rawest,ssfitnlm$stanfit$rawest,tol=1e-2) 46 | 47 | expect_equal(ssfitnl$stanfit$optimfit$value,ssfitnlm$stanfit$optimfit$value,tol=1e-2) 48 | expect_equal(ssfitnl$stanfit$optimfit$value,ssfitl$stanfit$optimfit$value,tol=1e-2) 49 | 50 | cbind(ssfitnl$stanfit$rawest,ssfitl$stanfit$rawest,ssfitnlm$stanfit$rawest) 51 | c(ssfitnl$stanfit$optimfit$value,ssfitl$stanfit$optimfit$value,ssfitnlm$stanfit$optimfit$value) 52 | 53 | }) 54 | } 55 | -------------------------------------------------------------------------------- /tests/testthat/test-reshaping.R: -------------------------------------------------------------------------------- 1 | library(ctsem) 2 | library(testthat) 3 | 4 | context("reshaping") 5 | 6 | test_that("reshaping1", { 7 | 8 | Tpoints=3 9 | n.latent=2 10 | n.manifest=4 11 | n.TDpred=2 12 | n.TIpred=0 13 | 14 | gm<-ctModel(Tpoints=Tpoints,n.latent=n.latent, 15 | n.TDpred=n.TDpred,n.TIpred=n.TIpred,n.manifest=n.manifest, 16 | LAMBDA=matrix(c(1,.4,.8,0,0,0,0,1),nrow=n.manifest,ncol=n.latent), 17 | MANIFESTVAR=diag(c(1),n.manifest), 18 | # TRAITVAR=matrix(c(2.3,-1.1,0,1.8) ,n.latent,n.latent), 19 | MANIFESTMEANS=matrix(c(0,0,0,0),n.manifest,1), 20 | DRIFT=matrix(c(-.23,.1,.0,-.4),n.latent), 21 | DIFFUSION=matrix(c(8.3,-5.1,0,8.4),n.latent,n.latent), 22 | CINT=matrix(c(0,.4),n.latent,1), 23 | # TRAITTDPREDCOV = matrix(c(.6,-.3,.4,.4),nrow=n.latent,ncol=n.TDpred*(Tpoints)), 24 | TDPREDEFFECT=matrix(c(1.2,-.4, 0,.3),nrow=n.latent,ncol=n.TDpred), 25 | T0MEANS=matrix(0,ncol=1,nrow=n.latent)) 26 | 27 | data<-ctGenerate(gm,n.subjects=20,burnin=50) 28 | 29 | data <- ctLongToWide(data,id='id',time='time', 30 | manifestNames=gm$manifestNames,TDpredNames=gm$TDpredNames,TIpredNames = gm$TIpredNames) 31 | data <- ctIntervalise(datawide = data,Tpoints = Tpoints,n.manifest = gm$n.manifest, 32 | n.TDpred = gm$n.TDpred,n.TIpred = gm$n.TIpred) 33 | 34 | 35 | data[1:(ceiling(nrow(data/2))),'dT1']<-2 36 | data[1:(ceiling(nrow(data/2))),'dT2']<-3 37 | 38 | 39 | manifestNames<-paste0('manifestV',1:n.manifest) 40 | latentNames<-paste0('latentV',1:n.latent) 41 | TDpredNames<-paste0('TDpredV',1:n.TDpred) 42 | TIpredNames<-paste0('TIpredV',1:n.TIpred) 43 | 44 | colnames(data)<-ctWideNames(n.manifest=n.manifest, n.TDpred = n.TDpred, 45 | Tpoints=Tpoints, manifestNames=manifestNames, TDpredNames=TDpredNames, 46 | TIpredNames=TIpredNames, 47 | n.TIpred=n.TIpred) 48 | 49 | testlong<-ctWideToLong(data,n.manifest=n.manifest,n.TDpred=n.TDpred,n.TIpred=n.TIpred, 50 | manifestNames=manifestNames,TDpredNames=TDpredNames, 51 | TIpredNames=TIpredNames, 52 | Tpoints=Tpoints) 53 | 54 | testlong<-ctDeintervalise(testlong) 55 | 56 | testwide<-ctLongToWide(testlong,id='id',time='time', 57 | manifestNames=manifestNames,TDpredNames=TDpredNames) 58 | 59 | testwide<-ctIntervalise(testwide,n.manifest=n.manifest,n.TDpred=n.TDpred,n.TIpred=n.TIpred, Tpoints=Tpoints, 60 | manifestNames=manifestNames,TDpredNames=TDpredNames) 61 | 62 | identical(testwide,data) 63 | 64 | 65 | expect_identical(testwide,data) 66 | }) 67 | -------------------------------------------------------------------------------- /tests/testthat/test-runExamples.R: -------------------------------------------------------------------------------- 1 | if(1==99){ 2 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 3 | library(devtools) 4 | context("allexamples") 5 | 6 | test_that("allexamples1", { 7 | # if (file.exists('../../ctsem/')) 8 | run_examples(pkg = '../../ctsem/.',run_donttest = TRUE, run_dontrun = TRUE) 9 | # else run_examples(pkg = '../../.',test=TRUE) 10 | }) 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /tests/testthat/test-stantipred.R: -------------------------------------------------------------------------------- 1 | if(identical(Sys.getenv("NOT_CRAN"), "true")& .Machine$sizeof.pointer != 4){ 2 | 3 | library(ctsem) 4 | library(testthat) 5 | set.seed(2) 6 | 7 | context("tipredcheck") 8 | 9 | test_that("simpleTIpredcheck", { 10 | Tpoints=10 11 | n.manifest=1 12 | n.TDpred=0 13 | n.TIpred=1 14 | n.latent=1 15 | n.subjects=50 16 | TI1 <- rnorm(n.subjects) 17 | gm<-ctModel(type='omx', Tpoints=Tpoints,n.latent=n.latent, 18 | n.TDpred=n.TDpred,n.manifest=n.manifest, 19 | MANIFESTVAR=diag(0.5,1), 20 | LAMBDA=diag(1,1),T0MEANS=100, 21 | DRIFT=matrix(c(-.3),nrow=1), 22 | DIFFUSION=matrix(c(2),1), 23 | T0VAR=diag(10,1)) 24 | 25 | for(i in 1:n.subjects){ 26 | gm$CINT[1,1] <- TI1[i]*5+rnorm(1,0,.6) 27 | ndat<-suppressMessages(ctGenerate(gm,n.subjects=1,burnin=10,logdtsd=.4)) 28 | ndat <- cbind(ndat,TI1[i]) 29 | ndat[,1] <- i 30 | if(i>1) tdat <- rbind(tdat,ndat) else tdat <- ndat 31 | } 32 | colnames(tdat)[4] <- 'TI1' 33 | 34 | tdat[2,'Y1'] <- NA 35 | tdat[tdat[,'id']==2,'TI1'] <- NA 36 | 37 | checkm<-suppressMessages(ctModel(type='ct',Tpoints=Tpoints, 38 | MANIFESTVAR=diag(0.5,1), 39 | DRIFT=matrix(c(-.3),nrow=1), 40 | DIFFUSION=matrix(c(2),1), 41 | n.latent=n.latent,n.TDpred=n.TDpred, 42 | n.TIpred=n.TIpred, 43 | MANIFESTMEANS=matrix(0,nrow=n.manifest), 44 | CINT=matrix(c('cint1'),ncol=1), 45 | n.manifest=n.manifest,LAMBDA=diag(1))) 46 | 47 | # checkm$pars$indvarying <- FALSE 48 | 49 | checkm$pars[c(-1,-7) ,c('TI1_effect')] <- FALSE 50 | 51 | tfit1<-ctStanFit(tdat,checkm,cores=2,optimize=TRUE, 52 | optimcontrol=list(is=TRUE,finishsamples=500), 53 | priors=TRUE,verbose=0) 54 | s1=summary(tfit1) 55 | 56 | test_isclose(s1$tipreds[2,'mean'],5,tol=.2) 57 | test_isclose(s1$popsd[2,'mean'],.6,tol=.2) 58 | 59 | tfit2<-ctStanFit(tdat,checkm,optimize=TRUE,cores=2,verbose=0, 60 | optimcontrol=list(is=FALSE),priors=TRUE) 61 | s2=summary(tfit2) 62 | 63 | test_isclose(s2$tipreds[2,'mean'],5,tol=.2) 64 | test_isclose(s2$popsd[2,'mean'],.6,tol=.2) 65 | 66 | tfit3<-suppressWarnings(ctStanFit(tdat,checkm,iter=300,chains=2,optimize=FALSE, 67 | control=list(adapt_delta=.8,max_treedepth=6),plot=FALSE)) 68 | s3=summary(tfit3) 69 | 70 | test_isclose(s3$tipreds[2,'mean'],5,tol=.5) 71 | test_isclose(s3$popsd[2,'mean'],.6,tol=.5) 72 | }) 73 | } 74 | -------------------------------------------------------------------------------- /tests/testthat/test-sunspots.R: -------------------------------------------------------------------------------- 1 | library(ctsem) 2 | library(testthat) 3 | set.seed(1) 4 | 5 | context("sunspots") 6 | 7 | test_that("sunspots", { 8 | sunspots<-sunspot.year 9 | sunspots<-sunspots[50: (length(sunspots) - (1988-1924))] 10 | id <- 1 11 | time <- 1749:1924 12 | datalong <- cbind(id, time, sunspots) 13 | 14 | #setup model 15 | ssmodel <- ctModel(type='ct', n.latent=2, n.manifest=1, 16 | # n.TDpred = 1, 17 | manifestNames='sunspots', 18 | latentNames=c('ss_level', 'ss_velocity'), 19 | LAMBDA=matrix(c( 1, 0), nrow=1, ncol=2), 20 | DRIFT=matrix(c(0, 'a21|-log1p(exp(param))', 1, 'a22'), nrow=2, ncol=2), 21 | # TDPREDEFFECT=matrix(c('tdeffect',0),2), 22 | MANIFESTMEANS=0, CINT=c(0,'cint'), 23 | MANIFESTVAR=diag(0,1), 24 | T0VAR=matrix(c(1,0,0,1), nrow=2, ncol=2), #Because single subject 25 | DIFFUSION=c(0, 0, 26 | 0,'diff')) 27 | 28 | 29 | # ssmodel$covmattransform='cholesky' 30 | 31 | ssfit1 <- ctStanFit(datalong, ssmodel,cores=1,verbose=0) 32 | # ssfit <- ctStanFit(datalong, ssmodel,cores=1,verbose=0,optimcontrol = list(hessianType='stochastic', stochasticHessianEpsilon=1e-1)) 33 | ssfit2 <- ctStanFit(datalong, ssmodel,cores=2,verbose=0) 34 | ssfit3 <- ctStanFit(datalong, ssmodel,cores=1,nlcontrol=list(maxtimestep=.3)) 35 | ssfit4 <- ctStanFit(datalong, ssmodel,chains=2,cores=2,iter=300,optimize=F,priors=F, 36 | control=list(max_treedepth=8),verbose=0, 37 | inits='optimize', 38 | intoverpop = T) 39 | 40 | for(i in 2:4){ 41 | test_isclose(get(paste0('ssfit',i))$stanfit$transformedparsfull$ll, 42 | get(paste0('ssfit',i-1))$stanfit$transformedparsfull$ll,tol=ifelse(i==4,3e-1,1e-2)) 43 | } 44 | 45 | for(i in 2:4){ 46 | test_isclose( 47 | ctStanContinuousPars(get(paste0('ssfit',i)))$DRIFT, 48 | ctStanContinuousPars(get(paste0('ssfit',i-1)))$DRIFT,tol=1e-1) 49 | } 50 | 51 | }) 52 | -------------------------------------------------------------------------------- /vignettes/compactPDF.R: -------------------------------------------------------------------------------- 1 | library(tools) 2 | compactPDF('./vignettes/',gs_cmd = find_gs_cmd(),gs_quality = 'ebook') 3 | -------------------------------------------------------------------------------- /vignettes/hierarchicalmanual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cdriveraus/ctsem/838b94ebe1fd7e63eba4f34ce864ebfd0d5ab8b3/vignettes/hierarchicalmanual.pdf --------------------------------------------------------------------------------