├── data └── LaLonde.rda ├── vignettes ├── sticker.png ├── vis_val-1.png ├── plot_model-1.png ├── usage_overview-1.png ├── efficiency_augmentation_personalized.R ├── fitting_itrs_with_xgboost.R ├── multicategory_treatments_with_personalized.R └── efficiency_augmentation_personalized.Rmd ├── man ├── figures │ └── sticker.png ├── print.individual_treatment_effects.Rd ├── summary.Rd ├── subgroup.effects.Rd ├── weighted.ksvm.Rd ├── LaLonde.Rd ├── print.Rd ├── summarize.subgroups.Rd ├── create.propensity.function.Rd ├── create.augmentation.function.Rd ├── predict.Rd ├── plotCompare.Rd ├── check.overlap.Rd ├── treatment.effects.Rd └── plot.Rd ├── docs ├── reference │ ├── plot-1.png │ ├── plot-10.png │ ├── plot-11.png │ ├── plot-12.png │ ├── plot-13.png │ ├── plot-14.png │ ├── plot-15.png │ ├── plot-16.png │ ├── plot-17.png │ ├── plot-18.png │ ├── plot-19.png │ ├── plot-2.png │ ├── plot-20.png │ ├── plot-21.png │ ├── plot-22.png │ ├── plot-23.png │ ├── plot-24.png │ ├── plot-25.png │ ├── plot-26.png │ ├── plot-27.png │ ├── plot-28.png │ ├── plot-29.png │ ├── plot-3.png │ ├── plot-30.png │ ├── plot-31.png │ ├── plot-32.png │ ├── plot-33.png │ ├── plot-34.png │ ├── plot-35.png │ ├── plot-36.png │ ├── plot-37.png │ ├── plot-38.png │ ├── plot-39.png │ ├── plot-4.png │ ├── plot-40.png │ ├── plot-5.png │ ├── plot-6.png │ ├── plot-7.png │ ├── plot-8.png │ ├── plot-9.png │ ├── Rplot001.png │ ├── Rplot002.png │ ├── Rplot003.png │ ├── Rplot004.png │ ├── Rplot005.png │ ├── Rplot006.png │ ├── Rplot007.png │ ├── check.overlap-1.png │ ├── check.overlap-2.png │ ├── check.overlap-3.png │ ├── check.overlap-4.png │ ├── check.overlap-5.png │ ├── check.overlap-6.png │ ├── check.overlap-7.png │ ├── check.overlap-8.png │ ├── check.overlap-9.png │ ├── figures │ │ └── sticker.png │ ├── plotCompare-1.png │ ├── plotCompare-2.png │ ├── plotCompare-3.png │ ├── plotCompare-4.png │ ├── plotCompare-5.png │ ├── plotCompare-6.png │ ├── plotCompare-7.png │ ├── plotCompare-8.png │ ├── check.overlap-10.png │ ├── check.overlap-11.png │ ├── check.overlap-12.png │ ├── check.overlap-13.png │ ├── check.overlap-14.png │ ├── check.overlap-15.png │ ├── check.overlap-16.png │ ├── check.overlap-17.png │ ├── check.overlap-18.png │ ├── check.overlap-19.png │ ├── check.overlap-20.png │ ├── check.overlap-21.png │ ├── check.overlap-22.png │ ├── check.overlap-23.png │ ├── check.overlap-24.png │ └── print.individual_treatment_effects.html ├── articles │ ├── vis_val-1.png │ ├── plot_model-1.png │ ├── usage_overview-1.png │ ├── fitting_itrs_with_xgboost_files │ │ └── figure-html │ │ │ └── unnamed-chunk-7-1.png │ ├── usage_of_the_personalized_package_files │ │ ├── figure-html │ │ │ ├── plot_1-1.png │ │ │ ├── plot_2-1.png │ │ │ ├── plot_4-1.png │ │ │ ├── fit_binary_2-1.png │ │ │ ├── plot_model-1.png │ │ │ ├── plot_model_2-1.png │ │ │ ├── plot_overlap-1.png │ │ │ ├── contin_example-1.png │ │ │ ├── plot_compare_ex2-1.png │ │ │ ├── plot_compare_ex3-1.png │ │ │ ├── plot_ex_model_1-1.png │ │ │ ├── plot_ex_model_1a-1.png │ │ │ ├── plot_ex_model_1b-1.png │ │ │ ├── plot_ex_model_2-1.png │ │ │ ├── plot_ex_model_3-1.png │ │ │ ├── plot_validation-1.png │ │ │ ├── plot_validation_2-1.png │ │ │ └── plot_validation_compare-1.png │ │ └── header-attrs-2.8 │ │ │ └── header-attrs.js │ ├── multicategory_treatments_with_personalized_files │ │ ├── figure-html │ │ │ ├── plot_multi_trt_model-1.png │ │ │ ├── check_overlap_multitreat-1.png │ │ │ └── plotcomparemultivalidated-1.png │ │ └── header-attrs-2.8 │ │ │ └── header-attrs.js │ ├── efficiency_augmentation_personalized_files │ │ └── header-attrs-2.8 │ │ │ └── header-attrs.js │ └── index.html ├── vignettes │ ├── vis_val-1.png │ ├── plot_model-1.png │ └── usage_overview-1.png ├── pkgdown.yml ├── link.svg ├── bootstrap-toc.css ├── sitemap.xml ├── docsearch.js ├── jquery.sticky-kit.min.js ├── pkgdown.js ├── bootstrap-toc.js ├── 404.html └── authors.html ├── .gitignore ├── tests ├── testthat.R └── testthat │ ├── test-subgroupeffects.R │ ├── test-designmatrixcalc.R │ ├── test-wksvm.R │ ├── test-treatmenteffects.R │ └── test-checkoverlap.R ├── .Rbuildignore ├── inst ├── NEWS.Rd └── CITATION ├── cran-comments.md ├── personalized.Rproj ├── .travis.yml ├── R ├── utils.R ├── data.R ├── data_prep_utils_split.R ├── data_prep_utils.R ├── predict_subgroup.R ├── summary_subgroup.R └── check_overlap.R ├── DESCRIPTION ├── appveyor.yml ├── _pkgdown.yml ├── NAMESPACE ├── NEWS.md └── .github └── workflows └── rhub.yaml /data/LaLonde.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/data/LaLonde.rda -------------------------------------------------------------------------------- /vignettes/sticker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/vignettes/sticker.png -------------------------------------------------------------------------------- /man/figures/sticker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/man/figures/sticker.png -------------------------------------------------------------------------------- /vignettes/vis_val-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/vignettes/vis_val-1.png -------------------------------------------------------------------------------- /docs/reference/plot-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-1.png -------------------------------------------------------------------------------- /docs/reference/plot-10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-10.png -------------------------------------------------------------------------------- /docs/reference/plot-11.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-11.png -------------------------------------------------------------------------------- /docs/reference/plot-12.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-12.png -------------------------------------------------------------------------------- /docs/reference/plot-13.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-13.png -------------------------------------------------------------------------------- /docs/reference/plot-14.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-14.png -------------------------------------------------------------------------------- /docs/reference/plot-15.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-15.png -------------------------------------------------------------------------------- /docs/reference/plot-16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-16.png -------------------------------------------------------------------------------- /docs/reference/plot-17.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-17.png -------------------------------------------------------------------------------- /docs/reference/plot-18.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-18.png -------------------------------------------------------------------------------- /docs/reference/plot-19.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-19.png -------------------------------------------------------------------------------- /docs/reference/plot-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-2.png -------------------------------------------------------------------------------- /docs/reference/plot-20.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-20.png -------------------------------------------------------------------------------- /docs/reference/plot-21.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-21.png -------------------------------------------------------------------------------- /docs/reference/plot-22.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-22.png -------------------------------------------------------------------------------- /docs/reference/plot-23.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-23.png -------------------------------------------------------------------------------- /docs/reference/plot-24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-24.png -------------------------------------------------------------------------------- /docs/reference/plot-25.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-25.png -------------------------------------------------------------------------------- /docs/reference/plot-26.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-26.png -------------------------------------------------------------------------------- /docs/reference/plot-27.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-27.png -------------------------------------------------------------------------------- /docs/reference/plot-28.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-28.png -------------------------------------------------------------------------------- /docs/reference/plot-29.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-29.png -------------------------------------------------------------------------------- /docs/reference/plot-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-3.png -------------------------------------------------------------------------------- /docs/reference/plot-30.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-30.png -------------------------------------------------------------------------------- /docs/reference/plot-31.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-31.png -------------------------------------------------------------------------------- /docs/reference/plot-32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-32.png -------------------------------------------------------------------------------- /docs/reference/plot-33.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-33.png -------------------------------------------------------------------------------- /docs/reference/plot-34.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-34.png -------------------------------------------------------------------------------- /docs/reference/plot-35.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-35.png -------------------------------------------------------------------------------- /docs/reference/plot-36.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-36.png -------------------------------------------------------------------------------- /docs/reference/plot-37.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-37.png -------------------------------------------------------------------------------- /docs/reference/plot-38.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-38.png -------------------------------------------------------------------------------- /docs/reference/plot-39.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-39.png -------------------------------------------------------------------------------- /docs/reference/plot-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-4.png -------------------------------------------------------------------------------- /docs/reference/plot-40.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-40.png -------------------------------------------------------------------------------- /docs/reference/plot-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-5.png -------------------------------------------------------------------------------- /docs/reference/plot-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-6.png -------------------------------------------------------------------------------- /docs/reference/plot-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-7.png -------------------------------------------------------------------------------- /docs/reference/plot-8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-8.png -------------------------------------------------------------------------------- /docs/reference/plot-9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plot-9.png -------------------------------------------------------------------------------- /vignettes/plot_model-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/vignettes/plot_model-1.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | personalized.Rproj 6 | inst/doc 7 | .DS_Store 8 | -------------------------------------------------------------------------------- /docs/articles/vis_val-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/vis_val-1.png -------------------------------------------------------------------------------- /docs/reference/Rplot001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot001.png -------------------------------------------------------------------------------- /docs/reference/Rplot002.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot002.png -------------------------------------------------------------------------------- /docs/reference/Rplot003.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot003.png -------------------------------------------------------------------------------- /docs/reference/Rplot004.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot004.png -------------------------------------------------------------------------------- /docs/reference/Rplot005.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot005.png -------------------------------------------------------------------------------- /docs/reference/Rplot006.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot006.png -------------------------------------------------------------------------------- /docs/reference/Rplot007.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/Rplot007.png -------------------------------------------------------------------------------- /docs/vignettes/vis_val-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/vignettes/vis_val-1.png -------------------------------------------------------------------------------- /docs/articles/plot_model-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/plot_model-1.png -------------------------------------------------------------------------------- /docs/vignettes/plot_model-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/vignettes/plot_model-1.png -------------------------------------------------------------------------------- /vignettes/usage_overview-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/vignettes/usage_overview-1.png -------------------------------------------------------------------------------- /docs/articles/usage_overview-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_overview-1.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-1.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-2.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-3.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-4.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-5.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-6.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-7.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-8.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-9.png -------------------------------------------------------------------------------- /docs/reference/figures/sticker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/figures/sticker.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-1.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-2.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-3.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-4.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-5.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-6.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-7.png -------------------------------------------------------------------------------- /docs/reference/plotCompare-8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/plotCompare-8.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-10.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-11.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-11.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-12.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-12.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-13.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-13.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-14.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-14.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-15.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-15.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-16.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-17.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-17.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-18.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-18.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-19.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-19.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-20.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-20.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-21.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-21.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-22.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-22.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-23.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-23.png -------------------------------------------------------------------------------- /docs/reference/check.overlap-24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/reference/check.overlap-24.png -------------------------------------------------------------------------------- /docs/vignettes/usage_overview-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/vignettes/usage_overview-1.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | Sys.setenv("R_TESTS" = "") 2 | library(testthat) 3 | library(personalized) 4 | 5 | test_check("personalized") 6 | -------------------------------------------------------------------------------- /docs/articles/fitting_itrs_with_xgboost_files/figure-html/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/fitting_itrs_with_xgboost_files/figure-html/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_1-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_4-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/fit_binary_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/fit_binary_2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_model-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_model-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_model_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_model_2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_overlap-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_overlap-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/contin_example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/contin_example-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_compare_ex2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_compare_ex2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_compare_ex3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_compare_ex3-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1a-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1a-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1b-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_1b-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_ex_model_3-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation_2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation_2-1.png -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation_compare-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/usage_of_the_personalized_package_files/figure-html/plot_validation_compare-1.png -------------------------------------------------------------------------------- /docs/articles/multicategory_treatments_with_personalized_files/figure-html/plot_multi_trt_model-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/multicategory_treatments_with_personalized_files/figure-html/plot_multi_trt_model-1.png -------------------------------------------------------------------------------- /docs/articles/multicategory_treatments_with_personalized_files/figure-html/check_overlap_multitreat-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/multicategory_treatments_with_personalized_files/figure-html/check_overlap_multitreat-1.png -------------------------------------------------------------------------------- /docs/articles/multicategory_treatments_with_personalized_files/figure-html/plotcomparemultivalidated-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaredhuling/personalized/HEAD/docs/articles/multicategory_treatments_with_personalized_files/figure-html/plotcomparemultivalidated-1.png -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^docs$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^.*\.Rhistory$ 5 | ^cran-comments.md$ 6 | ^NEWS.md$ 7 | README.Rmd 8 | README.html 9 | ^\.travis\.yml$ 10 | ^/\.gitattributes$ 11 | ^.*\docs$ 12 | ^\_pkgdown\.yml$ 13 | docs 14 | ^_pkgdown\.yml$ 15 | ^appveyor\.yml$ 16 | .github 17 | -------------------------------------------------------------------------------- /inst/NEWS.Rd: -------------------------------------------------------------------------------- 1 | \name{NEWS} 2 | \title{News for Package 'personalized'} 3 | 4 | \section{CHANGES IN personalized VERSION 999.999}{ 5 | \itemize{ 6 | \item This NEWS file is only a placeholder. The version 999.999 does not really 7 | exist. Please read the NEWS on Github: \url{https://github.com/jaredhuling/personalized/releases} 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## New version for 'personalized' -- 0.2.8 2 | 3 | * Minor bug fixes 4 | * Fixes CRAN errors and RD warnings 5 | 6 | ## Test environments 7 | 8 | * local Mac OSX Sequoia (R 4.5.1) 9 | * Rhub max-arm64, m1-san, windows 10 | 11 | ## R CMD check results 12 | 13 | * DONE 14 | Status: OK 15 | 16 | 17 | 18 | R CMD check results 19 | 0 errors | 0 warnings | 0 notes 20 | 21 | R CMD check succeeded 22 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.17.1.1 2 | pkgdown: 2.0.5 3 | pkgdown_sha: ~ 4 | articles: 5 | efficiency_augmentation_personalized: efficiency_augmentation_personalized.html 6 | fitting_itrs_with_xgboost: fitting_itrs_with_xgboost.html 7 | multicategory_treatments_with_personalized: multicategory_treatments_with_personalized.html 8 | usage_of_the_personalized_package: usage_of_the_personalized_package.html 9 | last_built: 2022-07-07T15:05Z 10 | 11 | -------------------------------------------------------------------------------- /personalized.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 4 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace,vignette 22 | -------------------------------------------------------------------------------- /docs/articles/efficiency_augmentation_personalized_files/header-attrs-2.8/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/usage_of_the_personalized_package_files/header-attrs-2.8/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /docs/articles/multicategory_treatments_with_personalized_files/header-attrs-2.8/header-attrs.js: -------------------------------------------------------------------------------- 1 | // Pandoc 2.9 adds attributes on both header and div. We remove the former (to 2 | // be compatible with the behavior of Pandoc < 2.8). 3 | document.addEventListener('DOMContentLoaded', function(e) { 4 | var hs = document.querySelectorAll("div.section[class*='level'] > :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | cache: packages 3 | r: 4 | - release 5 | 6 | r_check_args: --as-cran 7 | 8 | warnings_are_errors: true 9 | 10 | sudo: false 11 | 12 | notifications: 13 | email: 14 | on_success: change 15 | on_failure: always 16 | 17 | matrix: 18 | include: 19 | - os: linux 20 | env: BLAS=OpenBLAS 21 | addons: 22 | apt: 23 | sources: 24 | - ubuntu-toolchain-r-test 25 | packages: 26 | # compilers 27 | - g++ 28 | - gfortran 29 | # math libraries 30 | - libopenblas-base 31 | - os: linux 32 | 33 | 34 | r_packages: 35 | - covr 36 | 37 | after_success: 38 | - Rscript -e 'library(covr); codecov()' 39 | 40 | cache: packages 41 | -------------------------------------------------------------------------------- /man/print.individual_treatment_effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_treatment_effects.R 3 | \name{print.individual_treatment_effects} 4 | \alias{print.individual_treatment_effects} 5 | \title{Printing individualized treatment effects} 6 | \usage{ 7 | \method{print}{individual_treatment_effects}(x, digits = max(getOption("digits") - 3, 3), ...) 8 | } 9 | \arguments{ 10 | \item{x}{a fitted object from either \code{\link[personalized]{treat.effects}} or \code{\link[personalized]{treatment.effects}}} 11 | 12 | \item{digits}{minimal number of significant digits to print.} 13 | 14 | \item{...}{further arguments passed to or from \code{\link[base]{print.default}}.} 15 | } 16 | \description{ 17 | Prints results for estimated subgroup treatment effects 18 | } 19 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | convert.cutpoint <- function(cutpoint, benefit.scores) 4 | { 5 | if (is.character(cutpoint)) 6 | { 7 | if (cutpoint == "median") 8 | { 9 | cutpoint <- median(benefit.scores, na.rm = TRUE) 10 | } else if (grepl("^quant[0-9]+$", cutpoint)) 11 | { 12 | matches <- gregexpr('[0-9]+', cutpoint) 13 | qval <- as.numeric(regmatches(cutpoint, matches)[[1]]) 14 | if (qval >= 100 | qval < 1) stop("Invalid quantile value for cutpoint.") 15 | qval <- qval / 100 16 | cutpoint <- quantile(benefit.scores, probs = qval) 17 | } else 18 | { 19 | stop("Invalid cupoint supplied.") 20 | } 21 | } else if (is.numeric(cutpoint)) 22 | { 23 | cutpoint <- cutpoint[1] 24 | } else 25 | { 26 | stop("Invalid value specified for cutpoint.") 27 | } 28 | cutpoint 29 | } 30 | -------------------------------------------------------------------------------- /man/summary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summary_subgroup.R, R/weighted_svm.R 3 | \name{summary.subgroup_fitted} 4 | \alias{summary.subgroup_fitted} 5 | \alias{summary.wksvm} 6 | \title{Summary of results for fitted subgroup identification models} 7 | \usage{ 8 | \method{summary}{subgroup_fitted}(object, digits = max(getOption("digits") - 3, 3), ...) 9 | 10 | \method{summary}{wksvm}(object, digits = max(getOption("digits") - 3, 3), ...) 11 | } 12 | \arguments{ 13 | \item{object}{a fitted object from either \code{fit.subgroup} or \code{validate.subgroup}} 14 | 15 | \item{digits}{minimal number of significant digits to print.} 16 | 17 | \item{...}{further arguments passed to or from \code{\link[base]{print.default}}.} 18 | } 19 | \description{ 20 | Prints summary of results for estimated subgroup treatment effects 21 | 22 | Prints summary of results for estimated weighted ksvm 23 | } 24 | \seealso{ 25 | \code{\link[personalized]{validate.subgroup}} for function which creates validation results 26 | and \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 27 | } 28 | -------------------------------------------------------------------------------- /tests/testthat/test-subgroupeffects.R: -------------------------------------------------------------------------------- 1 | 2 | context("subgroup effect calculations") 3 | 4 | test_that("test that subgroup effect calculations are correct", { 5 | 6 | set.seed(123) 7 | bene.score <- rnorm(10) 8 | y <- rnorm(10) 9 | trt <- c(rep(1, 5), rep(0, 5)) 10 | pi.x <- c(rep(0.75, 5), rep(0.25, 5)) 11 | 12 | sub.eff <- subgroup.effects(benefit.scores = bene.score, 13 | y = y, trt = trt, pi.x = pi.x) 14 | 15 | recom <- 1 * (bene.score > 0) 16 | 17 | mean11 <- mean(y[trt == 1 & recom == 1]) 18 | mean01 <- mean(y[trt == 0 & recom == 1]) 19 | mean10 <- mean(y[trt == 1 & recom == 0]) 20 | mean00 <- mean(y[trt == 0 & recom == 0]) 21 | 22 | overall <- mean(y[(trt == 1 & recom == 1) | 23 | (trt == 0 & recom == 0) ]) - 24 | mean(y[(trt == 0 & recom == 1) | 25 | (trt == 1 & recom == 0) ]) 26 | 27 | expect_equal(overall, sub.eff$overall.subgroup.effect) 28 | 29 | expect_error(subgroup.effects(benefit.scores = bene.score, 30 | y = y, trt = c(rep(1, 4), rep(0, 3), rep(2, 3)), 31 | pi.x = c(rep(0.33, 4), rep(0.25, 3), rep(0.75, 3)) 32 | )) 33 | 34 | }) 35 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: personalized 2 | Type: Package 3 | Title: Estimation and Validation Methods for Subgroup Identification and 4 | Personalized Medicine 5 | Version: 0.2.8 6 | Authors@R: c( 7 | person("Jared", "Huling", role = c("aut", "cre"), email = "jaredhuling@gmail.com", 8 | comment = c(ORCID = "0000-0003-0670-4845")), 9 | person("Aaron", "Potvien", role = "ctb"), 10 | person("Alexandros", "Karatzoglou", role = "cph"), 11 | person("Alex", "Smola", role = "cph") 12 | ) 13 | Description: Provides functions for fitting and validation of models for subgroup 14 | identification and personalized medicine / precision medicine under the general subgroup 15 | identification framework of Chen et al. (2017) . 16 | This package is intended for use for both randomized controlled trials and 17 | observational studies and is described in detail in Huling and Yu (2021) 18 | . 19 | URL: https://jaredhuling.org/personalized/, 20 | https://arxiv.org/abs/1809.07905 21 | BugReports: https://github.com/jaredhuling/personalized/issues 22 | License: GPL-2 23 | Encoding: UTF-8 24 | LazyData: true 25 | Suggests: 26 | knitr, 27 | rmarkdown, 28 | testthat, 29 | nnet 30 | Imports: 31 | survival, 32 | methods, 33 | kernlab, 34 | foreach, 35 | xgboost (<= 1.7.11.1) 36 | Depends: 37 | glmnet (>= 2.0-13), 38 | mgcv, 39 | ggplot2, 40 | plotly 41 | RoxygenNote: 7.3.3 42 | VignetteBuilder: knitr 43 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite personalized in publications use:") 2 | 3 | bibentry(bibtype = "Article", 4 | title = "Subgroup Identification Using the {personalized} Package", 5 | author = c(person(given = c("Jared", "D."), 6 | family = "Huling", 7 | email = "huling@umn.edu"), 8 | person(given = "Menggang", 9 | family = "Yu", 10 | email = "meyu@biostat.wisc.edu")), 11 | journal = "Journal of Statistical Software", 12 | year = "2021", 13 | volume = "98", 14 | number = "5", 15 | pages = "1--60", 16 | doi = "10.18637/jss.v098.i05" 17 | ) 18 | 19 | 20 | bibentry(, 21 | bibtype = "Article", 22 | author = "Shuai Chen and Lu Tian and Tianxi Cai and Menggang Yu", 23 | title = "A General Statistical Framework for Subgroup Identification and Comparative Treatment Scoring", 24 | journal = "Biometrics", 25 | year = "2017", 26 | volume = "73", 27 | issue = "4", 28 | pages = "1199--1209", 29 | doi = "10.1111/biom.12676", 30 | url = "https://doi.org/10.1111/biom.12676", 31 | textVersion = paste("Chen, S., Tian, L., Cai, T., Yu, M. (2017) ", 32 | "A General Statistical Framework for Subgroup Identification and Comparative Treatment Scoring, ", 33 | "Biometrics, Volume 73, Issue 4, Pages 1199-1209,", 34 | "https://doi.org/10.1111/biom.12676.") 35 | ) 36 | 37 | 38 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | platform: 4 | - x86 5 | 6 | # Download script file from GitHub 7 | init: 8 | ps: | 9 | $ErrorActionPreference = "Stop" 10 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 11 | Import-Module '..\appveyor-tool.ps1' 12 | 13 | 14 | install: 15 | ps: Bootstrap 16 | 17 | # Adapt as necessary starting from here 18 | 19 | build_script: 20 | - travis-tool.sh install_r dplyr 21 | - travis-tool.sh install_r ggplot2 22 | - travis-tool.sh install_deps 23 | 24 | test_script: 25 | - travis-tool.sh run_tests 26 | 27 | on_failure: 28 | - 7z a failure.zip *.Rcheck\* 29 | - appveyor PushArtifact failure.zip 30 | 31 | artifacts: 32 | - path: '*.Rcheck\**\*.log' 33 | name: Logs 34 | 35 | - path: '*.Rcheck\**\*.out' 36 | name: Logs 37 | 38 | - path: '*.Rcheck\**\*.fail' 39 | name: Logs 40 | 41 | - path: '*.Rcheck\**\*.Rout' 42 | name: Logs 43 | 44 | - path: '\*_*.tar.gz' 45 | name: Bits 46 | 47 | - path: '\*_*.zip' 48 | name: Bits 49 | 50 | 51 | # Adapt as necessary starting from here 52 | 53 | environment: 54 | global: 55 | WARNINGS_ARE_ERRORS: 1 56 | USE_RTOOLS: true 57 | R_CHECK_ARGS: --no-manual --as-cran --install-args=--build _R_CHECK_CRAN_INCOMING_=TRUE 58 | 59 | 60 | matrix: 61 | - R_VERSION: stable 62 | R_ARCH: x64 63 | 64 | - R_VERSION: patched 65 | R_ARCH: x64 66 | 67 | - R_VERSION: devel 68 | R_ARCH: x64 69 | 70 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | template: 2 | params: 3 | bootswatch: cerulean 4 | 5 | navbar: 6 | type: default 7 | left: 8 | - icon: fa-home 9 | href: index.html 10 | - text: "Vignettes" 11 | href: articles/index.html 12 | menu: 13 | - text: Usage of the personalized Package 14 | href: articles/usage_of_the_personalized_package.html 15 | - text: Utilities for Improving Estimation Efficiency via Augmentation and for Propensity Score Estimation 16 | href: articles/efficiency_augmentation_personalized.html 17 | - text: Multi-category Treatments with personalized 18 | href: articles/multicategory_treatments_with_personalized.html 19 | - text: Estimation of Flexible ITRs with xgboost 20 | href: articles/fitting_itrs_with_xgboost.html 21 | - text: "Functions" 22 | href: reference/index.html 23 | - text: "News" 24 | href: news/index.html 25 | right: 26 | - icon: fa-github 27 | href: https://github.com/jaredhuling/personalized 28 | 29 | reference: 30 | - title: Main Functions 31 | contents: 32 | - fit.subgroup 33 | - validate.subgroup 34 | 35 | - title: Plotting 36 | contents: 37 | - check.overlap 38 | - starts_with("plot") 39 | 40 | - title: Summarizing 41 | contents: 42 | - starts_with("summar") 43 | - starts_with("print") 44 | - subgroup.effects 45 | - treatment.effects 46 | - treat.effects 47 | 48 | - title: Predicting 49 | contents: 50 | - starts_with("predict") 51 | 52 | - title: Data 53 | contents: 54 | - LaLonde 55 | 56 | - title: Utilities 57 | contents: 58 | - create.propensity.function 59 | - create.augmentation.function 60 | - weighted.ksvm 61 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /docs/sitemap.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | /404.html 5 | 6 | 7 | /articles/efficiency_augmentation_personalized.html 8 | 9 | 10 | /articles/fitting_itrs_with_xgboost.html 11 | 12 | 13 | /articles/index.html 14 | 15 | 16 | /articles/multicategory_treatments_with_personalized.html 17 | 18 | 19 | /articles/usage_of_the_personalized_package.html 20 | 21 | 22 | /authors.html 23 | 24 | 25 | /index.html 26 | 27 | 28 | /news/index.html 29 | 30 | 31 | /reference/LaLonde.html 32 | 33 | 34 | /reference/check.overlap.html 35 | 36 | 37 | /reference/create.augmentation.function.html 38 | 39 | 40 | /reference/create.propensity.function.html 41 | 42 | 43 | /reference/fit.subgroup.html 44 | 45 | 46 | /reference/index.html 47 | 48 | 49 | /reference/plot.html 50 | 51 | 52 | /reference/plotCompare.html 53 | 54 | 55 | /reference/predict.html 56 | 57 | 58 | /reference/print.html 59 | 60 | 61 | /reference/print.individual_treatment_effects.html 62 | 63 | 64 | /reference/subgroup.effects.html 65 | 66 | 67 | /reference/summarize.subgroups.html 68 | 69 | 70 | /reference/summary.html 71 | 72 | 73 | /reference/treatment.effects.html 74 | 75 | 76 | /reference/validate.subgroup.html 77 | 78 | 79 | /reference/weighted.ksvm.html 80 | 81 | 82 | -------------------------------------------------------------------------------- /man/subgroup.effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/est_subgroup_effects.R 3 | \name{subgroup.effects} 4 | \alias{subgroup.effects} 5 | \title{Computes treatment effects within various subgroups} 6 | \usage{ 7 | subgroup.effects( 8 | benefit.scores, 9 | y, 10 | trt, 11 | pi.x, 12 | cutpoint = 0, 13 | larger.outcome.better = TRUE, 14 | reference.trt = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{benefit.scores}{vector of estimated benefit scores} 19 | 20 | \item{y}{The response vector} 21 | 22 | \item{trt}{treatment vector with each element equal to a 0 or a 1, with 1 indicating 23 | treatment status is active.} 24 | 25 | \item{pi.x}{The propensity score for each observation} 26 | 27 | \item{cutpoint}{numeric value for patients with benefit scores above which 28 | (or below which if \code{larger.outcome.better = FALSE}) 29 | will be recommended to be in the treatment group. Can also set \code{cutpoint = "median"}, which will 30 | use the median value of the benefit scores as the cutpoint or can set specific quantile values via \code{"quantx"} 31 | where \code{"x"} is a number between 0 and 100 representing the quantile value; e.g. \code{cutpoint = "quant75"} 32 | will use the 75th perent upper quantile of the benefit scores as the quantile.} 33 | 34 | \item{larger.outcome.better}{boolean value of whether a larger outcome is better. Set to \code{TRUE} 35 | if a larger outcome is better and set to \code{FALSE} if a smaller outcome is better. Defaults to \code{TRUE}.} 36 | 37 | \item{reference.trt}{index of which treatment is the reference (in the case of multiple treatments). 38 | This should be known already, as for a \code{trt} with K-levels, there will be K-1 benefit scores (1 per column) 39 | of \code{benefit.scores}, where each column is a comparison of each K-1 treatments with the reference treatment. 40 | The default is the last level of \code{trt} if it is a factor.} 41 | } 42 | \description{ 43 | Computes treatment effects within various subgroups to estimate subgroup treatment effects 44 | } 45 | \seealso{ 46 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models which generate 47 | benefit scores. 48 | } 49 | -------------------------------------------------------------------------------- /man/weighted.ksvm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/weighted_svm.R 3 | \name{weighted.ksvm} 4 | \alias{weighted.ksvm} 5 | \title{Fit weighted kernel svm model.} 6 | \usage{ 7 | weighted.ksvm( 8 | y, 9 | x, 10 | weights, 11 | C = c(0.1, 0.5, 1, 2, 10), 12 | kernel = "rbfdot", 13 | kpar = "automatic", 14 | nfolds = 10, 15 | foldid = NULL, 16 | eps = 1e-08, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{y}{The response vector (either a character vector, factor vector, or numeric vector with values in \{-1, 1\})} 22 | 23 | \item{x}{The design matrix (not including intercept term)} 24 | 25 | \item{weights}{vector of sample weights for weighted SVM} 26 | 27 | \item{C}{cost of constraints violation, see \code{\link[kernlab]{ksvm}}} 28 | 29 | \item{kernel}{kernel function used for training and prediction. See \code{\link[kernlab]{ksvm}} and \code{\link[kernlab]{kernels}}} 30 | 31 | \item{kpar}{list of hyperparameters for the kernel function. See \code{\link[kernlab]{ksvm}}} 32 | 33 | \item{nfolds}{number of cross validation folds for selecting value of C} 34 | 35 | \item{foldid}{optional vector of values between 1 and nfolds specifying which fold each observation is in. If specified, it will 36 | override the \code{nfolds} argument.} 37 | 38 | \item{eps}{penalty nugget parameter. Defaults to \code{1e-8}} 39 | 40 | \item{...}{extra arguments to be passed to \code{\link[kernlab]{ipop}} from the kernlab package} 41 | } 42 | \description{ 43 | Fits weighted kernel SVM. To be used for OWL with hinge loss (but can be used more generally) 44 | } 45 | \examples{ 46 | 47 | library(kernlab) 48 | 49 | x <- matrix(rnorm(200 * 2), ncol = 2) 50 | 51 | y <- 2 * (sin(x[,2]) ^ 2 * exp(-x[,2]) - 0.2 > rnorm(200, sd = 0.1)) - 1 52 | 53 | weights <- runif(100, max = 1.5, min = 0.5) 54 | 55 | wk <- weighted.ksvm(x = x[1:100,], y = y[1:100], 56 | C = c(0.1, 0.5, 1, 2), 57 | nfolds = 5, 58 | weights = weights[1:100]) 59 | 60 | pr <- predict(wk, newx = x[101:200,]) 61 | 62 | mean(pr == y[101:200]) 63 | 64 | } 65 | \seealso{ 66 | \code{\link[personalized]{predict.wksvm}} for predicting from fitted \code{weighted.ksvm} objects 67 | } 68 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' National Supported Work Study Data 2 | #' 3 | #' 4 | #' @description The LaLonde dataset comes from the National Supported Work Study, which sought to 5 | #' evaluate the effectiveness of an employment trainining program on wage increases. 6 | #' @format A data frame with 722 observations and 12 variables: 7 | #' \describe{ 8 | #' \item{outcome}{whether earnings in 1978 are larger than in 1975; 1 for yes, 0 for no} 9 | #' \item{treat}{whether the individual received the treatment; "Yes" or "No"} 10 | #' \item{age}{age in years} 11 | #' \item{educ}{education in years} 12 | #' \item{black}{black or not; factor with levels "Yes" or "No"} 13 | #' \item{hisp}{hispanic or not; factor with levels "Yes" or "No"} 14 | #' \item{white}{white or not; factor with levels "Yes" or "No"} 15 | #' \item{marr}{married or not; factor with levels "Yes" or "No"} 16 | #' \item{nodegr}{No high school degree; factor with levels "Yes" (for no HS degree) or "No"} 17 | #' \item{log.re75}{log of earnings in 1975} 18 | #' \item{u75}{unemployed in 1975; factor with levels "Yes" or "No"} 19 | #' \item{wts.extrap}{extrapolation weights to the 1978 Panel Study for Income Dynamics dataset} 20 | #' } 21 | #' @source The National Supported Work Study. 22 | #' @references LaLonde, R.J. 1986. "Evaluating the econometric evaulations of training programs with experimental data." American Economic Review, Vol.76, No.4, pp. 604-620. 23 | #' 24 | #' Egami N, Ratkovic M, Imai K (2017). "\pkg{FindIt}: Finding Heterogeneous Treatment Effects." \code{R} package version 1.1.2, \url{https://CRAN.R-project.org/package=FindIt}. 25 | #' @examples 26 | #' data(LaLonde) 27 | #' y <- LaLonde$outcome 28 | #' 29 | # treatment assignment (employment training vs not) 30 | #' trt <- LaLonde$treat 31 | #' 32 | #' x.varnames <- c("age", "educ", "black", "hisp", "white", 33 | #' "marr", "nodegr", "log.re75", "u75") 34 | #' 35 | #' # covariates 36 | #' data.x <- LaLonde[, x.varnames] 37 | #' 38 | #' # construct design matrix (with no intercept) 39 | #' x <- model.matrix(~ -1 + ., data = data.x) 40 | #' 41 | #' const.propens <- function(x, trt) 42 | #' { 43 | #' mean.trt <- mean(trt == "Trt") 44 | #' rep(mean.trt, length(trt)) 45 | #' } 46 | #' 47 | #' subgrp_fit_w <- fit.subgroup(x = x, y = y, trt = trt, 48 | #' loss = "logistic_loss_lasso", 49 | #' propensity.func = const.propens, 50 | #' cutpoint = 0, 51 | #' type.measure = "auc", 52 | #' nfolds = 10) 53 | #' 54 | #' summary(subgrp_fit_w) 55 | "LaLonde" 56 | -------------------------------------------------------------------------------- /man/LaLonde.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{LaLonde} 5 | \alias{LaLonde} 6 | \title{National Supported Work Study Data} 7 | \format{ 8 | A data frame with 722 observations and 12 variables: 9 | \describe{ 10 | \item{outcome}{whether earnings in 1978 are larger than in 1975; 1 for yes, 0 for no} 11 | \item{treat}{whether the individual received the treatment; "Yes" or "No"} 12 | \item{age}{age in years} 13 | \item{educ}{education in years} 14 | \item{black}{black or not; factor with levels "Yes" or "No"} 15 | \item{hisp}{hispanic or not; factor with levels "Yes" or "No"} 16 | \item{white}{white or not; factor with levels "Yes" or "No"} 17 | \item{marr}{married or not; factor with levels "Yes" or "No"} 18 | \item{nodegr}{No high school degree; factor with levels "Yes" (for no HS degree) or "No"} 19 | \item{log.re75}{log of earnings in 1975} 20 | \item{u75}{unemployed in 1975; factor with levels "Yes" or "No"} 21 | \item{wts.extrap}{extrapolation weights to the 1978 Panel Study for Income Dynamics dataset} 22 | } 23 | } 24 | \source{ 25 | The National Supported Work Study. 26 | } 27 | \usage{ 28 | LaLonde 29 | } 30 | \description{ 31 | The LaLonde dataset comes from the National Supported Work Study, which sought to 32 | evaluate the effectiveness of an employment trainining program on wage increases. 33 | } 34 | \examples{ 35 | data(LaLonde) 36 | y <- LaLonde$outcome 37 | 38 | trt <- LaLonde$treat 39 | 40 | x.varnames <- c("age", "educ", "black", "hisp", "white", 41 | "marr", "nodegr", "log.re75", "u75") 42 | 43 | # covariates 44 | data.x <- LaLonde[, x.varnames] 45 | 46 | # construct design matrix (with no intercept) 47 | x <- model.matrix(~ -1 + ., data = data.x) 48 | 49 | const.propens <- function(x, trt) 50 | { 51 | mean.trt <- mean(trt == "Trt") 52 | rep(mean.trt, length(trt)) 53 | } 54 | 55 | subgrp_fit_w <- fit.subgroup(x = x, y = y, trt = trt, 56 | loss = "logistic_loss_lasso", 57 | propensity.func = const.propens, 58 | cutpoint = 0, 59 | type.measure = "auc", 60 | nfolds = 10) 61 | 62 | summary(subgrp_fit_w) 63 | } 64 | \references{ 65 | LaLonde, R.J. 1986. "Evaluating the econometric evaulations of training programs with experimental data." American Economic Review, Vol.76, No.4, pp. 604-620. 66 | 67 | Egami N, Ratkovic M, Imai K (2017). "\pkg{FindIt}: Finding Heterogeneous Treatment Effects." \code{R} package version 1.1.2, \url{https://CRAN.R-project.org/package=FindIt}. 68 | } 69 | \keyword{datasets} 70 | -------------------------------------------------------------------------------- /man/print.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print_subgroup.R, R/summarize_subgroups.R 3 | \name{print.subgroup_fitted} 4 | \alias{print.subgroup_fitted} 5 | \alias{print.subgroup_validated} 6 | \alias{print.subgroup_summary} 7 | \title{Printing results for fitted subgroup identification models} 8 | \usage{ 9 | \method{print}{subgroup_fitted}(x, digits = max(getOption("digits") - 3, 3), ...) 10 | 11 | \method{print}{subgroup_validated}( 12 | x, 13 | digits = max(getOption("digits") - 3, 3), 14 | sample.pct = FALSE, 15 | which.quant = NULL, 16 | ... 17 | ) 18 | 19 | \method{print}{subgroup_summary}(x, p.value = 0.001, digits = max(getOption("digits") - 3, 3), ...) 20 | } 21 | \arguments{ 22 | \item{x}{a fitted object from either \code{fit.subgroup}, \code{validate.subgroup}, or \code{summarize.subgroups()}} 23 | 24 | \item{digits}{minimal number of significant digits to print.} 25 | 26 | \item{...}{further arguments passed to or from \code{\link[base]{print.default}}.} 27 | 28 | \item{sample.pct}{boolean variable of whether to print the percent of the test sample within each subgroup. If false 29 | the sample size itself, not the percent is printed. This may not be informative if the test sample size is much different 30 | from the total sample size} 31 | 32 | \item{which.quant}{when \code{validate.subgroup()} is called with a vector of quantile values specified for \code{benefit.score.quantiles}, 33 | i.e. \code{benefit.score.quantiles = c(0.25, 0.5, 0.75)}, the argument \code{which.quant} can be a vector of indexes specifying which 34 | quantile cutoff value validation results to display, i.e. \code{which.quant = c(1,3)} in the above example results in the display of 35 | validation results for subgroups defined by cutoff values of the benefit score defined by the 25th abnd 75th quantiles of the benefit score} 36 | 37 | \item{p.value}{a p-value threshold for mean differences below which covariates will be displayed. P-values are adjusted for 38 | multiple comparisons by the Hommel approach. For example, 39 | setting \code{p.value = 0.05} will display all covariates that have a significant difference between subgroups 40 | with p-value less than 0.05. Defaults to 0.001.} 41 | } 42 | \description{ 43 | Prints results for estimated subgroup treatment effects 44 | 45 | Prints summary results for estimated subgroup treatment effects 46 | } 47 | \seealso{ 48 | \code{\link[personalized]{validate.subgroup}} for function which creates validation results 49 | and \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 50 | 51 | \code{\link[personalized]{summarize.subgroups}} for function which summarizes subgroup covariate values 52 | } 53 | -------------------------------------------------------------------------------- /docs/jquery.sticky-kit.min.js: -------------------------------------------------------------------------------- 1 | /* 2 | Sticky-kit v1.1.2 | WTFPL | Leaf Corcoran 2015 | http://leafo.net 3 | */ 4 | (function(){var b,f;b=this.jQuery||window.jQuery;f=b(window);b.fn.stick_in_parent=function(d){var A,w,J,n,B,K,p,q,k,E,t;null==d&&(d={});t=d.sticky_class;B=d.inner_scrolling;E=d.recalc_every;k=d.parent;q=d.offset_top;p=d.spacer;w=d.bottoming;null==q&&(q=0);null==k&&(k=void 0);null==B&&(B=!0);null==t&&(t="is_stuck");A=b(document);null==w&&(w=!0);J=function(a,d,n,C,F,u,r,G){var v,H,m,D,I,c,g,x,y,z,h,l;if(!a.data("sticky_kit")){a.data("sticky_kit",!0);I=A.height();g=a.parent();null!=k&&(g=g.closest(k)); 5 | if(!g.length)throw"failed to find stick parent";v=m=!1;(h=null!=p?p&&a.closest(p):b("
"))&&h.css("position",a.css("position"));x=function(){var c,f,e;if(!G&&(I=A.height(),c=parseInt(g.css("border-top-width"),10),f=parseInt(g.css("padding-top"),10),d=parseInt(g.css("padding-bottom"),10),n=g.offset().top+c+f,C=g.height(),m&&(v=m=!1,null==p&&(a.insertAfter(h),h.detach()),a.css({position:"",top:"",width:"",bottom:""}).removeClass(t),e=!0),F=a.offset().top-(parseInt(a.css("margin-top"),10)||0)-q, 6 | u=a.outerHeight(!0),r=a.css("float"),h&&h.css({width:a.outerWidth(!0),height:u,display:a.css("display"),"vertical-align":a.css("vertical-align"),"float":r}),e))return l()};x();if(u!==C)return D=void 0,c=q,z=E,l=function(){var b,l,e,k;if(!G&&(e=!1,null!=z&&(--z,0>=z&&(z=E,x(),e=!0)),e||A.height()===I||x(),e=f.scrollTop(),null!=D&&(l=e-D),D=e,m?(w&&(k=e+u+c>C+n,v&&!k&&(v=!1,a.css({position:"fixed",bottom:"",top:c}).trigger("sticky_kit:unbottom"))),eb&&!v&&(c-=l,c=Math.max(b-u,c),c=Math.min(q,c),m&&a.css({top:c+"px"})))):e>F&&(m=!0,b={position:"fixed",top:c},b.width="border-box"===a.css("box-sizing")?a.outerWidth()+"px":a.width()+"px",a.css(b).addClass(t),null==p&&(a.after(h),"left"!==r&&"right"!==r||h.append(a)),a.trigger("sticky_kit:stick")),m&&w&&(null==k&&(k=e+u+c>C+n),!v&&k)))return v=!0,"static"===g.css("position")&&g.css({position:"relative"}), 8 | a.css({position:"absolute",bottom:d,top:"auto"}).trigger("sticky_kit:bottom")},y=function(){x();return l()},H=function(){G=!0;f.off("touchmove",l);f.off("scroll",l);f.off("resize",y);b(document.body).off("sticky_kit:recalc",y);a.off("sticky_kit:detach",H);a.removeData("sticky_kit");a.css({position:"",bottom:"",top:"",width:""});g.position("position","");if(m)return null==p&&("left"!==r&&"right"!==r||a.insertAfter(h),h.remove()),a.removeClass(t)},f.on("touchmove",l),f.on("scroll",l),f.on("resize", 9 | y),b(document.body).on("sticky_kit:recalc",y),a.on("sticky_kit:detach",H),setTimeout(l,0)}};n=0;for(K=this.length;n 2 15 | 16 | if (is.mult.trt) 17 | { 18 | # set to factor for multiple trtment trt vector if it isn't already 19 | if (!is.factor(trt)) trt <- as.factor(trt) 20 | 21 | return( create.design.matrix.mult.trt.split(x = cbind(1, x), 22 | pi.x = pi.x, 23 | trt = trt, 24 | #y = y, 25 | method = method, 26 | reference.trt = reference.trt) ) 27 | } else 28 | { 29 | return( create.design.matrix.binary.trt.split(x = x, 30 | pi.x = pi.x, 31 | trt = trt, 32 | method = method, 33 | reference.trt = reference.trt) ) 34 | } 35 | } 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | create.design.matrix.binary.trt.split <- function(x, pi.x, trt, method, reference.trt = NULL) 44 | { 45 | # trt must be supplied as integer vector 46 | # where 1 = treatment, 0 = control 47 | 48 | 49 | if (is.factor(trt)) 50 | { 51 | # drop any unused levels of trt 52 | trt <- droplevels(trt) 53 | unique.trts <- levels(trt) 54 | n.trts <- length(unique.trts) 55 | } else 56 | { 57 | unique.trts <- sort(unique(trt)) 58 | n.trts <- length(unique.trts) 59 | } 60 | 61 | # if not specified, set reference treatment 62 | # to be the last one 63 | if (is.null(reference.trt)) 64 | { 65 | reference.trt <- unique.trts[1L] 66 | } 67 | 68 | which.reference <- which(unique.trts == reference.trt) 69 | 70 | if (n.trts != 2) stop("two trtment levels only for binary trt design matrix function") 71 | 72 | # construct modified design matrices 73 | # depending on what method is used 74 | if (method == "weighting") 75 | { 76 | # create 1 and -1 version of treatment vector 77 | trt.multiplier <- 2 * (trt != reference.trt) - 1 78 | 79 | x.tilde <- cbind(1, x) 80 | } else 81 | { # A-learning method 82 | trt.multiplier <- (1 * (trt != reference.trt) - pi.x) 83 | x.tilde <- cbind(1, x) 84 | } 85 | list(x = x.tilde, 86 | trt.multiplier = trt.multiplier) 87 | } 88 | 89 | 90 | 91 | 92 | 93 | 94 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,subgroup_fitted) 4 | S3method(plot,subgroup_validated) 5 | S3method(predict,subgroup_fitted) 6 | S3method(predict,wksvm) 7 | S3method(print,individual_treatment_effects) 8 | S3method(print,subgroup_fitted) 9 | S3method(print,subgroup_summary) 10 | S3method(print,subgroup_validated) 11 | S3method(summarize.subgroups,default) 12 | S3method(summarize.subgroups,subgroup_fitted) 13 | S3method(summary,subgroup_fitted) 14 | S3method(summary,wksvm) 15 | S3method(treatment.effects,default) 16 | S3method(treatment.effects,subgroup_fitted) 17 | export(check.overlap) 18 | export(create.augmentation.function) 19 | export(create.propensity.function) 20 | export(fit.subgroup) 21 | export(plotCompare) 22 | export(subgroup.effects) 23 | export(summarize.subgroups) 24 | export(treat.effects) 25 | export(treatment.effects) 26 | export(validate.subgroup) 27 | export(weighted.ksvm) 28 | import(foreach) 29 | import(glmnet) 30 | import(mgcv) 31 | import(survival) 32 | import(xgboost) 33 | importFrom(ggplot2,aes) 34 | importFrom(ggplot2,coord_flip) 35 | importFrom(ggplot2,facet_grid) 36 | importFrom(ggplot2,geom_bar) 37 | importFrom(ggplot2,geom_boxplot) 38 | importFrom(ggplot2,geom_density) 39 | importFrom(ggplot2,geom_errorbar) 40 | importFrom(ggplot2,geom_histogram) 41 | importFrom(ggplot2,geom_hline) 42 | importFrom(ggplot2,geom_line) 43 | importFrom(ggplot2,geom_point) 44 | importFrom(ggplot2,geom_rect) 45 | importFrom(ggplot2,geom_rug) 46 | importFrom(ggplot2,geom_smooth) 47 | importFrom(ggplot2,geom_vline) 48 | importFrom(ggplot2,ggplot) 49 | importFrom(ggplot2,ggtitle) 50 | importFrom(ggplot2,guide_legend) 51 | importFrom(ggplot2,guides) 52 | importFrom(ggplot2,scale_color_discrete) 53 | importFrom(ggplot2,scale_x_discrete) 54 | importFrom(ggplot2,theme) 55 | importFrom(ggplot2,xlab) 56 | importFrom(ggplot2,xlim) 57 | importFrom(ggplot2,ylab) 58 | importFrom(kernlab,anovadot) 59 | importFrom(kernlab,besseldot) 60 | importFrom(kernlab,dual) 61 | importFrom(kernlab,ipop) 62 | importFrom(kernlab,kernelMatrix) 63 | importFrom(kernlab,kpar) 64 | importFrom(kernlab,laplacedot) 65 | importFrom(kernlab,polydot) 66 | importFrom(kernlab,primal) 67 | importFrom(kernlab,rbfdot) 68 | importFrom(kernlab,sigest) 69 | importFrom(kernlab,splinedot) 70 | importFrom(kernlab,tanhdot) 71 | importFrom(kernlab,vanilladot) 72 | importFrom(methods,formalArgs) 73 | importFrom(methods,is) 74 | importFrom(methods,new) 75 | importFrom(plotly,ggplotly) 76 | importFrom(plotly,layout) 77 | importFrom(plotly,subplot) 78 | importFrom(stats,as.formula) 79 | importFrom(stats,binomial) 80 | importFrom(stats,chisq.test) 81 | importFrom(stats,coef) 82 | importFrom(stats,fisher.test) 83 | importFrom(stats,gaussian) 84 | importFrom(stats,median) 85 | importFrom(stats,model.matrix) 86 | importFrom(stats,poisson) 87 | importFrom(stats,predict) 88 | importFrom(stats,quantile) 89 | importFrom(stats,sd) 90 | importFrom(stats,t.test) 91 | importFrom(stats,weighted.mean) 92 | importFrom(xgboost,slice) 93 | importFrom(xgboost,xgb.train) 94 | -------------------------------------------------------------------------------- /vignettes/efficiency_augmentation_personalized.R: -------------------------------------------------------------------------------- 1 | ## ----loadpkg, message=FALSE, warning=FALSE------------------------------------ 2 | library(personalized) 3 | 4 | ## ----sim_data_1, message = FALSE, warning = FALSE----------------------------- 5 | library(personalized) 6 | 7 | set.seed(1) 8 | n.obs <- 500 9 | n.vars <- 10 10 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 11 | 12 | # simulate non-randomized treatment 13 | xbetat <- 0.5 + 0.25 * x[,9] - 0.25 * x[,1] 14 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 15 | trt <- rbinom(n.obs, 1, prob = trt.prob) 16 | 17 | # simulate delta 18 | delta <- (0.5 + x[,2] - 0.5 * x[,3] - 1 * x[,1] + 1 * x[,1] * x[,4] ) 19 | 20 | # simulate main effects g(X) 21 | xbeta <- 2 * x[,1] + 3 * x[,4] - 0.25 * x[,2]^2 + 2 * x[,3] + 0.25 * x[,5] ^ 2 22 | xbeta <- xbeta + delta * (2 * trt - 1) 23 | 24 | # simulate continuous outcomes 25 | y <- drop(xbeta) + rnorm(n.obs, sd = 3) 26 | 27 | ## ----------------------------------------------------------------------------- 28 | # arguments can be passed to cv.glmnet via `cv.glmnet.args` 29 | prop.func <- create.propensity.function(crossfit = TRUE, 30 | nfolds.crossfit = 4, 31 | cv.glmnet.args = list(type.measure = "auc", nfolds = 3)) 32 | 33 | ## ----------------------------------------------------------------------------- 34 | subgrp.model <- fit.subgroup(x = x, y = y, 35 | trt = trt, 36 | propensity.func = prop.func, 37 | loss = "sq_loss_lasso", 38 | nfolds = 3) # option for cv.glmnet (for ITR estimation) 39 | 40 | summary(subgrp.model) 41 | 42 | ## ----------------------------------------------------------------------------- 43 | aug.func <- create.augmentation.function(family = "gaussian", 44 | crossfit = TRUE, 45 | nfolds.crossfit = 4, 46 | cv.glmnet.args = list(type.measure = "mae", nfolds = 3)) 47 | 48 | ## ----------------------------------------------------------------------------- 49 | subgrp.model.aug <- fit.subgroup(x = x, y = y, 50 | trt = trt, 51 | propensity.func = prop.func, 52 | augment.func = aug.func, 53 | loss = "sq_loss_lasso", 54 | nfolds = 3) # option for cv.glmnet (for ITR estimation) 55 | 56 | summary(subgrp.model.aug) 57 | 58 | ## ----------------------------------------------------------------------------- 59 | valmod <- validate.subgroup(subgrp.model, B = 3, 60 | method = "training_test", 61 | train.fraction = 0.75) 62 | valmod 63 | 64 | ## ----------------------------------------------------------------------------- 65 | valmod.aug <- validate.subgroup(subgrp.model.aug, B = 3, 66 | method = "training_test", 67 | train.fraction = 0.75) 68 | valmod.aug 69 | 70 | -------------------------------------------------------------------------------- /man/summarize.subgroups.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summarize_subgroups.R 3 | \name{summarize.subgroups} 4 | \alias{summarize.subgroups} 5 | \alias{summarize.subgroups.default} 6 | \alias{summarize.subgroups.subgroup_fitted} 7 | \title{Summarizing covariates within estimated subgroups} 8 | \usage{ 9 | summarize.subgroups(x, ...) 10 | 11 | \method{summarize.subgroups}{default}(x, subgroup, ...) 12 | 13 | \method{summarize.subgroups}{subgroup_fitted}(x, ...) 14 | } 15 | \arguments{ 16 | \item{x}{a fitted object from \code{fit.subgroup()} or a matrix of covariate values} 17 | 18 | \item{...}{optional arguments to \code{summarize.subgroups} methods} 19 | 20 | \item{subgroup}{vector of indicators of same length as the number of rows in x if x is a matrix. 21 | A value of 1 in the ith position of \code{subgroup} indicates patient i is in the subgroup 22 | of patients recommended the treatment and a value of 0 in the ith position of \code{subgroup} indicates patient i is in the subgroup 23 | of patients recommended the control. 24 | If x is a fitted object returned by \code{fit.subgroup()}, \code{subgroup} is not needed.} 25 | } 26 | \description{ 27 | Summarizes covariate values within the estimated subgroups 28 | } 29 | \details{ 30 | The p-values shown are raw p-values and are not adjusted for multiple comparisons. 31 | } 32 | \examples{ 33 | library(personalized) 34 | 35 | set.seed(123) 36 | n.obs <- 1000 37 | n.vars <- 50 38 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 39 | 40 | 41 | # simulate non-randomized treatment 42 | xbetat <- 0.5 + 0.5 * x[,21] - 0.5 * x[,41] 43 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 44 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 45 | 46 | trt <- 2 * trt01 - 1 47 | 48 | # simulate response 49 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 50 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 51 | xbeta <- xbeta + delta * trt 52 | 53 | # continuous outcomes 54 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 55 | 56 | # create function for fitting propensity score model 57 | prop.func <- function(x, trt) 58 | { 59 | # fit propensity score model 60 | propens.model <- cv.glmnet(y = trt, 61 | x = x, family = "binomial") 62 | pi.x <- predict(propens.model, s = "lambda.min", 63 | newx = x, type = "response")[,1] 64 | pi.x 65 | } 66 | 67 | subgrp.model <- fit.subgroup(x = x, y = y, 68 | trt = trt01, 69 | propensity.func = prop.func, 70 | loss = "sq_loss_lasso", 71 | nfolds = 5) # option for cv.glmnet 72 | 73 | comp <- summarize.subgroups(subgrp.model) 74 | print(comp, p.value = 0.01) 75 | 76 | # or we can simply supply the matrix x and the subgroups 77 | comp2 <- summarize.subgroups(x, subgroup = 1 * (subgrp.model$benefit.scores > 0)) 78 | 79 | print(comp2, p.value = 0.01) 80 | 81 | } 82 | \seealso{ 83 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models and 84 | \code{\link[personalized]{print.subgroup_summary}} for arguments for printing options for \code{summarize.subgroups()}. 85 | } 86 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | # personalized 0.2.7 3 | 4 | * Bug fix for GAM-based losses 5 | * Replaces gbm implementation with xgboost using a custom loss function 6 | * Adds vignette for estimation of flexible ITRs via xgboost 7 | 8 | 9 | # personalized 0.2.6 10 | 11 | * Various small improvements/bug fixes 12 | * Added changes to reflect the incoming JSS publication related to this package 13 | * The DOI in the CITATION is for a new JSS publication that will be registered after 14 | publication on CRAN. 15 | 16 | # personalized 0.2.5 17 | 18 | * Adds utilities for construction of augmentation functions and propensity score fitting functions 19 | * Adds vignette for multi-category treatments and for usage of augmentation/propensity score utilities 20 | * Various bug fixes 21 | 22 | # personalized 0.2.4 23 | 24 | * Added warning for use of Harrell's procedure in high dimensions 25 | * Changed default value for 'train.fraction' to 0.75 from 0.5 in 'validate.subgroup' 26 | * Minor improvements to plotting for 'subgroup_validated' objects 27 | 28 | # personalized 0.2.3 29 | 30 | * Fixes trt factor level reordering issue for plots 31 | 32 | # personalized 0.2.2 33 | 34 | * Fixes model printing error 35 | * Improves subgroup.summarize() output 36 | 37 | # personalized 0.2.1 38 | 39 | * Fixes default argument bug for r-oldrel + windows 40 | 41 | # personalized 0.2.0 42 | 43 | * Simplified plot labeling 44 | * Added clarifications to documentation 45 | * Added customized loss function option 46 | * Added options for count outcomes via Poisson negative log-likelihood as the loss 47 | * Added treatment effect calculation based on estimated benefit scores 48 | * Clarified/improved printing 49 | * Improved numerical stability of weighted.ksvm 50 | 51 | # personalized 0.1.5 52 | 53 | * Added printing of subgroup_validated results for quantile cutoffs via the which.quant argument 54 | 55 | # personalized 0.1.4 56 | 57 | * Added plots of means within treatment groups as the benefit scores are varied 58 | * Added quantile and median cutpoints as options 59 | * Fixes subgroup effect calculation to account for weights 60 | 61 | # personalized 0.1.3 62 | 63 | * Added NSW Study dataset 64 | 65 | # personalized 0.1.2 66 | 67 | * Added requirement for latest version of glmnet. old versions throw error when efficiency augmentation used 68 | 69 | # personalized 0.1.1 70 | 71 | * Fixed minor bugs regarding multiple treatment options, match.id 72 | 73 | * Added OWL-type losses: logistic and hinge surrogates (multiple treatment available for logistic surrogate) 74 | 75 | * Added outcome flipping OWL-type losses: logistic and hinge surrogates 76 | 77 | * Added augmentation option for non-continuous outcomes via offset 78 | 79 | # personalized 0.1.0 80 | 81 | * Added estimation functionality for multiple treatments 82 | 83 | * Updated all plot and summary type functions to properly handle results for multiple treatments 84 | 85 | * Aaron added plotting option for validation objects that allows the user to inspect the distribution of variable selections over the bootstrap or training/test resampling iterations 86 | 87 | * Added more options to printing of validation objects 88 | 89 | * Updated check.overlap() to handle multiple treatments 90 | 91 | * Aaron added match.id argument to allow proper analysis of matched case-control datasets 92 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/actions/setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: r-hub/actions/checkout@v1 55 | - uses: r-hub/actions/platform-info@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | - uses: r-hub/actions/setup-deps@v1 60 | with: 61 | token: ${{ secrets.RHUB_TOKEN }} 62 | job-config: ${{ matrix.config.job-config }} 63 | - uses: r-hub/actions/run-check@v1 64 | with: 65 | token: ${{ secrets.RHUB_TOKEN }} 66 | job-config: ${{ matrix.config.job-config }} 67 | 68 | other-platforms: 69 | needs: setup 70 | if: ${{ needs.setup.outputs.platforms != '[]' }} 71 | runs-on: ${{ matrix.config.os }} 72 | name: ${{ matrix.config.label }} 73 | strategy: 74 | fail-fast: false 75 | matrix: 76 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 77 | 78 | steps: 79 | - uses: r-hub/actions/checkout@v1 80 | - uses: r-hub/actions/setup-r@v1 81 | with: 82 | job-config: ${{ matrix.config.job-config }} 83 | token: ${{ secrets.RHUB_TOKEN }} 84 | - uses: r-hub/actions/platform-info@v1 85 | with: 86 | token: ${{ secrets.RHUB_TOKEN }} 87 | job-config: ${{ matrix.config.job-config }} 88 | - uses: r-hub/actions/setup-deps@v1 89 | with: 90 | job-config: ${{ matrix.config.job-config }} 91 | token: ${{ secrets.RHUB_TOKEN }} 92 | - uses: r-hub/actions/run-check@v1 93 | with: 94 | job-config: ${{ matrix.config.job-config }} 95 | token: ${{ secrets.RHUB_TOKEN }} 96 | -------------------------------------------------------------------------------- /man/create.propensity.function.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/augmentation_utils.R 3 | \name{create.propensity.function} 4 | \alias{create.propensity.function} 5 | \title{Creation of propensity fitting function} 6 | \usage{ 7 | create.propensity.function( 8 | crossfit = TRUE, 9 | nfolds.crossfit = 10, 10 | cv.glmnet.args = NULL 11 | ) 12 | } 13 | \arguments{ 14 | \item{crossfit}{A logical value indicating whether to use cross-fitting (\code{TRUE}) or not (\code{FALSE}). 15 | Cross-fitting is more computationally intensive, but helps to prevent overfitting, see Chernozhukov, et al. (2018)} 16 | 17 | \item{nfolds.crossfit}{An integer specifying the number of folds to use for cross-fitting. Must be greater than 1} 18 | 19 | \item{cv.glmnet.args}{A list of NAMED arguments to pass to the \code{\link[glmnet]{cv.glmnet}} function. For 20 | example, \code{cv.glmnet.args = list(type.measure = "mse", nfolds = 10)}. See \code{\link[glmnet]{cv.glmnet}} and \code{\link[glmnet]{glmnet}} 21 | for all possible options.} 22 | } 23 | \value{ 24 | A function which can be passed to the \code{augment.func} argument of the \code{\link[personalized]{fit.subgroup}} function. 25 | } 26 | \description{ 27 | Creates an propensity function that optionally utilizes cross-fitting 28 | } 29 | \examples{ 30 | library(personalized) 31 | 32 | set.seed(123) 33 | n.obs <- 500 34 | n.vars <- 15 35 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 36 | 37 | 38 | # simulate non-randomized treatment 39 | xbetat <- 0.5 + 0.5 * x[,7] - 0.5 * x[,9] 40 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 41 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 42 | 43 | trt <- 2 * trt01 - 1 44 | 45 | # simulate response 46 | # delta below drives treatment effect heterogeneity 47 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12] ) 48 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] + 0.5 * x[,15] ^ 2 49 | xbeta <- xbeta + delta * trt 50 | 51 | # continuous outcomes 52 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 53 | 54 | aug.func <- create.augmentation.function(family = "gaussian", 55 | crossfit = TRUE, 56 | nfolds.crossfit = 10, 57 | cv.glmnet.args = list(type.measure = "mae", 58 | nfolds = 5)) 59 | 60 | prop.func <- create.propensity.function(crossfit = TRUE, 61 | nfolds.crossfit = 10, 62 | cv.glmnet.args = list(type.measure = "mae", 63 | nfolds = 5)) 64 | 65 | subgrp.model <- fit.subgroup(x = x, y = y, 66 | trt = trt01, 67 | propensity.func = prop.func, 68 | augment.func = aug.func, 69 | loss = "sq_loss_lasso", 70 | nfolds = 10) # option for cv.glmnet (for ITR estimation) 71 | 72 | summary(subgrp.model) 73 | 74 | } 75 | \references{ 76 | Chernozhukov, V., Chetverikov, D., Demirer, M., Duflo, E., Hansen, C., Newey, W., & Robins, J. (2018). 77 | Double/debiased machine learning for treatment and structural parameters \url{https://arxiv.org/abs/1608.00060} 78 | } 79 | \seealso{ 80 | \code{\link[personalized]{fit.subgroup}} for estimating ITRs and \code{\link[personalized]{create.propensity.function}} for creation of propensity functions 81 | } 82 | -------------------------------------------------------------------------------- /man/create.augmentation.function.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/augmentation_utils.R 3 | \name{create.augmentation.function} 4 | \alias{create.augmentation.function} 5 | \title{Creation of augmentation functions} 6 | \usage{ 7 | create.augmentation.function( 8 | family, 9 | crossfit = TRUE, 10 | nfolds.crossfit = 10, 11 | cv.glmnet.args = NULL 12 | ) 13 | } 14 | \arguments{ 15 | \item{family}{The response type (see options in \code{\link[glmnet]{glmnet}} help file)} 16 | 17 | \item{crossfit}{A logical value indicating whether to use cross-fitting (\code{TRUE}) or not (\code{FALSE}). 18 | Cross-fitting is more computationally intensive, but helps to prevent overfitting, see Chernozhukov, et al. (2018)} 19 | 20 | \item{nfolds.crossfit}{An integer specifying the number of folds to use for cross-fitting. Must be greater than 1} 21 | 22 | \item{cv.glmnet.args}{A list of NAMED arguments to pass to the \code{\link[glmnet]{cv.glmnet}} function. For 23 | example, \code{cv.glmnet.args = list(type.measure = "mse", nfolds = 10)}. See \code{\link[glmnet]{cv.glmnet}} and \code{\link[glmnet]{glmnet}} 24 | for all possible options.} 25 | } 26 | \value{ 27 | A function which can be passed to the \code{augment.func} argument of the \code{\link[personalized]{fit.subgroup}} function. 28 | } 29 | \description{ 30 | Creates an augmentation function that optionally utilizes cross-fitting 31 | } 32 | \examples{ 33 | library(personalized) 34 | 35 | set.seed(123) 36 | n.obs <- 500 37 | n.vars <- 15 38 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 39 | 40 | 41 | # simulate non-randomized treatment 42 | xbetat <- 0.5 + 0.5 * x[,7] - 0.5 * x[,9] 43 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 44 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 45 | 46 | trt <- 2 * trt01 - 1 47 | 48 | # simulate response 49 | # delta below drives treatment effect heterogeneity 50 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12] ) 51 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] + 0.5 * x[,15] ^ 2 52 | xbeta <- xbeta + delta * trt 53 | 54 | # continuous outcomes 55 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 56 | 57 | aug.func <- create.augmentation.function(family = "gaussian", 58 | crossfit = TRUE, 59 | nfolds.crossfit = 10, 60 | cv.glmnet.args = list(type.measure = "mae", 61 | nfolds = 5)) 62 | 63 | prop.func <- create.propensity.function(crossfit = TRUE, 64 | nfolds.crossfit = 10, 65 | cv.glmnet.args = list(type.measure = "auc", 66 | nfolds = 5)) 67 | \dontrun{ 68 | subgrp.model <- fit.subgroup(x = x, y = y, 69 | trt = trt01, 70 | propensity.func = prop.func, 71 | augment.func = aug.func, 72 | loss = "sq_loss_lasso", 73 | nfolds = 10) # option for cv.glmnet (for ITR estimation) 74 | 75 | summary(subgrp.model) 76 | } 77 | 78 | } 79 | \references{ 80 | Chernozhukov, V., Chetverikov, D., Demirer, M., Duflo, E., Hansen, C., Newey, W., & Robins, J. (2018). 81 | Double/debiased machine learning for treatment and structural parameters \url{https://arxiv.org/abs/1608.00060} 82 | } 83 | \seealso{ 84 | \code{\link[personalized]{fit.subgroup}} for estimating ITRs and \code{\link[personalized]{create.propensity.function}} for creation of propensity functions 85 | } 86 | -------------------------------------------------------------------------------- /man/predict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/predict_subgroup.R, R/weighted_svm.R 3 | \name{predict.subgroup_fitted} 4 | \alias{predict.subgroup_fitted} 5 | \alias{predict.wksvm} 6 | \title{Function to predict either benefit scores or treatment recommendations} 7 | \usage{ 8 | \method{predict}{subgroup_fitted}( 9 | object, 10 | newx, 11 | type = c("benefit.score", "trt.group"), 12 | cutpoint = 0, 13 | ... 14 | ) 15 | 16 | \method{predict}{wksvm}(object, newx, type = c("class", "linear.predictor"), ...) 17 | } 18 | \arguments{ 19 | \item{object}{fitted object returned by \code{validate.subgrp()} function. 20 | 21 | For \code{predict.wksvm()}, this should be a fitted \code{wksvm} object from the \code{weighted.ksvm()} function} 22 | 23 | \item{newx}{new design matrix for which predictions will be made} 24 | 25 | \item{type}{type of prediction. \code{type = "benefit.score"} results in predicted benefit scores and 26 | \code{type = "trt.group"} results in prediction of recommended treatment group. 27 | 28 | For \code{predict.wksvm()}, \code{type = 'class'} yields predicted 29 | class and \code{type = 'linear.predictor'} yields estimated function (the sign of which is the estimated class)} 30 | 31 | \item{cutpoint}{numeric value for patients with benefit scores above which 32 | (or below which if \code{larger.outcome.better = FALSE}) 33 | will be recommended to be in the treatment group. Can also set \code{cutpoint = "median"}, which will 34 | use the median value of the benefit scores as the cutpoint or can set specific quantile values via \code{"quantx"} 35 | where \code{"x"} is a number between 0 and 100 representing the quantile value; e.g. \code{cutpoint = "quant75"} 36 | will use the 75th perent upper quantile of the benefit scores as the quantile.} 37 | 38 | \item{...}{not used} 39 | } 40 | \description{ 41 | Predicts benefit scores or treatment recommendations based on a fitted subgroup identification model 42 | 43 | Function to obtain predictions for weighted ksvm objects 44 | } 45 | \examples{ 46 | library(personalized) 47 | 48 | set.seed(123) 49 | n.obs <- 500 50 | n.vars <- 15 51 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 52 | 53 | 54 | # simulate non-randomized treatment 55 | xbetat <- 0.5 + 0.5 * x[,11] - 0.5 * x[,3] 56 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 57 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 58 | 59 | trt <- 2 * trt01 - 1 60 | 61 | # simulate response 62 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 63 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 64 | xbeta <- xbeta + delta * trt 65 | 66 | # continuous outcomes 67 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 68 | 69 | # create function for fitting propensity score model 70 | prop.func <- function(x, trt) 71 | { 72 | # fit propensity score model 73 | propens.model <- cv.glmnet(y = trt, 74 | x = x, family = "binomial") 75 | pi.x <- predict(propens.model, s = "lambda.min", 76 | newx = x, type = "response")[,1] 77 | pi.x 78 | } 79 | 80 | subgrp.model <- fit.subgroup(x = x, y = y, 81 | trt = trt01, 82 | propensity.func = prop.func, 83 | loss = "sq_loss_lasso", 84 | nfolds = 3) # option for cv.glmnet 85 | 86 | subgrp.model$subgroup.trt.effects 87 | benefit.scores <- predict(subgrp.model, newx = x, type = "benefit.score") 88 | 89 | rec.trt.grp <- predict(subgrp.model, newx = x, type = "trt.group") 90 | } 91 | \seealso{ 92 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 93 | 94 | \code{\link[personalized]{weighted.ksvm}} for fitting \code{weighted.ksvm} objects 95 | } 96 | -------------------------------------------------------------------------------- /man/plotCompare.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_compare.R 3 | \name{plotCompare} 4 | \alias{plotCompare} 5 | \title{Plot a comparison results for fitted or validated subgroup identification models} 6 | \usage{ 7 | plotCompare( 8 | ..., 9 | type = c("boxplot", "density", "interaction", "conditional"), 10 | avg.line = TRUE 11 | ) 12 | } 13 | \arguments{ 14 | \item{...}{the fitted (model or validation) objects to be plotted. Must be either 15 | objects returned from \code{fit.subgroup()} or \code{validate.subgroup()}} 16 | 17 | \item{type}{type of plot. \code{"density"} results in a density plot for the results 18 | across all observations (if \code{x} is from \code{fit.subgroup()}) or if \code{x} is from \code{validate.subgroup()} 19 | across iterations of either the bootstrap or training/test re-fitting. For the latter 20 | case the test results will be plotted. \code{"boxplot"} results in boxplots across all observations/iterations of either 21 | the bootstrap or training/test re-fitting. For the latter 22 | case the test results will be plotted. \code{"interaction"} creates an 23 | interaction plot for the different subgroups (crossing lines here means a meaningful subgroup). 24 | \code{"conditional"} plots smoothed (via a GAM smoother) means of the outcomes as a function of the estimated benefit score 25 | separately for the treated and untreated groups.} 26 | 27 | \item{avg.line}{boolean value of whether or not to plot a line for the average 28 | value in addition to the density (only valid for \code{type = "density"})} 29 | } 30 | \description{ 31 | Plots comparison of results for estimated subgroup treatment effects 32 | } 33 | \examples{ 34 | library(personalized) 35 | 36 | set.seed(123) 37 | n.obs <- 100 38 | n.vars <- 15 39 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 40 | 41 | 42 | # simulate non-randomized treatment 43 | xbetat <- 0.5 + 0.5 * x[,1] - 0.5 * x[,4] 44 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 45 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 46 | 47 | trt <- 2 * trt01 - 1 48 | 49 | # simulate response 50 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 51 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 52 | xbeta <- xbeta + delta * trt 53 | 54 | # continuous outcomes 55 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 56 | 57 | # create function for fitting propensity score model 58 | prop.func <- function(x, trt) 59 | { 60 | # fit propensity score model 61 | propens.model <- cv.glmnet(y = trt, 62 | x = x, family = "binomial") 63 | pi.x <- predict(propens.model, s = "lambda.min", 64 | newx = x, type = "response")[,1] 65 | pi.x 66 | } 67 | 68 | subgrp.model <- fit.subgroup(x = x, y = y, 69 | trt = trt01, 70 | propensity.func = prop.func, 71 | loss = "sq_loss_lasso", 72 | # option for cv.glmnet, 73 | # better to use 'nfolds=10' 74 | nfolds = 3) # option for cv.glmnet 75 | 76 | 77 | subgrp.model.o <- fit.subgroup(x = x, y = y, 78 | trt = trt01, 79 | propensity.func = prop.func, 80 | # option for cv.glmnet, 81 | # better to use 'nfolds=10' 82 | loss = "owl_logistic_flip_loss_lasso", 83 | nfolds = 3) 84 | 85 | plotCompare(subgrp.model, subgrp.model.o) 86 | 87 | } 88 | \seealso{ 89 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models and 90 | \code{\link[personalized]{validate.subgroup}} for function which creates validation results. 91 | } 92 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $("div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent.replace(/\n#>[^\n]*/g, ""); 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /man/check.overlap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_overlap.R 3 | \name{check.overlap} 4 | \alias{check.overlap} 5 | \title{Check propensity score overlap} 6 | \usage{ 7 | check.overlap( 8 | x, 9 | trt, 10 | propensity.func, 11 | type = c("histogram", "density", "both"), 12 | bins = 50L, 13 | alpha = ifelse(type == "both", 0.35, 0.5) 14 | ) 15 | } 16 | \arguments{ 17 | \item{x}{The design matrix (not including intercept term)} 18 | 19 | \item{trt}{treatment vector with each element equal to a 0 or a 1, with 1 indicating 20 | treatment status is active.} 21 | 22 | \item{propensity.func}{function that inputs the design matrix x and the treatment vector trt and outputs 23 | the propensity score, ie Pr(trt = 1 | X = x). Function should take two arguments 1) x and 2) trt. See example below. 24 | For a randomized controlled trial this can simply be a function that returns a constant equal to the proportion 25 | of patients assigned to the treatment group, i.e.: 26 | \code{propensity.func = function(x, trt) 0.5}.} 27 | 28 | \item{type}{Type of plot to create. Options are either a histogram (\code{type = "histogram"}) for each treatment 29 | group, a density (\code{type = "density"}) for each treatment group, or to plot both a density and histogram 30 | (\code{type = "code"})} 31 | 32 | \item{bins}{integer number of bins for histograms when \code{type = "histogram"}} 33 | 34 | \item{alpha}{value between 0 and 1 indicating transparency level (1 for solid, 0 for fully transparent)} 35 | } 36 | \description{ 37 | Results in a plot to check whether the propensity score has adequate overlap between treatment groups 38 | } 39 | \examples{ 40 | library(personalized) 41 | 42 | set.seed(123) 43 | n.obs <- 250 44 | n.vars <- 15 45 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 46 | 47 | 48 | # simulate non-randomized treatment 49 | xbetat <- 0.25 + 0.5 * x[,11] - 0.5 * x[,12] 50 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 51 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 52 | 53 | # create function for fitting propensity score model 54 | prop.func <- function(x, trt) 55 | { 56 | # fit propensity score model 57 | propens.model <- cv.glmnet(y = trt, 58 | x = x, family = "binomial") 59 | pi.x <- predict(propens.model, s = "lambda.min", 60 | newx = x, type = "response")[,1] 61 | pi.x 62 | } 63 | 64 | check.overlap(x = x, 65 | trt = trt01, 66 | propensity.func = prop.func) 67 | 68 | # now add density plot with histogram 69 | check.overlap(x = x, 70 | trt = trt01, 71 | type = "both", 72 | propensity.func = prop.func) 73 | 74 | 75 | # simulated non-randomized treatment with multiple levels 76 | xbetat_1 <- 0.15 + 0.5 * x[,9] - 0.25 * x[,12] 77 | xbetat_2 <- 0.15 - 0.5 * x[,11] + 0.25 * x[,15] 78 | trt.1.prob <- exp(xbetat_1) / (1 + exp(xbetat_1) + exp(xbetat_2)) 79 | trt.2.prob <- exp(xbetat_2) / (1 + exp(xbetat_1) + exp(xbetat_2)) 80 | trt.3.prob <- 1 - (trt.1.prob + trt.2.prob) 81 | prob.mat <- cbind(trt.1.prob, trt.2.prob, trt.3.prob) 82 | trt <- apply(prob.mat, 1, function(rr) rmultinom(1, 1, prob = rr)) 83 | trt <- apply(trt, 2, function(rr) which(rr == 1)) 84 | 85 | # use multinomial logistic regression model with lasso penalty for propensity 86 | propensity.multinom.lasso <- function(x, trt) 87 | { 88 | if (!is.factor(trt)) trt <- as.factor(trt) 89 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 90 | 91 | # predict returns a matrix of probabilities: 92 | # one column for each treatment level 93 | propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 94 | nfolds = 5, alpha = 0)) 95 | 96 | # return the probability corresponding to the 97 | # treatment that was observed 98 | probs <- propens[,match(levels(trt), colnames(propens))] 99 | 100 | probs 101 | } 102 | 103 | check.overlap(x = x, 104 | trt = trt, 105 | type = "histogram", 106 | propensity.func = propensity.multinom.lasso) 107 | 108 | 109 | 110 | } 111 | -------------------------------------------------------------------------------- /vignettes/fitting_itrs_with_xgboost.R: -------------------------------------------------------------------------------- 1 | ## ----loadpkg, message=FALSE, warning=FALSE, echo=FALSE------------------------ 2 | library(personalized) 3 | 4 | ## ----sim_data_1, message = FALSE, warning = FALSE----------------------------- 5 | library(personalized) 6 | 7 | set.seed(1) 8 | n.obs <- 500 9 | n.vars <- 10 10 | x <- matrix(rnorm(n.obs * n.vars, sd = 1), n.obs, n.vars) 11 | 12 | # simulate non-randomized treatment 13 | xbetat <- 0.5 + 0.25 * x[,1] - 0.25 * x[,5] 14 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 15 | trt <- rbinom(n.obs, 1, prob = trt.prob) 16 | 17 | # simulate delta (CATE) as a complex function of the covariates 18 | delta <- 2*(0.25 + x[,1] * x[,2] - x[,3] ^ {-2} * (x[,3] > 0.35) + 19 | (x[,1] < x[,3]) - (x[,1] < x[,2])) 20 | 21 | # simulate main effects g(X) 22 | xbeta <- x[,1] + x[,2] + x[,4] - 0.2 * x[,4]^2 + x[,5] + 0.2 * x[,9] ^ 2 23 | xbeta <- xbeta + delta * (2 * trt - 1) * 0.5 24 | 25 | # simulate continuous outcomes 26 | y <- drop(xbeta) + rnorm(n.obs) 27 | 28 | ## ----------------------------------------------------------------------------- 29 | # arguments can be passed to cv.glmnet via `cv.glmnet.args`. 30 | # normally we would set the number of crossfit folds and internal folds to be larger, 31 | # but have reduced it to make computation time shorter 32 | prop.func <- create.propensity.function(crossfit = TRUE, 33 | nfolds.crossfit = 4, 34 | cv.glmnet.args = list(type.measure = "auc", nfolds = 3)) 35 | 36 | ## ----------------------------------------------------------------------------- 37 | aug.func <- create.augmentation.function(family = "gaussian", 38 | crossfit = TRUE, 39 | nfolds.crossfit = 4, 40 | cv.glmnet.args = list(type.measure = "mse", nfolds = 3)) 41 | 42 | ## ----------------------------------------------------------------------------- 43 | subgrp.model.linear <- fit.subgroup(x = x, y = y, 44 | trt = trt, 45 | propensity.func = prop.func, 46 | augment.func = aug.func, 47 | loss = "sq_loss_lasso", 48 | nfolds = 3) # option for cv.glmnet (for ITR estimation) 49 | 50 | summary(subgrp.model.linear) 51 | 52 | ## ----------------------------------------------------------------------------- 53 | 54 | ## xgboost tuning parameters to use: 55 | param <- list(max_depth = 5, eta = 0.01, nthread = 1, 56 | booster = "gbtree", subsample = 0.623, colsample_bytree = 1) 57 | 58 | subgrp.model.xgb <- fit.subgroup(x = x, y = y, 59 | trt = trt, 60 | propensity.func = prop.func, 61 | augment.func = aug.func, 62 | ## specify xgboost via the 'loss' argument 63 | loss = "sq_loss_xgboost", 64 | nfold = 3, 65 | params = param, verbose = 0, 66 | nrounds = 5000, early_stopping_rounds = 50) 67 | 68 | subgrp.model.xgb 69 | 70 | ## ----eval=FALSE--------------------------------------------------------------- 71 | # valmod.lin <- validate.subgroup(subgrp.model.linear, B = 100, 72 | # method = "training_test", 73 | # train.fraction = 0.75) 74 | # valmod.lin 75 | 76 | ## ----eval=FALSE--------------------------------------------------------------- 77 | # valmod.xgb <- validate.subgroup(subgrp.model.xgb, B = 100, 78 | # method = "training_test", 79 | # train.fraction = 0.75) 80 | # valmod.xgb 81 | 82 | ## ---- fig.height=10----------------------------------------------------------- 83 | 84 | ## RMSE (note: this is still on the in-sample data so 85 | ## out-of-sample RMSE is preferred to evaluate methods) 86 | 87 | sqrt(mean((delta - treatment.effects(subgrp.model.linear)$delta) ^ 2)) 88 | sqrt(mean((delta - treatment.effects(subgrp.model.xgb)$delta) ^ 2)) 89 | 90 | par(mfrow = c(2,1)) 91 | plot(delta ~ treatment.effects(subgrp.model.linear)$delta, 92 | ylab = "True CATE", xlab = "Estimated Linear CATE") 93 | abline(a=0,b=1,col="blue") 94 | plot(delta ~ treatment.effects(subgrp.model.xgb)$delta, 95 | ylab = "True CATE", xlab = "CATE via xgboost") 96 | abline(a=0,b=1,col="blue") 97 | 98 | -------------------------------------------------------------------------------- /man/treatment.effects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calculate_treatment_effects.R 3 | \name{treatment.effects} 4 | \alias{treatment.effects} 5 | \alias{treatment.effects.default} 6 | \alias{treat.effects} 7 | \alias{treatment.effects.subgroup_fitted} 8 | \title{Calculation of covariate-conditional treatment effects} 9 | \usage{ 10 | treatment.effects(x, ...) 11 | 12 | \method{treatment.effects}{default}(x, ...) 13 | 14 | treat.effects( 15 | benefit.scores, 16 | loss = c("sq_loss_lasso", "logistic_loss_lasso", "poisson_loss_lasso", 17 | "cox_loss_lasso", "owl_logistic_loss_lasso", "owl_logistic_flip_loss_lasso", 18 | "owl_hinge_loss", "owl_hinge_flip_loss", "sq_loss_lasso_gam", 19 | "poisson_loss_lasso_gam", "logistic_loss_lasso_gam", "sq_loss_gam", 20 | "poisson_loss_gam", "logistic_loss_gam", "owl_logistic_loss_gam", 21 | "owl_logistic_flip_loss_gam", "owl_logistic_loss_lasso_gam", 22 | "owl_logistic_flip_loss_lasso_gam", "sq_loss_xgboost", "custom"), 23 | method = c("weighting", "a_learning"), 24 | pi.x = NULL, 25 | ... 26 | ) 27 | 28 | \method{treatment.effects}{subgroup_fitted}(x, ...) 29 | } 30 | \arguments{ 31 | \item{x}{a fitted object from \code{fit.subgroup()}} 32 | 33 | \item{...}{not used} 34 | 35 | \item{benefit.scores}{vector of estimated benefit scores} 36 | 37 | \item{loss}{loss choice USED TO CALCULATE \code{benefit.scores} of both the M function from Chen, et al (2017) and 38 | potentially the penalty used for variable selection. See \code{\link[personalized]{fit.subgroup}} for more details.} 39 | 40 | \item{method}{method choice USED TO CALCULATE \code{benefit.scores}. Either the \code{"weighting"} method or 41 | \code{"a_learning"} method. See \code{\link[personalized]{fit.subgroup}} for more details} 42 | 43 | \item{pi.x}{The propensity score for each observation} 44 | } 45 | \value{ 46 | A List with elements \code{delta} (if the treatment effects are a difference/contrast, 47 | i.e. \eqn{E[Y|T=1, X] - E[Y|T=-1, X]}) and \code{gamma} (if the treatment effects are a ratio, 48 | i.e. \eqn{E[Y|T=1, X] / E[Y|T=-1, X]}) 49 | } 50 | \description{ 51 | Calculates covariate conditional treatment effects using estimated benefit scores 52 | } 53 | \examples{ 54 | library(personalized) 55 | 56 | set.seed(123) 57 | n.obs <- 500 58 | n.vars <- 25 59 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 60 | 61 | 62 | # simulate non-randomized treatment 63 | xbetat <- 0.5 + 0.5 * x[,21] - 0.5 * x[,11] 64 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 65 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 66 | 67 | trt <- 2 * trt01 - 1 68 | 69 | # simulate response 70 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 71 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 72 | xbeta <- xbeta + delta * trt 73 | 74 | # continuous outcomes 75 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 76 | 77 | # time-to-event outcomes 78 | surv.time <- exp(-20 - xbeta + rnorm(n.obs, sd = 1)) 79 | cens.time <- exp(rnorm(n.obs, sd = 3)) 80 | y.time.to.event <- pmin(surv.time, cens.time) 81 | status <- 1 * (surv.time <= cens.time) 82 | 83 | # create function for fitting propensity score model 84 | prop.func <- function(x, trt) 85 | { 86 | # fit propensity score model 87 | propens.model <- cv.glmnet(y = trt, 88 | x = x, family = "binomial") 89 | pi.x <- predict(propens.model, s = "lambda.min", 90 | newx = x, type = "response")[,1] 91 | pi.x 92 | } 93 | 94 | subgrp.model <- fit.subgroup(x = x, y = y, 95 | trt = trt01, 96 | propensity.func = prop.func, 97 | loss = "sq_loss_lasso", 98 | nfolds = 3) # option for cv.glmnet 99 | 100 | trt_eff <- treatment.effects(subgrp.model) 101 | str(trt_eff) 102 | 103 | trt_eff 104 | 105 | 106 | library(survival) 107 | subgrp.model.cox <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), 108 | trt = trt01, 109 | propensity.func = prop.func, 110 | loss = "cox_loss_lasso", 111 | nfolds = 3) # option for cv.glmnet 112 | 113 | trt_eff_c <- treatment.effects(subgrp.model.cox) 114 | str(trt_eff_c) 115 | 116 | trt_eff_c 117 | 118 | } 119 | \seealso{ 120 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 121 | 122 | \code{\link[personalized]{print.individual_treatment_effects}} for printing of objects returned by 123 | \code{treat.effects} or \code{treatment.effects} 124 | } 125 | -------------------------------------------------------------------------------- /R/data_prep_utils.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | create.design.matrix.binary.trt <- function(x, pi.x, trt, method, reference.trt = NULL) 4 | { 5 | # trt must be supplied as integer vector 6 | # where 1 = treatment, 0 = control 7 | 8 | 9 | if (is.factor(trt)) 10 | { 11 | # drop any unused levels of trt 12 | trt <- droplevels(trt) 13 | unique.trts <- levels(trt) 14 | n.trts <- length(unique.trts) 15 | } else 16 | { 17 | unique.trts <- sort(unique(trt)) 18 | n.trts <- length(unique.trts) 19 | } 20 | 21 | # if not specified, set reference treatment 22 | # to be the last one 23 | if (is.null(reference.trt)) 24 | { 25 | reference.trt <- unique.trts[1L] 26 | } 27 | 28 | which.reference <- which(unique.trts == reference.trt) 29 | 30 | if (n.trts != 2) stop("two trtment levels only for binary trt design matrix function") 31 | 32 | # construct modified design matrices 33 | # depending on what method is used 34 | if (method == "weighting") 35 | { 36 | # create 1 and -1 version of treatment vector 37 | trt2 <- 2 * (trt != reference.trt) - 1 38 | 39 | x.tilde <- trt2 * cbind(1, x) 40 | } else 41 | { # A-learning method 42 | x.tilde <- (1 * (trt != reference.trt) - pi.x) * cbind(1, x) 43 | } 44 | x.tilde 45 | } 46 | 47 | create.weights.binary.trt <- function(pi.x, trt, method) 48 | { 49 | # trt must be supplied as integer vector 50 | # where 1 = treatment, 0 = control 51 | 52 | if (is.factor(trt)) 53 | { 54 | # drop any unused levels of trt 55 | trt <- droplevels(trt) 56 | unique.trts <- levels(trt) 57 | n.trts <- length(unique.trts) 58 | } else 59 | { 60 | unique.trts <- sort(unique(trt)) 61 | n.trts <- length(unique.trts) 62 | } 63 | 64 | if (n.trts != 2) stop("two trtment levels only for binary trt weighting function") 65 | 66 | # construct weights 67 | # depending on what method is used 68 | if (method == "weighting") 69 | { 70 | wts <- 1 / (pi.x * (trt == unique.trts[2L]) + (1 - pi.x) * (trt == unique.trts[1L])) 71 | } else 72 | { # A-learning method 73 | wts <- rep(1, length(pi.x)) 74 | } 75 | wts 76 | } 77 | 78 | 79 | 80 | 81 | 82 | 83 | create.weights.mult.trt <- function(pi.x, trt, method) 84 | { 85 | # trt must be supplied as factor (actually not anymore!) 86 | 87 | # construct weights 88 | # depending on what method is used 89 | if (method == "weighting") 90 | { 91 | wts <- 1 / (pi.x) 92 | } else 93 | { # A-learning method 94 | wts <- rep(1, length(pi.x)) 95 | } 96 | wts 97 | } 98 | 99 | 100 | create.design.matrix <- function(x, pi.x, trt, y, method, reference.trt = NULL) 101 | { 102 | # check if multiple treatments or not 103 | if (is.factor(trt)) 104 | { 105 | n.trts <- length(levels(trt)) 106 | } else 107 | { 108 | n.trts <- length(unique(trt)) 109 | } 110 | 111 | is.mult.trt <- n.trts > 2 112 | 113 | if (is.mult.trt) 114 | { 115 | # set to factor for multiple trtment trt vector if it isn't already 116 | if (!is.factor(trt)) trt <- as.factor(trt) 117 | 118 | return( create.design.matrix.mult.trt(x = cbind(1, x), 119 | pi.x = pi.x, 120 | trt = trt, 121 | #y = y, 122 | method = method, 123 | reference.trt = reference.trt) ) 124 | } else 125 | { 126 | return( create.design.matrix.binary.trt(x = x, 127 | pi.x = pi.x, 128 | trt = trt, 129 | method = method, 130 | reference.trt = reference.trt) ) 131 | } 132 | } 133 | 134 | create.weights <- function(pi.x, trt, method) 135 | { 136 | # check if multiple treatments or not 137 | if (is.factor(trt)) 138 | { 139 | n.trts <- length(levels(droplevels(trt))) 140 | } else 141 | { 142 | n.trts <- length(unique(trt)) 143 | } 144 | 145 | is.mult.trt <- n.trts > 2 146 | 147 | if (is.mult.trt) 148 | { 149 | # set to factor for multiple trtment trt vector if it isn't already 150 | if (!is.factor(trt)) trt <- as.factor(trt) 151 | 152 | return( create.weights.mult.trt(pi.x = pi.x, 153 | trt = trt, 154 | method = method) ) 155 | } else 156 | { 157 | return( create.weights.binary.trt(pi.x = pi.x, 158 | trt = trt, 159 | method = method) ) 160 | } 161 | } 162 | 163 | -------------------------------------------------------------------------------- /man/plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_subgroup_fitted.R, 3 | % R/plot_subgroup_validated.R 4 | \name{plot.subgroup_fitted} 5 | \alias{plot.subgroup_fitted} 6 | \alias{plot.subgroup_validated} 7 | \title{Plotting results for fitted subgroup identification models} 8 | \usage{ 9 | \method{plot}{subgroup_fitted}( 10 | x, 11 | type = c("boxplot", "density", "interaction", "conditional"), 12 | avg.line = TRUE, 13 | ... 14 | ) 15 | 16 | \method{plot}{subgroup_validated}( 17 | x, 18 | type = c("boxplot", "density", "interaction", "conditional", "stability"), 19 | avg.line = TRUE, 20 | ... 21 | ) 22 | } 23 | \arguments{ 24 | \item{x}{fitted object returned by \code{validate.subgroup()} or \code{fit.subgroup()} function} 25 | 26 | \item{type}{type of plot. \code{"density"} results in a density plot for the results 27 | across all observations (if \code{x} is from \code{fit.subgroup()}) or if \code{x} is from \code{validate.subgroup()} 28 | across iterations of either the bootstrap or training/test re-fitting. For the latter 29 | case the test results will be plotted. \code{"boxplot"} results in boxplots across all observations/iterations of either 30 | the bootstrap or training/test re-fitting. For the latter 31 | case the test results will be plotted. \code{"interaction"} creates an 32 | interaction plot for the different subgroups (crossing lines here means a meaningful subgroup). For the interaction plot, 33 | the intervals around each point represent +1 one SE 34 | \code{"conditional"} For subgroup_fitted objects, plots smoothed (via a GAM smoother) means of the outcomes as a function of the estimated benefit score 35 | separately for the treated and untreated groups. For subgroup_validated objects, boxplots of summary statistics 36 | within subgroups will be plotted as subgroups are defined by different cutoffs of the benefit scores. 37 | These cutoffs can be specified via the \code{benefit.score.quantiles} argument of 38 | \code{\link[personalized]{validate.subgroup}}.} 39 | 40 | \item{avg.line}{boolean value of whether or not to plot a line for the average 41 | value in addition to the density (only valid for \code{type = "density"})} 42 | 43 | \item{...}{not used} 44 | } 45 | \description{ 46 | Plots results for estimated subgroup treatment effects 47 | 48 | Plots validation results for estimated subgroup treatment effects 49 | } 50 | \examples{ 51 | library(personalized) 52 | 53 | set.seed(123) 54 | n.obs <- 250 55 | n.vars <- 15 56 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 57 | 58 | 59 | # simulate non-randomized treatment 60 | xbetat <- 0.5 + 0.5 * x[,11] - 0.5 * x[,13] 61 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 62 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 63 | 64 | trt <- 2 * trt01 - 1 65 | 66 | # simulate response 67 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 68 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 69 | xbeta <- xbeta + delta * trt 70 | 71 | # continuous outcomes 72 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 73 | 74 | # create function for fitting propensity score model 75 | prop.func <- function(x, trt) 76 | { 77 | # fit propensity score model 78 | propens.model <- cv.glmnet(y = trt, 79 | x = x, family = "binomial") 80 | pi.x <- predict(propens.model, s = "lambda.min", 81 | newx = x, type = "response")[,1] 82 | pi.x 83 | } 84 | 85 | subgrp.model <- fit.subgroup(x = x, y = y, 86 | trt = trt01, 87 | propensity.func = prop.func, 88 | loss = "sq_loss_lasso", 89 | # option for cv.glmnet, 90 | # better to use 'nfolds=10' 91 | nfolds = 3) # option for cv.glmnet 92 | 93 | subgrp.model$subgroup.trt.effects 94 | 95 | plot(subgrp.model) 96 | 97 | plot(subgrp.model, type = "boxplot") 98 | 99 | plot(subgrp.model, type = "interaction") 100 | 101 | plot(subgrp.model, type = "conditional") 102 | 103 | valmod <- validate.subgroup(subgrp.model, B = 3, 104 | method = "training_test", 105 | benefit.score.quantiles = c(0.25, 0.5, 0.75), 106 | train.fraction = 0.75) 107 | 108 | plot(valmod) 109 | 110 | 111 | plot(valmod, type = "interaction") 112 | 113 | # see how summary statistics of subgroups change 114 | # when the subgroups are defined based on different cutoffs 115 | # (25th quantile of bene score, 50th, and 75th) 116 | plot(valmod, type = "conditional") 117 | 118 | # visualize the frequency of particular variables 119 | # of being selected across the resampling iterations with 120 | # 'type = "stability"' 121 | # not run: 122 | # plot(valmod, type = "stability") 123 | 124 | } 125 | \seealso{ 126 | \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 127 | 128 | \code{\link[personalized]{validate.subgroup}} for function which creates validation results 129 | and \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 130 | } 131 | -------------------------------------------------------------------------------- /vignettes/multicategory_treatments_with_personalized.R: -------------------------------------------------------------------------------- 1 | ## ----loadpkg, message=FALSE, warning=FALSE------------------------------------ 2 | library(personalized) 3 | 4 | ## ----sim_three_trt_data------------------------------------------------------- 5 | set.seed(123) 6 | n.obs <- 250 7 | n.vars <- 10 8 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 9 | 10 | # simulated non-randomized treatment with multiple levels 11 | # based off of a multinomial logistic model 12 | xbetat_1 <- 0.1 + 0.5 * x[,1] - 0.25 * x[,5] 13 | xbetat_2 <- 0.1 - 0.5 * x[,9] + 0.25 * x[,5] 14 | trt.1.prob <- exp(xbetat_1) / (1 + exp(xbetat_1) + exp(xbetat_2)) 15 | trt.2.prob <- exp(xbetat_2) / (1 + exp(xbetat_1) + exp(xbetat_2)) 16 | trt.3.prob <- 1 - (trt.1.prob + trt.2.prob) 17 | 18 | prob.mat <- cbind(trt.1.prob, trt.2.prob, trt.3.prob) 19 | trt.mat <- apply(prob.mat, 1, function(rr) rmultinom(1, 1, prob = rr)) 20 | trt.num <- apply(trt.mat, 2, function(rr) which(rr == 1)) 21 | trt <- as.factor(paste0("Trt_", trt.num)) 22 | 23 | # simulate response 24 | 25 | # effect of treatment 1 relative to treatment 3 26 | delta1 <- 2 * (0.5 + x[,2] - 2 * x[,3] ) 27 | # effect of treatment 2 relative to treatment 3 28 | delta2 <- (0.5 + x[,6] - 2 * x[,5] ) 29 | 30 | # main covariate effects with nonlinearities 31 | xbeta <- x[,1] + x[,9] - 2 * x[,4]^2 + x[,4] + 32 | 0.5 * x[,5] ^ 2 + 2 * x[,2] - 3 * x[,5] 33 | 34 | # create entire functional form of E(Y|T,X) 35 | xbeta <- xbeta + 36 | delta1 * ((trt.num == 1) - (trt.num == 3) ) + 37 | delta2 * ((trt.num == 2) - (trt.num == 3) ) 38 | 39 | 40 | # simulate continuous outcomes E(Y|T,X) 41 | y <- xbeta + rnorm(n.obs, sd = 2) 42 | 43 | 44 | ## ----display_mult_trt_vector-------------------------------------------------- 45 | trt[1:5] 46 | table(trt) 47 | 48 | ## ----define_multi_propens----------------------------------------------------- 49 | propensity.multinom.lasso <- function(x, trt) 50 | { 51 | if (!is.factor(trt)) trt <- as.factor(trt) 52 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial", 53 | nfolds = 3) 54 | 55 | # predict returns a matrix of probabilities: 56 | # one column for each treatment level 57 | propens <- drop(predict(gfit, newx = x, 58 | type = "response", s = "lambda.min")) 59 | 60 | # return the matrix probability of treatment assignments 61 | probs <- propens[,match(levels(trt), colnames(propens))] 62 | 63 | probs 64 | } 65 | 66 | ## ----check_overlap_multitreat, fig.cap = "Propensity score overlap plot for multi-category treatment data."---- 67 | check.overlap(x = x, trt = trt, propensity.multinom.lasso) 68 | 69 | ## ----fit_multi_trt_model------------------------------------------------------ 70 | set.seed(123) 71 | subgrp.multi <- fit.subgroup(x = x, y = y, 72 | trt = trt, propensity.func = propensity.multinom.lasso, 73 | reference.trt = "Trt_3", 74 | loss = "sq_loss_lasso", 75 | nfolds = 3) 76 | 77 | summary(subgrp.multi) 78 | 79 | ## ----plot_multi_trt_model, warning=FALSE, message=FALSE, fig.width=5, fig.cap = "Individual outcome observations by treatment group and subgroup."---- 80 | pl <- plot(subgrp.multi) 81 | pl + theme(axis.text.x = element_text(angle = 90, hjust = 1)) 82 | 83 | ## ----validate_multi_trt_model, eval = TRUE------------------------------------ 84 | set.seed(123) 85 | validation.multi <- validate.subgroup(subgrp.multi, 86 | B = 4, # specify the number of replications 87 | method = "training_test_replication", 88 | train.fraction = 0.5) 89 | 90 | print(validation.multi, digits = 2, sample.pct = TRUE) 91 | 92 | ## ----plotcomparemultivalidated, warning=FALSE, message=FALSE, eval = TRUE, fig.width=5, fig.cap = "Validation results for multi-category treatment data."---- 93 | plv <- plot(validation.multi) 94 | plv + theme(axis.text.x = element_text(angle = 90, hjust = 1)) 95 | 96 | ## ----multinom_propens--------------------------------------------------------- 97 | propensity.func.multinom <- function(x, trt) 98 | { 99 | df <- data.frame(trt = trt, x) 100 | mfit <- nnet::multinom(trt ~ . -trt, data = df) 101 | # predict returns a matrix of probabilities: 102 | # one column for each treatment level 103 | propens <- nnet::predict.nnet(mfit, type = "probs") 104 | 105 | if (is.factor(trt)) 106 | { 107 | values <- levels(trt)[trt] 108 | } else 109 | { 110 | values <- trt 111 | } 112 | # return the probability corresponding to the 113 | # treatment that was observed 114 | probs <- propens[cbind(1:nrow(propens), 115 | match(values, colnames(propens)))] 116 | probs 117 | } 118 | 119 | ## ----multinom_propens2-------------------------------------------------------- 120 | propensity.func.multinom <- function(x, trt) 121 | { 122 | require(nnet) 123 | df <- data.frame(trt = trt, x) 124 | mfit <- multinom(trt ~ . -trt, data = df) 125 | # predict returns a matrix of probabilities: 126 | # one column for each treatment level 127 | propens <- predict(mfit, type = "probs") 128 | 129 | if (is.factor(trt)) 130 | { 131 | levels <- levels(trt) 132 | } else 133 | { 134 | levels <- sort(unique(trt)) 135 | } 136 | # return the probability corresponding to the 137 | # treatment that was observed 138 | probs <- propens[,match(levels, colnames(propens))] 139 | probs 140 | } 141 | 142 | -------------------------------------------------------------------------------- /tests/testthat/test-designmatrixcalc.R: -------------------------------------------------------------------------------- 1 | 2 | context("design matrix checking") 3 | 4 | test_that("test design matrix for binary trt works - weighting", { 5 | 6 | x <- matrix(1:8, ncol = 2) 7 | y <- 1:4 8 | trt <- c(rep(1, 2), rep(0, 2)) 9 | pi.x <- seq(0.2, 0.8, length.out = 4) 10 | 11 | xtilde <- create.design.matrix.binary.trt(x, pi.x, trt, "weighting") 12 | 13 | expect_equivalent(xtilde, (2 * trt - 1) * cbind(1, x) ) 14 | }) 15 | 16 | 17 | test_that("test create.design.matrix for binary trt works - weighting", { 18 | 19 | x <- matrix(1:8, ncol = 2) 20 | y <- 1:4 21 | trt <- c(rep(1, 2), rep(0, 2)) 22 | pi.x <- seq(0.2, 0.8, length.out = 4) 23 | 24 | xtilde <- create.design.matrix(x, pi.x, trt, y, "weighting") 25 | 26 | expect_equivalent(xtilde, (2 * trt - 1) * cbind(1, x) ) 27 | }) 28 | 29 | test_that("test design matrix for multi trt works - weighting", { 30 | 31 | x <- matrix(1:10, ncol = 2) 32 | y <- 1:5 33 | trt <- as.factor(c(1, 1, 2, rep(0, 2))) 34 | pi.x <- seq(0.2, 0.8, length.out = 5) 35 | 36 | xtilde <- create.design.matrix.mult.trt(x, pi.x, trt, "weighting", reference.trt = "2") 37 | 38 | xm <- matrix(0, ncol=4, nrow=5) 39 | xm[1:2,3:4] <- x[1:2,] 40 | xm[4:5,1:2] <- x[4:5,] 41 | xm[3,] <- rep(-x[3,], 2) 42 | 43 | expect_equivalent(xtilde, xm ) 44 | 45 | 46 | xtilde <- create.design.matrix.mult.trt(x, pi.x, trt, "weighting") 47 | 48 | expect_is(xtilde, "matrix") 49 | }) 50 | 51 | 52 | test_that("test create.design.matrix for multi trt works - weighting", { 53 | 54 | x <- matrix(1:10, ncol = 2) 55 | y <- 1:5 56 | trt <- c(1, 1, 2, rep(0, 2)) 57 | pi.x <- seq(0.2, 0.8, length.out = 5) 58 | 59 | xtilde <- create.design.matrix(x, pi.x, trt, y, "weighting", reference.trt = "2") 60 | 61 | x2 <- cbind(1, x) 62 | xm <- matrix(0, ncol=4 + 2, nrow=5) 63 | xm[1:2,4:6] <- x2[1:2,] 64 | xm[4:5,1:3] <- x2[4:5,] 65 | xm[3,] <- rep(-x2[3,], 2) 66 | 67 | expect_equivalent(xtilde, xm ) 68 | 69 | expect_error(xtilde <- create.design.matrix(x, pi.x, trt, y, "a_learning", reference.trt = "2")) 70 | }) 71 | 72 | test_that("test design matrix for binary trt works - a learning", { 73 | 74 | x <- matrix(1:8, ncol = 2) 75 | y <- 1:4 76 | trt <- c(rep(1, 2), rep(0, 2)) 77 | pi.x <- seq(0.2, 0.8, length.out = 4) 78 | 79 | xtilde <- create.design.matrix.binary.trt(x, pi.x, trt, "a_learning") 80 | 81 | expect_equivalent(xtilde, (1 * (trt != 0) - pi.x) * cbind(1, x) ) 82 | }) 83 | 84 | 85 | test_that("test create.design.matrix for binary trt works - a learning", { 86 | 87 | x <- matrix(1:8, ncol = 2) 88 | y <- 1:4 89 | trt <- c(rep(1, 2), rep(0, 2)) 90 | pi.x <- seq(0.2, 0.8, length.out = 4) 91 | 92 | xtilde <- create.design.matrix(x, pi.x, trt, y, "a_learning") 93 | 94 | expect_equivalent(xtilde, (1 * (trt != 0) - pi.x) * cbind(1, x) ) 95 | }) 96 | 97 | test_that("test weights for binary trt works - weighting", { 98 | 99 | trt <- c(rep(1, 2), rep(0, 2)) 100 | pi.x <- seq(0.2, 0.8, length.out = 4) 101 | 102 | wts <- create.weights.binary.trt(pi.x = pi.x, trt = trt, "weighting") 103 | 104 | expect_equivalent(wts, 1 / (pi.x * (trt == 1) + (1 - pi.x) * (trt == 0)) ) 105 | }) 106 | 107 | test_that("test weights for binary trt works - a_learning", { 108 | 109 | trt <- c(rep(1, 2), rep(0, 2)) 110 | pi.x <- seq(0.2, 0.8, length.out = 4) 111 | 112 | wts <- create.weights.binary.trt(pi.x = pi.x, trt = trt, "a_learning") 113 | 114 | expect_equivalent(wts, rep(1, length(trt)) ) 115 | }) 116 | 117 | 118 | 119 | test_that("test weights for multi trt works - weighting", { 120 | 121 | trt <- c(1:4) 122 | pi.x <- seq(0.2, 0.8, length.out = 4) 123 | 124 | wts <- create.weights.mult.trt(pi.x = pi.x, trt = trt, "weighting") 125 | 126 | expect_equivalent(wts, 1 / (pi.x) ) 127 | }) 128 | 129 | test_that("test weights for multi trt works - a_learning", { 130 | 131 | trt <- c(1:4) 132 | pi.x <- seq(0.2, 0.8, length.out = 4) 133 | 134 | wts <- create.weights.mult.trt(pi.x = pi.x, trt = trt, "a_learning") 135 | 136 | expect_equivalent(wts, rep(1, length(trt)) ) 137 | }) 138 | 139 | 140 | test_that("test create.weights for multi trt works - weighting", { 141 | 142 | trt <- c(1:4) 143 | pi.x <- seq(0.2, 0.8, length.out = 4) 144 | 145 | wts <- create.weights(pi.x = pi.x, trt = trt, "weighting") 146 | 147 | expect_equivalent(wts, 1 / (pi.x) ) 148 | }) 149 | 150 | test_that("test create.weights for multi trt works - a_learning", { 151 | 152 | trt <- c(1:4) 153 | pi.x <- seq(0.2, 0.8, length.out = 4) 154 | 155 | wts <- create.weights(pi.x = pi.x, trt = trt, "a_learning") 156 | 157 | expect_equivalent(wts, rep(1, length(trt)) ) 158 | }) 159 | 160 | 161 | test_that("test weights for binary trt works - weighting", { 162 | 163 | trt <- c(rep(1, 2), rep(0, 2)) 164 | pi.x <- seq(0.2, 0.8, length.out = 4) 165 | 166 | wts <- create.weights(pi.x = pi.x, trt = trt, "weighting") 167 | 168 | expect_equivalent(wts, 1 / (pi.x * (trt == 1) + (1 - pi.x) * (trt == 0)) ) 169 | }) 170 | 171 | test_that("test weights for binary trt works - a_learning", { 172 | 173 | trt <- c(rep(1, 2), rep(0, 2)) 174 | pi.x <- seq(0.2, 0.8, length.out = 4) 175 | 176 | wts <- create.weights(pi.x = pi.x, trt = trt, "a_learning") 177 | 178 | expect_equivalent(wts, rep(1, length(trt)) ) 179 | }) 180 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $('
      '); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
    • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

      `, then `

      `, etc.) that has more than one element. Defaults to 1 (for `

      `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /tests/testthat/test-wksvm.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | context("weighted.ksvm") 5 | 6 | test_that("weighted.ksvm fitting", { 7 | 8 | library(kernlab) 9 | 10 | set.seed(123) 11 | 12 | n <- 40 13 | 14 | x <- matrix(rnorm(n * 2), ncol = 2) 15 | 16 | y <- 2 * (sin(x[,2]) ^ 2 * exp(-x[,2]) > rnorm(n, sd = 0.1) + 0.225) - 1 17 | 18 | weights <- runif(n, max = 1.5, min = 0.5) 19 | 20 | wk <- weighted.ksvm(x = x[1:n/2,], y = y[1:n/2], C = c(0.1, 0.5, 1), 21 | weights = weights[1:n/2]) 22 | 23 | expect_is(wk, "wksvm") 24 | 25 | pr <- predict(wk, newx = x[1:n/2,]) 26 | 27 | if (Sys.info()[[1]] != "windows") 28 | { 29 | wk <- weighted.ksvm(x = x[1:n/2,], y = y[1:n/2], C = 1, 30 | weights = weights[1:n/2]) 31 | 32 | expect_is(wk, "wksvm") 33 | } 34 | 35 | expect_error(weighted.ksvm(x = x[1:(n/2+1),], y = y[1:n/2], C = c(10), 36 | weights = weights[1:n/2])) 37 | 38 | expect_error(weighted.ksvm(x = x[1:n/2,], y = y[1:n/2], C = c(0.1), 39 | weights = weights[1:(n/2 + 1)])) 40 | 41 | 42 | foldid <- sample(rep(seq(3), length = n/2)) 43 | 44 | if (Sys.info()[[1]] != "windows") 45 | { 46 | 47 | wk <- weighted.ksvm(x = x[1:n/2,], y = y[1:n/2], C = c(1, 3), 48 | foldid = foldid, 49 | weights = weights[1:n/2]) 50 | 51 | expect_is(wk, "wksvm") 52 | 53 | 54 | 55 | expect_error(weighted.ksvm(x = x[1:(n/2),], y = y[1:(n/2)], C = c(0.1), 56 | nfolds = 150, 57 | weights = weights[1:(n/2)])) 58 | 59 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.factor(y[1:(n/2)]), C = c(1, 3), 60 | foldid = foldid, 61 | weights = weights[1:(n/2)]) 62 | 63 | expect_is(wk, "wksvm") 64 | 65 | expect_error(weighted.ksvm(x = x[1:(n/2),], y = c(1:5, y[5:(n/2)]), C = c(0.1), 66 | weights = weights[1:(n/2)])) 67 | 68 | 69 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 3), 70 | foldid = foldid, 71 | weights = weights[1:(n/2)]) 72 | 73 | expect_is(wk, "wksvm") 74 | 75 | 76 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.factor(y[1:(n/2)]), C = c(1, 3), 77 | foldid = foldid, 78 | weights = weights[1:(n/2)]) 79 | 80 | expect_is(wk, "wksvm") 81 | 82 | expect_warning(weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 3), 83 | nfolds = -5, 84 | weights = weights[1:(n/2)])) 85 | 86 | expect_error(weighted.ksvm(x = x[1:(n/2),], y = y[1:(n/2)]/2 + 0.5, C = c(0.1), 87 | weights = weights[1:(n/2)])) 88 | 89 | 90 | 91 | 92 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 93 | foldid = foldid, 94 | kernel = "polydot", 95 | weights = weights[1:(n/2)]) 96 | 97 | expect_is(wk, "wksvm") 98 | 99 | 100 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.factor(y[1:(n/2)]), C = c(1, 3), 101 | foldid = foldid, 102 | weights = weights[1:(n/2)]) 103 | 104 | expect_is(wk, "wksvm") 105 | 106 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(10), 107 | foldid = foldid, 108 | kernel = "tanhdot", 109 | weights = rep(1, (n/2)), 110 | margin = 0.5, 111 | bound = 10, 112 | maxiter = 200) 113 | 114 | expect_is(wk, "wksvm") 115 | 116 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 117 | foldid = foldid, 118 | kernel = "vanilladot", 119 | weights = weights[1:(n/2)]) 120 | 121 | expect_is(wk, "wksvm") 122 | 123 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 124 | foldid = foldid, 125 | kernel = "laplacedot", 126 | weights = weights[1:(n/2)]) 127 | 128 | expect_is(wk, "wksvm") 129 | 130 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 131 | foldid = foldid, 132 | kernel = "besseldot", 133 | weights = weights[1:(n/2)]) 134 | 135 | expect_is(wk, "wksvm") 136 | 137 | wk <- weighted.ksvm(x = x[1:25,], y = as.character(y[1:25]), C = c(1, 10), 138 | kernel = "tanhdot", maxiter = 500, bound = 10, 139 | weights = weights[1:25]) 140 | 141 | expect_is(wk, "wksvm") 142 | 143 | summary(wk) 144 | 145 | wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 146 | foldid = foldid, 147 | kernel = "anovadot", 148 | weights = weights[1:(n/2)]) 149 | 150 | expect_is(wk, "wksvm") 151 | 152 | # wk <- weighted.ksvm(x = x[1:(n/2),], y = as.character(y[1:(n/2)]), C = c(1, 10), 153 | # foldid = foldid, 154 | # kernel = "splinedot", 155 | # weights = weights[1:(n/2)], 156 | # margin = 0.1, 157 | # maxiter = 100) 158 | # 159 | # expect_is(wk, "wksvm") 160 | } 161 | 162 | 163 | 164 | }) 165 | -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | Page not found (404) • personalized 9 | 10 | 11 | 12 | 13 | 14 | 15 | 19 | 20 | 21 | 22 | 23 |
      24 |
      88 | 89 | 90 | 91 | 92 |
      93 |
      94 |
      95 |

      Page not found (404)

      96 |
      97 | 98 | Content not found. Please use links in the navbar. 99 | 100 |
      101 | 102 | 106 | 107 |
      108 | 109 | 110 | 111 |
      112 |

      113 |

      Developed by Jared Huling.

      114 |
      115 | 116 |
      117 |

      118 |

      Site built with pkgdown 2.0.5.

      119 |
      120 | 121 |
      122 |
      123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | -------------------------------------------------------------------------------- /R/predict_subgroup.R: -------------------------------------------------------------------------------- 1 | 2 | #' Function to predict either benefit scores or treatment recommendations 3 | #' 4 | #' @description Predicts benefit scores or treatment recommendations based on a fitted subgroup identification model 5 | #' 6 | #' @param object fitted object returned by \code{validate.subgrp()} function. 7 | #' 8 | #' For \code{predict.wksvm()}, this should be a fitted \code{wksvm} object from the \code{weighted.ksvm()} function 9 | #' @param newx new design matrix for which predictions will be made 10 | #' @param type type of prediction. \code{type = "benefit.score"} results in predicted benefit scores and 11 | #' \code{type = "trt.group"} results in prediction of recommended treatment group. 12 | #' 13 | #' For \code{predict.wksvm()}, \code{type = 'class'} yields predicted 14 | #' class and \code{type = 'linear.predictor'} yields estimated function (the sign of which is the estimated class) 15 | #' @param cutpoint numeric value for patients with benefit scores above which 16 | #' (or below which if \code{larger.outcome.better = FALSE}) 17 | #' will be recommended to be in the treatment group. Can also set \code{cutpoint = "median"}, which will 18 | #' use the median value of the benefit scores as the cutpoint or can set specific quantile values via \code{"quantx"} 19 | #' where \code{"x"} is a number between 0 and 100 representing the quantile value; e.g. \code{cutpoint = "quant75"} 20 | #' will use the 75th perent upper quantile of the benefit scores as the quantile. 21 | #' @param ... not used 22 | #' @seealso \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 23 | #' @rdname predict 24 | #' 25 | #' @examples 26 | #' library(personalized) 27 | #' 28 | #' set.seed(123) 29 | #' n.obs <- 500 30 | #' n.vars <- 15 31 | #' x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 32 | #' 33 | #' 34 | #' # simulate non-randomized treatment 35 | #' xbetat <- 0.5 + 0.5 * x[,11] - 0.5 * x[,3] 36 | #' trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 37 | #' trt01 <- rbinom(n.obs, 1, prob = trt.prob) 38 | #' 39 | #' trt <- 2 * trt01 - 1 40 | #' 41 | #' # simulate response 42 | #' delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 43 | #' xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 44 | #' xbeta <- xbeta + delta * trt 45 | #' 46 | #' # continuous outcomes 47 | #' y <- drop(xbeta) + rnorm(n.obs, sd = 2) 48 | #' 49 | #' # create function for fitting propensity score model 50 | #' prop.func <- function(x, trt) 51 | #' { 52 | #' # fit propensity score model 53 | #' propens.model <- cv.glmnet(y = trt, 54 | #' x = x, family = "binomial") 55 | #' pi.x <- predict(propens.model, s = "lambda.min", 56 | #' newx = x, type = "response")[,1] 57 | #' pi.x 58 | #' } 59 | #' 60 | #' subgrp.model <- fit.subgroup(x = x, y = y, 61 | #' trt = trt01, 62 | #' propensity.func = prop.func, 63 | #' loss = "sq_loss_lasso", 64 | #' nfolds = 3) # option for cv.glmnet 65 | #' 66 | #' subgrp.model$subgroup.trt.effects 67 | #' benefit.scores <- predict(subgrp.model, newx = x, type = "benefit.score") 68 | #' 69 | #' rec.trt.grp <- predict(subgrp.model, newx = x, type = "trt.group") 70 | #' @export 71 | predict.subgroup_fitted <- function(object, 72 | newx, 73 | type = c("benefit.score", "trt.group"), 74 | cutpoint = 0, 75 | ...) 76 | { 77 | type <- match.arg(type) 78 | 79 | # simply call prediction function 80 | # defined by the loss function used 81 | if (grepl("owl_", object$loss) & object$n.trts > 2 & type == "trt.group") 82 | { 83 | retval <- drop(object$predict(newx, type = "class")) 84 | } else 85 | { 86 | retval <- drop(object$predict(newx)) 87 | } 88 | 89 | cutpoint <- convert.cutpoint(cutpoint, retval) 90 | 91 | # need to make predicted (ie recommended) 92 | # treatment behavior different if larger 93 | # outcomes are better 94 | if (type == "trt.group") 95 | { 96 | if (object$n.trts > 2) 97 | { 98 | if (grepl("owl_", object$loss)) 99 | { 100 | # nothing to be done 101 | } else 102 | { 103 | # meaning of larger vs smaller benefit score 104 | # is different depending on whether larger means 105 | # better or not for the outcome 106 | if (object$larger.outcome.better) 107 | { 108 | best.comp.idx <- apply(retval, 1, which.max) 109 | recommended.trt <- 1 * (retval > cutpoint) 110 | rec.ref <- rowSums(recommended.trt) == 0 111 | 112 | retval <- ifelse(rec.ref, object$reference.trt, object$comparison.trts[best.comp.idx]) 113 | } else 114 | { 115 | best.comp.idx <- apply(retval, 1, which.min) 116 | recommended.trt <- 1 * (retval < cutpoint) 117 | rec.ref <- rowSums(recommended.trt) == 0 118 | 119 | retval <- ifelse(rec.ref, object$reference.trt, object$comparison.trts[best.comp.idx]) 120 | } 121 | } 122 | 123 | } else 124 | { 125 | # meaning of larger vs smaller benefit score 126 | # is different depending on whether larger means 127 | # better or not for the outcome 128 | if (object$larger.outcome.better) 129 | { 130 | retval <- ifelse(retval > cutpoint, object$comparison.trts, object$reference.trt) 131 | } else 132 | { 133 | retval <- ifelse(retval < cutpoint, object$comparison.trts, object$reference.trt) 134 | } 135 | 136 | } 137 | 138 | } 139 | 140 | attr(retval, "comparison.trts") <- object$comparison.trts 141 | attr(retval, "reference.trt") <- object$reference.trt 142 | attr(retval, "trts") <- object$trts 143 | 144 | retval 145 | } 146 | -------------------------------------------------------------------------------- /tests/testthat/test-treatmenteffects.R: -------------------------------------------------------------------------------- 1 | 2 | context("treatment effect calculations") 3 | 4 | test_that("test that treatment effect calculations work", { 5 | 6 | set.seed(123) 7 | n.obs <- 1000 8 | n.vars <- 50 9 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 10 | 11 | 12 | # simulate non-randomized treatment 13 | xbetat <- 0.5 + 0.5 * x[,21] - 0.5 * x[,41] 14 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 15 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 16 | 17 | trt <- 2 * trt01 - 1 18 | 19 | # simulate response 20 | delta <- 2 * (0.5 + x[,2] - x[,3] - x[,11] + x[,1] * x[,12]) 21 | xbeta <- x[,1] + x[,11] - 2 * x[,12]^2 + x[,13] 22 | xbeta <- xbeta + delta * trt 23 | 24 | # continuous outcomes 25 | y <- drop(xbeta) + rnorm(n.obs, sd = 2) 26 | 27 | # binary outcomes 28 | y.binary <- 1 * (xbeta + rnorm(n.obs, sd = 2) > 0 ) 29 | 30 | # count outcomes 31 | y.count <- round(abs(xbeta + rnorm(n.obs, sd = 2))) 32 | 33 | 34 | # time-to-event outcomes 35 | surv.time <- exp(-20 - xbeta + rnorm(n.obs, sd = 1)) 36 | cens.time <- exp(rnorm(n.obs, sd = 3)) 37 | y.time.to.event <- pmin(surv.time, cens.time) 38 | status <- 1 * (surv.time <= cens.time) 39 | 40 | # create function for fitting propensity score model 41 | prop.func <- function(x, trt) 42 | { 43 | # fit propensity score model 44 | propens.model <- cv.glmnet(y = trt, 45 | x = x, family = "binomial") 46 | pi.x <- predict(propens.model, s = "lambda.min", 47 | newx = x, type = "response")[,1] 48 | pi.x 49 | } 50 | 51 | subgrp.model <- fit.subgroup(x = x, y = y, 52 | trt = trt01, 53 | propensity.func = prop.func, 54 | loss = "sq_loss_lasso", 55 | nfolds = 3) # option for cv.glmnet 56 | 57 | trt_eff <- treatment.effects(subgrp.model) 58 | 59 | print(trt_eff) 60 | 61 | expect_true(is.na(trt_eff$gamma)) 62 | 63 | subgrp.modela <- fit.subgroup(x = x, y = y, 64 | trt = trt01, 65 | propensity.func = prop.func, 66 | loss = "sq_loss_lasso", 67 | method = "a_learning", 68 | nfolds = 3) # option for cv.glmnet 69 | 70 | trt_eff <- treatment.effects(subgrp.modela) 71 | expect_true(is.na(trt_eff$gamma)) 72 | 73 | print(trt_eff) 74 | 75 | 76 | trt_eff <- treat.effects(subgrp.modela$benefit.scores, 77 | subgrp.modela$loss, 78 | subgrp.modela$method, 79 | subgrp.modela$pi.x) 80 | 81 | expect_error(treat.effects(subgrp.modela$benefit.scores, 82 | "poisson_loss_lasso_gam", 83 | subgrp.modela$method)) 84 | 85 | print(trt_eff) 86 | 87 | 88 | expect_warning(treat.effects(subgrp.modela$benefit.scores, 89 | "owl_logistic_flip_loss_gam", 90 | subgrp.modela$method, 91 | subgrp.modela$pi.x)) 92 | 93 | 94 | library(survival) 95 | subgrp.model.cox <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), 96 | trt = trt01, 97 | propensity.func = prop.func, 98 | loss = "cox_loss_lasso", 99 | nfolds = 3) # option for cv.glmnet 100 | 101 | trt_eff_c <- treatment.effects(subgrp.model.cox) 102 | 103 | expect_true(all(trt_eff_c$gamma >= 0)) 104 | expect_true(is.na(trt_eff_c$delta)) 105 | 106 | print(trt_eff_c) 107 | 108 | 109 | if (Sys.info()[[1]] != "windows") 110 | { 111 | ## other calculation types 112 | 113 | subgrp.model <- fit.subgroup(x = x, y = y.binary, 114 | trt = trt01, 115 | propensity.func = prop.func, 116 | loss = "owl_logistic_loss_lasso", 117 | nfolds = 3) # option for cv.glmnet 118 | 119 | trt_eff <- treatment.effects(subgrp.model) 120 | 121 | expect_true(all(trt_eff$gamma >= 0)) 122 | expect_true(is.na(trt_eff$delta)) 123 | 124 | 125 | 126 | subgrp.model <- fit.subgroup(x = x, y = y.count, 127 | trt = trt01, 128 | propensity.func = prop.func, 129 | loss = "poisson_loss_lasso", 130 | nfolds = 3) # option for cv.glmnet 131 | 132 | trt_eff <- treatment.effects(subgrp.model) 133 | 134 | subgrp.modela <- fit.subgroup(x = x, y = y.count, 135 | trt = trt01, 136 | propensity.func = prop.func, 137 | loss = "poisson_loss_lasso", 138 | method = "a_learning", 139 | nfolds = 3) # option for cv.glmnet 140 | 141 | trt_eff <- treatment.effects(subgrp.modela) 142 | 143 | 144 | 145 | subgrp.model <- fit.subgroup(x = x, y = y.binary, 146 | trt = trt01, 147 | propensity.func = prop.func, 148 | loss = "logistic_loss_lasso", 149 | nfolds = 3) # option for cv.glmnet 150 | 151 | trt_eff <- treatment.effects(subgrp.model) 152 | 153 | subgrp.modela <- fit.subgroup(x = x, y = y.binary, 154 | trt = trt01, 155 | propensity.func = prop.func, 156 | loss = "logistic_loss_lasso", 157 | method = "a_learning", 158 | nfolds = 3) # option for cv.glmnet 159 | 160 | trt_eff <- treatment.effects(subgrp.modela) 161 | } 162 | 163 | 164 | }) 165 | -------------------------------------------------------------------------------- /docs/articles/index.html: -------------------------------------------------------------------------------- 1 | 2 | Articles • personalized 6 | 7 | 8 |
      9 |
      65 | 66 | 67 | 68 |
      69 |
      70 |
      71 |

      Articles

      72 |
      73 | 74 |
      75 |

      All vignettes

      76 |

      77 | 78 |
      Utilities for Improving Estimation Efficiency via Augmentation and for Propensity Score Estimation
      79 |
      80 |
      Estimation of Flexible ITRs with xgboost
      81 |
      82 |
      Multi-category Treatments with `personalized`
      83 |
      84 |
      Usage of the Personalized Package
      85 |
      86 |
      87 |
      88 |
      89 | 90 | 91 |
      92 |

      Developed by Jared Huling.

      93 |
      94 | 95 |
      96 |

      Site built with pkgdown 2.0.5.

      97 |
      98 | 99 |
      100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /R/summary_subgroup.R: -------------------------------------------------------------------------------- 1 | 2 | #' Summary of results for fitted subgroup identification models 3 | #' 4 | #' @description Prints summary of results for estimated subgroup treatment effects 5 | #' 6 | #' @param object a fitted object from either \code{fit.subgroup} or \code{validate.subgroup} 7 | #' @param digits minimal number of significant digits to print. 8 | #' @param ... further arguments passed to or from \code{\link[base]{print.default}}. 9 | #' @seealso \code{\link[personalized]{validate.subgroup}} for function which creates validation results 10 | #' and \code{\link[personalized]{fit.subgroup}} for function which fits subgroup identification models. 11 | #' @rdname summary 12 | #' @export 13 | summary.subgroup_fitted <- function(object, digits = max(getOption('digits')-3, 3), ...) 14 | { 15 | print.subgroup_fitted(object, digits, ...) 16 | 17 | ## have special summary info printed for cv.glmnet objects 18 | if (class(object$model)[1] == "cv.glmnet") 19 | { 20 | est.coef <- predict(object$model, type = "coef", s = "lambda.min") 21 | 22 | 23 | nsel <- 0 24 | ntot <- 0 25 | if (is.list(est.coef)) 26 | { 27 | for (cl in 1:length(est.coef)) 28 | { 29 | nsel <- nsel + sum(est.coef[[cl]][-1] != 0) 30 | ntot <- ntot + length(as.vector(est.coef[[cl]][-1])) 31 | } 32 | } else 33 | { 34 | # drop unused intercept 35 | nsel <- sum(as.vector(est.coef)[-1] != 0) 36 | ntot <- length(as.vector(est.coef)[-1]) 37 | } 38 | 39 | ## if variables are selected print out how many are selected 40 | ## and their coefficient estimates 41 | 42 | cat("\n---------------------------------------------------\n\n") 43 | 44 | cat(nsel - object$n.trts + 1 - 1 * (grepl("owl_", object$loss) & object$n.trts > 2), 45 | "out of", 46 | ntot - object$n.trts + 1 - 1 * (grepl("owl_", object$loss) & object$n.trts > 2), 47 | "interactions selected in total by the lasso (cross validation criterion).\n\n") 48 | 49 | cat("The first estimate is the treatment main effect, which is always selected. \nAny other variables selected represent treatment-covariate interactions.\n\n") 50 | 51 | if (object$n.trts == 2) 52 | { 53 | vnames <- rownames(est.coef) 54 | est.coef <- as.vector(est.coef) 55 | sel.idx <- which(est.coef != 0) 56 | 57 | sel.varnames <- vnames[sel.idx] 58 | coefmat <- matrix(est.coef[sel.idx], ncol = 1) 59 | rownames(coefmat) <- sel.varnames 60 | colnames(coefmat) <- "Estimate" 61 | 62 | print.default(t(round(coefmat, digits)), quote = FALSE, right = TRUE, na.print = "NA", ...) 63 | } else 64 | { 65 | 66 | if (!grepl("owl_", object$loss)) 67 | { 68 | ## no extra intercept term when the model is a cox model 69 | if (class(object$model$glmnet.fit)[1] == "coxnet") 70 | { 71 | est.coef <- predict(object$model, type = "coef", s = "lambda.min") 72 | } else 73 | { 74 | est.coef <- predict(object$model, type = "coef", s = "lambda.min")[-1,,drop=FALSE] 75 | } 76 | 77 | 78 | vnames <- rownames(est.coef) 79 | 80 | ## remove the unecessary ".#" artificially added to variable names 81 | vnames <- gsub("[.][0-9]*$", "", vnames) 82 | 83 | all.coefs <- unname(as.vector(drop(est.coef))) 84 | 85 | n.coefs.per.trt <- length(all.coefs) / (object$n.trts - 1) 86 | for (t in 1:(object$n.trts - 1)) 87 | { 88 | idx.coefs.cur <- (n.coefs.per.trt * (t - 1) + 1):(n.coefs.per.trt * t) 89 | coefs.cur <- all.coefs[idx.coefs.cur] 90 | 91 | sel.idx <- which(coefs.cur != 0) 92 | 93 | cat("\n") 94 | 95 | ## if variables are selected print out how many are selected 96 | ## and their coefficient estimates 97 | sel.varnames.cur <- vnames[idx.coefs.cur][sel.idx] 98 | cat(length(sel.idx) - 1, 99 | "out of", 100 | length(coefs.cur) - 1, 101 | "variables selected for delta", t, "by the lasso (cross validation criterion).\n\n") 102 | 103 | coefmat <- matrix(coefs.cur[sel.idx], ncol = 1) 104 | 105 | rownames(coefmat) <- sel.varnames.cur 106 | colnames(coefmat) <- paste0("Estimates for delta (", 107 | object$comparison.trts[t], " vs ", object$reference.trt, ")" ) 108 | 109 | print.default(t(round(coefmat, digits)), quote = FALSE, right = TRUE, na.print = "NA", ...) 110 | } 111 | } else 112 | { 113 | for (t in 1:(object$n.trts)) 114 | { 115 | coefs.cur <- est.coef[[t]] 116 | vnames <- rownames(coefs.cur)[-1] 117 | 118 | vnames[1] <- object$trts[t] 119 | 120 | coefs.cur <- as.vector(coefs.cur)[-1] 121 | 122 | sel.idx <- which(coefs.cur != 0) 123 | 124 | cat("\n") 125 | 126 | ## if variables are selected print out how many are selected 127 | ## and their coefficient estimates 128 | sel.varnames.cur <- vnames[sel.idx] 129 | cat(length(sel.idx) - 1, 130 | "out of", 131 | length(coefs.cur) - 1, 132 | "variables selected for delta", t, "by the lasso (cross validation criterion).\n\n") 133 | 134 | coefmat <- matrix(coefs.cur[sel.idx], ncol = 1) 135 | 136 | rownames(coefmat) <- sel.varnames.cur 137 | colnames(coefmat) <- paste0("Estimates for delta(", 138 | object$trts[t],")" ) 139 | 140 | print.default(t(round(coefmat, digits)), quote = FALSE, right = TRUE, na.print = "NA", ...) 141 | } 142 | } 143 | } 144 | 145 | } else 146 | { 147 | cat("\n---------------------------------------------------\n") 148 | cat("The following summary pertains to estimated treatment-covariate interactions:\n") 149 | return(summary(object$model)) 150 | } 151 | } 152 | -------------------------------------------------------------------------------- /vignettes/efficiency_augmentation_personalized.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Utilities for Improving Estimation Efficiency via Augmentation and for Propensity Score Estimation" 3 | author: "Jared Huling" 4 | date: "`r Sys.Date()`" 5 | output: 6 | rmarkdown::html_vignette: 7 | fig_width: 7 8 | fig_height: 5 9 | toc: true 10 | toc_depth: 3 11 | number_sections: true 12 | self_contained: true 13 | preamble: > 14 | \usepackage{amsmath,amssymb,amsfonts,bm,bbm,amsthm} 15 | \usepackage{longtable} 16 | \usepackage{booktabs} 17 | \usepackage{bbm, bm} 18 | \def\bsx {\boldsymbol x} 19 | \def\bsX {\boldsymbol X} 20 | \def\bsT {\boldsymbol T} 21 | \def\bsbeta {\boldsymbol \beta} 22 | \def\bsgamma {\boldsymbol \gamma} 23 | \def\bsW {\boldsymbol W} 24 | \def\bsy {\boldsymbol y} 25 | \def\bsY {\boldsymbol Y} 26 | \def\bsM {\boldsymbol M} 27 | \def\bfx {\mathbf x} 28 | \def\bfX {\mathbf X} 29 | \def\bfT {\mathbf T} 30 | \def\bfW {\mathbf W} 31 | \def\bfy {\mathbf y} 32 | \def\bfY {\mathbf Y} 33 | \def\bfM {\mathbf M} 34 | \def\bfU {\mathbf U} 35 | vignette: > 36 | %\VignetteIndexEntry{Utilities for Improving Estimation Efficiency via Augmentation and for Propensity Score Estimation} 37 | %\VignetteEngine{knitr::rmarkdown} 38 | --- 39 | 40 | # Efficiency augmentation 41 | 42 | To demonstrate how to use efficiency augmentation and the propensity score utilities available in the `personalized` package, we simulate data with two treatments. The treatment assignments are based on covariates and hence mimic an observational setting with no unmeasured confounders. 43 | 44 | ```{r loadpkg, message=FALSE, warning=FALSE} 45 | library(personalized) 46 | ``` 47 | 48 | In this simulation, the treatment assignment depends on covariates and hence we must model the propensity score $\pi(x) = Pr(T = 1 | X = x)$. In this simulation we will assume that larger values of the outcome are better. 49 | 50 | ```{r sim_data_1, message = FALSE, warning = FALSE} 51 | library(personalized) 52 | 53 | set.seed(1) 54 | n.obs <- 500 55 | n.vars <- 10 56 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 57 | 58 | # simulate non-randomized treatment 59 | xbetat <- 0.5 + 0.25 * x[,9] - 0.25 * x[,1] 60 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 61 | trt <- rbinom(n.obs, 1, prob = trt.prob) 62 | 63 | # simulate delta 64 | delta <- (0.5 + x[,2] - 0.5 * x[,3] - 1 * x[,1] + 1 * x[,1] * x[,4] ) 65 | 66 | # simulate main effects g(X) 67 | xbeta <- 2 * x[,1] + 3 * x[,4] - 0.25 * x[,2]^2 + 2 * x[,3] + 0.25 * x[,5] ^ 2 68 | xbeta <- xbeta + delta * (2 * trt - 1) 69 | 70 | # simulate continuous outcomes 71 | y <- drop(xbeta) + rnorm(n.obs, sd = 3) 72 | ``` 73 | 74 | 75 | # Propensity score utilities 76 | 77 | Estimation of the propensity score is a fundamental aspect of the estimation of individualized treatment rules (ITRs). The `personalized` package offers support tools for construction of the propensity score function used by the `fit.subgroup()` function. The support is via the `create.propensity.function()` function. This tool allows for estimation of the propensity score in high dimensions via `glmnet`. In high dimensions it can be important to account for regularization bias via cross-fitting (); the `create.propensity.function()` offers a cross-fitting approach for high-dimensional propensity score estimation. A basic usage of this function with cross-fitting (with 4 folds; normally we would set this larger, but have reduced it to make computation time shorter) is as follows: 78 | 79 | ```{r} 80 | # arguments can be passed to cv.glmnet via `cv.glmnet.args` 81 | prop.func <- create.propensity.function(crossfit = TRUE, 82 | nfolds.crossfit = 4, 83 | cv.glmnet.args = list(type.measure = "auc", nfolds = 3)) 84 | ``` 85 | 86 | `prop.func` can then be passed to `fit.subgroup()` as follows: 87 | 88 | 89 | 90 | We have set `nfolds` to 3 for computational reasons; it should generally be higher, such as 10. 91 | ```{r} 92 | subgrp.model <- fit.subgroup(x = x, y = y, 93 | trt = trt, 94 | propensity.func = prop.func, 95 | loss = "sq_loss_lasso", 96 | nfolds = 3) # option for cv.glmnet (for ITR estimation) 97 | 98 | summary(subgrp.model) 99 | ``` 100 | 101 | # Augmentation utilities 102 | 103 | Efficiency in estimating ITRs can be improved by including an augmentation term. The optimal augmentation term generally is a function of the main effects of the full outcome regression model marginalized over the treatment. Especially in high dimensions, regularization bias can potentially have a negative impact on performance. Cross-fitting is again another reasonable approach to circumventing this issue. Augmentation functions can be constructed (with cross-fitting as an option) via the `create.augmentation.function()` function, which works similarly as the `create.propensity.function()` function. The basic usage is as follows: 104 | 105 | ```{r} 106 | aug.func <- create.augmentation.function(family = "gaussian", 107 | crossfit = TRUE, 108 | nfolds.crossfit = 4, 109 | cv.glmnet.args = list(type.measure = "mae", nfolds = 3)) 110 | ``` 111 | 112 | 113 | We have set `nfolds` to 3 for computational reasons; it should generally be higher, such as 10. 114 | 115 | `aug.func` can be used for augmentation by passing it to `fit.subgroup()` like: 116 | 117 | ```{r} 118 | subgrp.model.aug <- fit.subgroup(x = x, y = y, 119 | trt = trt, 120 | propensity.func = prop.func, 121 | augment.func = aug.func, 122 | loss = "sq_loss_lasso", 123 | nfolds = 3) # option for cv.glmnet (for ITR estimation) 124 | 125 | summary(subgrp.model.aug) 126 | ``` 127 | 128 | # Comparing performance with augmentation 129 | 130 | We first run the training/testing procedure to assess the performance of the non-augmented estimator: 131 | 132 | ```{r} 133 | valmod <- validate.subgroup(subgrp.model, B = 3, 134 | method = "training_test", 135 | train.fraction = 0.75) 136 | valmod 137 | ``` 138 | 139 | Then we compare with the augmented estimator. Although this is based on just 3 replications, we can see that the augmented estimator is better at discriminating between benefitting and non-benefitting patients, as evidenced by the large treatment effect among those predicted to benefit (and smaller standard error) by the augmented estimator versus the smaller conditional treatment effect above. 140 | 141 | ```{r} 142 | valmod.aug <- validate.subgroup(subgrp.model.aug, B = 3, 143 | method = "training_test", 144 | train.fraction = 0.75) 145 | valmod.aug 146 | ``` 147 | -------------------------------------------------------------------------------- /tests/testthat/test-checkoverlap.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | context("check.overlap") 4 | 5 | test_that("test plot is returned for hist/density/both", { 6 | 7 | 8 | set.seed(123) 9 | n.obs <- 50 10 | n.vars <- 5 11 | x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 12 | 13 | 14 | # simulate non-randomized treatment 15 | xbetat <- 0.25 + 0.5 * x[,1] - 0.5 * x[,5] 16 | trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 17 | trt01 <- rbinom(n.obs, 1, prob = trt.prob) 18 | 19 | # create function for fitting propensity score model 20 | prop.func <- function(x, trt) 21 | { 22 | # fit propensity score model 23 | propens.model <- cv.glmnet(y = trt, 24 | x = x, family = "binomial") 25 | pi.x <- predict(propens.model, s = "lambda.min", 26 | newx = x, type = "response")[,1] 27 | pi.x 28 | } 29 | 30 | # this one returns matrix with 1 column 31 | prop.func2 <- function(x, trt) 32 | { 33 | # fit propensity score model 34 | propens.model <- cv.glmnet(y = trt, 35 | x = x, family = "binomial") 36 | pi.x <- predict(propens.model, s = "lambda.min", 37 | newx = x, type = "response") 38 | pi.x 39 | } 40 | 41 | prop.func3 <- function(x, trt) 42 | { 43 | # fit propensity score model 44 | propens.model <- cv.glmnet(y = trt, 45 | x = x, family = "binomial") 46 | pi.x <- predict(propens.model, s = "lambda.min", 47 | newx = x, type = "response")[,1] 48 | dim(pi.x) <- NROW(pi.x) 49 | pi.x 50 | } 51 | 52 | pl <- check.overlap(x = x, 53 | trt = trt01, 54 | propensity.func = prop.func, 55 | type = "hist") 56 | 57 | expect_is(pl, "ggplot") 58 | 59 | 60 | pl <- check.overlap(x = x, 61 | trt = trt01, 62 | propensity.func = prop.func2, 63 | type = "hist") 64 | 65 | expect_is(pl, "ggplot") 66 | 67 | pl <- check.overlap(x = x, 68 | trt = trt01, 69 | propensity.func = prop.func3, 70 | type = "hist") 71 | 72 | expect_is(pl, "ggplot") 73 | 74 | pl <- check.overlap(x = x, 75 | trt = trt01, 76 | propensity.func = prop.func, 77 | type = "density") 78 | 79 | expect_is(pl, "ggplot") 80 | 81 | pl <- check.overlap(x = x, 82 | trt = trt01, 83 | propensity.func = prop.func, 84 | type = "both") 85 | 86 | expect_is(pl, "ggplot") 87 | 88 | 89 | # simulated non-randomized treatment with multiple levels 90 | xbetat_1 <- 0.15 + 0.5 * x[,1] - 0.25 * x[,5] 91 | xbetat_2 <- 0.15 - 0.5 * x[,2] + 0.25 * x[,3] 92 | trt.1.prob <- exp(xbetat_1) / (1 + exp(xbetat_1) + exp(xbetat_2)) 93 | trt.2.prob <- exp(xbetat_2) / (1 + exp(xbetat_1) + exp(xbetat_2)) 94 | trt.3.prob <- 1 - (trt.1.prob + trt.2.prob) 95 | prob.mat <- cbind(trt.1.prob, trt.2.prob, trt.3.prob) 96 | trt <- apply(prob.mat, 1, function(rr) rmultinom(1, 1, prob = rr)) 97 | trt <- apply(trt, 2, function(rr) which(rr == 1)) 98 | 99 | # use multinomial logistic regression model with lasso penalty for propensity 100 | propensity.multinom.lasso <- function(x, trt) 101 | { 102 | if (!is.factor(trt)) trt <- as.factor(trt) 103 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 104 | 105 | # predict returns a matrix of probabilities: 106 | # one column for each treatment level 107 | propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 108 | nfolds = 5, alpha = 0)) 109 | 110 | # return the probability corresponding to the 111 | # treatment that was observed 112 | probs <- propens[,match(levels(trt), colnames(propens))] 113 | 114 | probs 115 | } 116 | 117 | pl <- check.overlap(x = x, 118 | trt = trt, 119 | type = "histogram", 120 | propensity.func = propensity.multinom.lasso) 121 | 122 | expect_is(pl, "ggplot") 123 | 124 | 125 | # use multinomial logistic regression model with lasso penalty for propensity 126 | propensity.multinom.lasso <- function(x, trt) 127 | { 128 | if (!is.factor(trt)) trt <- as.factor(trt) 129 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 130 | 131 | # predict returns a matrix of probabilities: 132 | # one column for each treatment level 133 | propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 134 | nfolds = 5, alpha = 0)) 135 | 136 | # return the probability corresponding to the 137 | # treatment that was observed 138 | probs <- propens[cbind(1:nrow(propens), match(levels(trt)[trt], colnames(propens)))] 139 | 140 | probs 141 | } 142 | 143 | pl <- check.overlap(x = x, 144 | trt = trt, 145 | type = "histogram", 146 | propensity.func = propensity.multinom.lasso) 147 | 148 | expect_is(pl, "ggplot") 149 | 150 | 151 | # use multinomial logistic regression model with lasso penalty for propensity 152 | propensity.multinom.lasso.nonames <- function(x, trt) 153 | { 154 | if (!is.factor(trt)) trt <- as.factor(trt) 155 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 156 | 157 | # predict returns a matrix of probabilities: 158 | # one column for each treatment level 159 | propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 160 | nfolds = 5, alpha = 0)) 161 | 162 | # return the probability corresponding to the 163 | # treatment that was observed 164 | probs <- propens[,match(levels(trt), colnames(propens))] 165 | 166 | unname(probs) 167 | } 168 | 169 | pl <- check.overlap(x = x, 170 | trt = trt, 171 | type = "histogram", 172 | propensity.func = propensity.multinom.lasso.nonames) 173 | 174 | expect_is(pl, "ggplot") 175 | 176 | pl <- check.overlap(x = x, 177 | trt = as.factor(trt), 178 | type = "histogram", 179 | propensity.func = propensity.multinom.lasso.nonames) 180 | 181 | expect_is(pl, "ggplot") 182 | 183 | propensity.multinom.lasso.array <- function(x, trt) 184 | { 185 | if (!is.factor(trt)) trt <- as.factor(trt) 186 | gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 187 | 188 | # predict returns a matrix of probabilities: 189 | # one column for each treatment level 190 | propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 191 | nfolds = 5, alpha = 0)) 192 | 193 | # return the probability corresponding to the 194 | # treatment that was observed 195 | probs <- array(dim = c(dim(propens), 2, 4)) 196 | probs[is.na(probs)] <- 0.5 197 | probs 198 | } 199 | 200 | expect_error(check.overlap(x = x, 201 | trt = trt, 202 | type = "histogram", 203 | propensity.func = propensity.multinom.lasso.array)) 204 | }) 205 | -------------------------------------------------------------------------------- /R/check_overlap.R: -------------------------------------------------------------------------------- 1 | ..density.. <- NULL # need to make variable defined 2 | 3 | #' Check propensity score overlap 4 | #' 5 | #' @description Results in a plot to check whether the propensity score has adequate overlap between treatment groups 6 | #' 7 | #' @param x The design matrix (not including intercept term) 8 | #' @param trt treatment vector with each element equal to a 0 or a 1, with 1 indicating 9 | #' treatment status is active. 10 | #' @param propensity.func function that inputs the design matrix x and the treatment vector trt and outputs 11 | #' the propensity score, ie Pr(trt = 1 | X = x). Function should take two arguments 1) x and 2) trt. See example below. 12 | #' For a randomized controlled trial this can simply be a function that returns a constant equal to the proportion 13 | #' of patients assigned to the treatment group, i.e.: 14 | #' \code{propensity.func = function(x, trt) 0.5}. 15 | #' @param type Type of plot to create. Options are either a histogram (\code{type = "histogram"}) for each treatment 16 | #' group, a density (\code{type = "density"}) for each treatment group, or to plot both a density and histogram 17 | #' (\code{type = "code"}) 18 | #' @param bins integer number of bins for histograms when \code{type = "histogram"} 19 | #' @param alpha value between 0 and 1 indicating transparency level (1 for solid, 0 for fully transparent) 20 | #' @importFrom ggplot2 guides guide_legend 21 | #' @importFrom methods formalArgs 22 | #' @examples 23 | #' library(personalized) 24 | #' 25 | #' set.seed(123) 26 | #' n.obs <- 250 27 | #' n.vars <- 15 28 | #' x <- matrix(rnorm(n.obs * n.vars, sd = 3), n.obs, n.vars) 29 | #' 30 | #' 31 | #' # simulate non-randomized treatment 32 | #' xbetat <- 0.25 + 0.5 * x[,11] - 0.5 * x[,12] 33 | #' trt.prob <- exp(xbetat) / (1 + exp(xbetat)) 34 | #' trt01 <- rbinom(n.obs, 1, prob = trt.prob) 35 | #' 36 | #' # create function for fitting propensity score model 37 | #' prop.func <- function(x, trt) 38 | #' { 39 | #' # fit propensity score model 40 | #' propens.model <- cv.glmnet(y = trt, 41 | #' x = x, family = "binomial") 42 | #' pi.x <- predict(propens.model, s = "lambda.min", 43 | #' newx = x, type = "response")[,1] 44 | #' pi.x 45 | #' } 46 | #' 47 | #' check.overlap(x = x, 48 | #' trt = trt01, 49 | #' propensity.func = prop.func) 50 | #' 51 | #' # now add density plot with histogram 52 | #' check.overlap(x = x, 53 | #' trt = trt01, 54 | #' type = "both", 55 | #' propensity.func = prop.func) 56 | #' 57 | #' 58 | #' # simulated non-randomized treatment with multiple levels 59 | #' xbetat_1 <- 0.15 + 0.5 * x[,9] - 0.25 * x[,12] 60 | #' xbetat_2 <- 0.15 - 0.5 * x[,11] + 0.25 * x[,15] 61 | #' trt.1.prob <- exp(xbetat_1) / (1 + exp(xbetat_1) + exp(xbetat_2)) 62 | #' trt.2.prob <- exp(xbetat_2) / (1 + exp(xbetat_1) + exp(xbetat_2)) 63 | #' trt.3.prob <- 1 - (trt.1.prob + trt.2.prob) 64 | #' prob.mat <- cbind(trt.1.prob, trt.2.prob, trt.3.prob) 65 | #' trt <- apply(prob.mat, 1, function(rr) rmultinom(1, 1, prob = rr)) 66 | #' trt <- apply(trt, 2, function(rr) which(rr == 1)) 67 | #' 68 | #' # use multinomial logistic regression model with lasso penalty for propensity 69 | #' propensity.multinom.lasso <- function(x, trt) 70 | #' { 71 | #' if (!is.factor(trt)) trt <- as.factor(trt) 72 | #' gfit <- cv.glmnet(y = trt, x = x, family = "multinomial") 73 | #' 74 | #' # predict returns a matrix of probabilities: 75 | #' # one column for each treatment level 76 | #' propens <- drop(predict(gfit, newx = x, type = "response", s = "lambda.min", 77 | #' nfolds = 5, alpha = 0)) 78 | #' 79 | #' # return the probability corresponding to the 80 | #' # treatment that was observed 81 | #' probs <- propens[,match(levels(trt), colnames(propens))] 82 | #' 83 | #' probs 84 | #' } 85 | #' 86 | #' check.overlap(x = x, 87 | #' trt = trt, 88 | #' type = "histogram", 89 | #' propensity.func = propensity.multinom.lasso) 90 | #' 91 | #' 92 | #' 93 | #' @export 94 | check.overlap <- function(x, 95 | trt, 96 | propensity.func, 97 | type = c("histogram", "density", "both"), 98 | bins = 50L, 99 | alpha = ifelse(type == "both", 0.35, 0.5)) 100 | { 101 | type <- match.arg(type) 102 | bins <- as.integer(bins[1]) 103 | 104 | # compute propensity scores 105 | pi.x <- drop(propensity.func(x = x, trt = trt)) 106 | 107 | # make sure the resulting propensity scores are in the 108 | # acceptable range (ie 0-1) 109 | rng.pi <- range(pi.x) 110 | 111 | if (rng.pi[1] <= 0 | rng.pi[2] >= 1) stop("propensity.func() should return values between 0 and 1") 112 | 113 | # should be FALSE for treatment/control scenario, 114 | # TRUE for multiple treatment scenario 115 | multiplot <- FALSE 116 | 117 | dim.pi.x <- dim(pi.x) 118 | if (!is.null(dim.pi.x)) 119 | { 120 | if (length(dim.pi.x) == 1) 121 | { 122 | pi.x <- as.vector(pi.x) 123 | prop.scores <- data.frame(Treatment = as.factor(trt), prop.score = pi.x) 124 | 125 | } else if (length(dim.pi.x) > 2) 126 | { 127 | stop("propensity.func() returns a multidimensional array; it can only return a vector or matrix.") 128 | } 129 | 130 | 131 | trt.names <- colnames(pi.x) 132 | 133 | if (is.null(trt.names)) 134 | { 135 | if (is.factor(trt)) 136 | { 137 | # drop any unused levels of trt 138 | trt <- droplevels(trt) 139 | trt.names <- levels(trt) 140 | } else 141 | { 142 | trt.names <- sort(unique(trt)) 143 | } 144 | 145 | } 146 | 147 | prop.scores <- data.frame(Treatment_Received = as.factor(rep(trt, NCOL(pi.x))), 148 | Treatment = rep(trt.names, NROW(trt)), 149 | prop.score = as.vector(t(pi.x))) 150 | 151 | levels(prop.scores$Treatment_Received) <- paste(levels(prop.scores$Treatment_Received), "Group") 152 | 153 | multiplot <- TRUE 154 | 155 | } else 156 | { 157 | prop.scores <- data.frame(Treatment = as.factor(trt), prop.score = pi.x) 158 | } 159 | 160 | 161 | Treatment <- prop.score <- NULL 162 | 163 | if (type == "density") 164 | { 165 | pl.obj <- ggplot(prop.scores, aes(x = prop.score, fill = Treatment)) + 166 | geom_density(alpha = alpha, colour = "grey50") + 167 | geom_rug(aes(colour = Treatment)) + 168 | theme(legend.position = "bottom") + 169 | ggtitle("Densities of propensity scores by treatment group") + 170 | xlab("Propensity Score") 171 | } else if (type == "histogram") 172 | { 173 | pl.obj <- ggplot(prop.scores, aes(x = prop.score, fill = Treatment)) + 174 | geom_histogram(bins = bins, alpha = alpha, position = "identity") + 175 | geom_rug(aes(colour = Treatment)) + 176 | theme(legend.position = "bottom") + 177 | ggtitle("Histograms of propensity scores by treatment group") + 178 | xlab("Propensity Score") 179 | } else 180 | { 181 | pl.obj <- ggplot(prop.scores, aes(x = prop.score, fill = Treatment)) + 182 | geom_histogram(aes(y = ..density..), bins = bins, alpha = alpha, position = "identity") + 183 | geom_rug(aes(colour = Treatment)) + 184 | geom_density(alpha = alpha) + 185 | theme(legend.position = "bottom") + 186 | ggtitle("Densities and histograms of propensity scores by treatment group") + 187 | xlab("Propensity Score") 188 | } 189 | 190 | if (multiplot) 191 | { 192 | pl.obj <- pl.obj + facet_grid(Treatment_Received ~ .) 193 | } 194 | pl.obj 195 | } 196 | 197 | 198 | -------------------------------------------------------------------------------- /docs/reference/print.individual_treatment_effects.html: -------------------------------------------------------------------------------- 1 | 2 | Printing individualized treatment effects — print.individual_treatment_effects • personalized 6 | 7 | 8 |
      9 |
      65 | 66 | 67 | 68 |
      69 |
      70 |
      71 |

      Printing individualized treatment effects

      72 | Source: R/calculate_treatment_effects.R 73 | 74 |
      75 | 76 |
      77 |

      Prints results for estimated subgroup treatment effects

      78 |
      79 | 80 |
      81 | 
      # S3 method for individual_treatment_effects
 82 | print(x, digits = max(getOption("digits") - 3, 3), ...)
      83 |
      84 | 85 |
      86 |

      Arguments

      87 |
      x
      88 |

      a fitted object from either treat.effects or treatment.effects

      89 | 90 | 91 |
      digits
      92 |

      minimal number of significant digits to print.

      93 | 94 | 95 |
      ...
      96 |

      further arguments passed to or from print.default.

      97 | 98 |
      99 | 100 |
      101 | 104 |
      105 | 106 | 107 |
      108 |

      Developed by Jared Huling.

      109 |
      110 | 111 |
      112 |

      Site built with pkgdown 2.0.5.

      113 |
      114 | 115 |
      116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | Authors and Citation • personalized 6 | 7 | 8 |
      9 |
      65 | 66 | 67 | 68 |
      69 |
      70 |
      71 |
      72 |

      Authors

      73 |
      74 | 75 | 76 |
      • 77 |

        Jared Huling. Author, maintainer. 78 |

        79 |
        • 80 |
      • 81 |

        Aaron Potvien. Contributor. 82 |

        83 |
        • 84 |
      • 85 |

        Alexandros Karatzoglou. Copyright holder. 86 |

        87 |
        • 88 |
      • 89 |

        Alex Smola. Copyright holder. 90 |

        91 |
        • 92 |
      93 |
      94 |
      95 |

      Citation

      96 | Source: inst/CITATION 97 |
      98 |
      99 | 100 | 101 |

      Huling JD, Yu M (2021). 102 | “Subgroup Identification Using the personalized Package.” 103 | Journal of Statistical Software, 98(5), 1–60. 104 | doi:10.18637/jss.v098.i05. 105 |

      106 | 
      @Article{,
107 |   title = {Subgroup Identification Using the {personalized} Package},
108 |   author = {Jared D. Huling and Menggang Yu},
109 |   journal = {Journal of Statistical Software},
110 |   year = {2021},
111 |   volume = {98},
112 |   number = {5},
113 |   pages = {1--60},
114 |   doi = {10.18637/jss.v098.i05},
115 | }
      116 |

      Chen, S., Tian, L., Cai, T., Yu, M. (2017) A General Statistical Framework for Subgroup Identification and Comparative Treatment Scoring, Biometrics, Volume 73, Issue 4, Pages 1199-1209, https://doi.org/10.1111/biom.12676.

      117 | 
      @Article{,
118 |   author = {Shuai Chen and Lu Tian and Tianxi Cai and Menggang Yu},
119 |   title = {A General Statistical Framework for Subgroup Identification and Comparative Treatment Scoring},
120 |   journal = {Biometrics},
121 |   year = {2017},
122 |   volume = {73},
123 |   issue = {4},
124 |   pages = {1199--1209},
125 |   doi = {10.1111/biom.12676},
126 |   url = {https://doi.org/10.1111/biom.12676},
127 | }
      128 | 129 |
      130 | 131 |
      132 | 133 | 134 | 135 |
      144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | --------------------------------------------------------------------------------