## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 4 ) ## ----derive, message = FALSE-------------------------------------------------- library(PTSDdiag) library(dplyr) data("simulated_ptsd") vet <- rename_ptsd_columns(simulated_ptsd[1:120, ], id_col = c("patient_id", "age", "sex")) comp_vet <- compare_optimizations( vet, n_top = 10, score_by = "balanced_accuracy", show_progress = FALSE ) ## ----figure, fig.alt = "Heatmap of PCL-5 symptom selection frequency in the veteran sample"---- plot_symptom_frequency(comp_vet, type = "relative") ## ----definitions-------------------------------------------------------------- definitions <- extract_definitions(comp_vet, n = 5) # The shared object: only symptom numbers and the rule to apply them lapply(definitions, function(d) d$symptoms) ## ----share-json--------------------------------------------------------------- json_file <- tempfile(fileext = ".json") write_combinations( definitions[["4/6 Hierarchical"]]$symptoms, json_file, n_required = 4, clusters = list(B = 1:5, C = 6:7, D = 8:14, E = 15:20), label = "4/6 Hierarchical", description = "Top 5 hierarchical combinations, veteran derivation sample" ) ## ----json-roundtrip----------------------------------------------------------- received <- as_definitions(read_combinations(json_file)) all.equal(received[["4/6 Hierarchical"]]$symptoms, definitions[["4/6 Hierarchical"]]$symptoms) ## ----perf-derivation---------------------------------------------------------- evaluate_definitions(vet, definitions, include_icd11 = TRUE) ## ----perf-validation---------------------------------------------------------- data("simulated_ptsd_genpop") # simulated_ptsd_genpop also carries paired CAPS-5 columns (C1..C20); here we # use only the PCL-5 items, so we select those before standardising. genpop <- rename_ptsd_columns( simulated_ptsd_genpop[, c("patient_id", "age", "sex", paste0("S", 1:20))], id_col = c("patient_id", "age", "sex") ) evaluate_definitions(genpop, definitions, include_icd11 = TRUE) ## ----tidy-table--------------------------------------------------------------- tidy_gp <- evaluate_definitions(genpop, definitions, tidy = TRUE) head(tidy_gp)