## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set(collapse = FALSE, comment = "") # Console colour carries no meaning on a rendered page. pkgdown turns it on for # its own build, and the escape sequences then reach the reader as literal text, # so colour is switched off here for a plain vignette render and a site build # alike. The fixed width keeps printed output inside the documentation column. options(cli.num_colors = 1, cli.hyperlink = FALSE, crayon.enabled = FALSE, width = 80) # Both optional packages are needed to turn the DOT source into an inline # SVG, so the rendering chunks below are skipped when either is absent. has_diagram <- requireNamespace("DiagrammeR", quietly = TRUE) && requireNamespace("DiagrammeRsvg", quietly = TRUE) ## ----setup-------------------------------------------------------------------- library(theoryforge) ## ----build-------------------------------------------------------------------- theory <- tf_theory("panic-network", "A network theory of panic") |> tf_add_construct("c_arousal", "Physiological arousal", "Bodily activation in response to a stressor.", measurement = "heart rate variability", boundary_conditions = "awake adults") |> tf_add_construct("c_threat", "Perceived threat", "Appraised danger of bodily sensations.", measurement = "self-report appraisal scale", boundary_conditions = "awake adults") |> tf_add_proposition( "p1", "c_arousal", "c_threat", "causes", mechanism = "Activation raises the salience of threat cues." ) |> tf_add_prediction("h1", "Arousal raises threat appraisal by a fixed amount.", "point", derives_from = "p1") isTRUE(tf_validate(theory)) # structural checks: required fields and enums # also checks referential integrity of ids and cross-references isTRUE(tf_validate(theory, full = TRUE)) ## ----validate-failure, error = TRUE------------------------------------------- try({ broken <- theory broken$predictions[[1]]$derives_from <- "p_missing" tf_validate(broken, full = TRUE) }) ## ----build-more--------------------------------------------------------------- extended <- theory |> tf_add_assumption("a1", "Arousal is measured at rest.", added_for = "h1") |> tf_set_formal_model("sem", spec_ref = "panic-sem.lavaan") ## ----provenance-entries------------------------------------------------------- do.call(rbind, lapply(extended$provenance, as.data.frame)) ## ----io----------------------------------------------------------------------- path <- tempfile(fileext = ".yaml") tf_write(theory, path) roundtrip <- tf_read(path) identical(roundtrip$id, theory$id) ## ----check-------------------------------------------------------------------- report <- tf_check(theory) report$aggregate_score # weighted score, 0-100, rounded to 1 dp report$gate # "pass", "blocked", or "advisory" (draft maturity) report$n_blockers_failed # count of failed blocker items # Per-item detail (checklist order preserved): report$items[[1]]$id # "falsifiability" report$items[[1]]$status # "pass" / "warn" / "fail" report$items[[1]]$score # numeric in [0, 1] ## ----report-json-------------------------------------------------------------- cat(tf_report(theory, format = "json")) ## ----report-html, results = "asis"-------------------------------------------- cat(tf_report(theory, format = "html")) ## ----redundancy--------------------------------------------------------------- tf_redundancy_check(theory) ## ----embedding-redundancy----------------------------------------------------- vocab <- c("bodily", "activation", "appraised", "danger", "salience") embedder <- function(def) { words <- strsplit(tolower(def), "[^a-z]+")[[1]] vapply(vocab, function(w) sum(words == w), numeric(1)) } tf_embedding_redundancy(theory, embedder) ## ----diagram------------------------------------------------------------------ cat(tf_diagram(theory, type = "nomological_net")) cat(tf_diagram(theory, type = "causal_dag")) ## ----diagram-render, results = "asis", eval = has_diagram--------------------- cat( '
', tf_render_diagram(theory, "nomological_net", as = "svg"), '
', sep = "" ) ## ----simulate----------------------------------------------------------------- sim <- tf_simulate(theory, steps = 5) unlist(sim$states) unlist(sim$trajectory[[1]]) # the common initial state unlist(sim$trajectory[[6]]) # after five Euler steps