## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = FALSE ) ## ----setup-lr----------------------------------------------------------------- # library(QCA) # library(qcaERT) # # data(LR) # # conditions <- c("DEV", "URB", "LIT", "IND", "STB") # outcome <- "SURV" # dir_exp <- rep("1", length(conditions)) # # thresholds <- list( # DEV = findTh(LR$DEV, groups = 7), # URB = findTh(LR$URB, groups = 4), # LIT = findTh(LR$LIT, groups = 4), # IND = findTh(LR$IND, groups = 4), # STB = findTh(LR$STB, groups = 4), # SURV = findTh(LR$SURV, groups = 4) # ) # # dat <- LR # dat$DEV <- calibrate(LR$DEV, type = "fuzzy", thresholds = thresholds$DEV) # dat$URB <- calibrate(LR$URB, type = "fuzzy", thresholds = thresholds$URB) # dat$LIT <- calibrate(LR$LIT, type = "fuzzy", thresholds = thresholds$LIT) # dat$IND <- calibrate(LR$IND, type = "fuzzy", thresholds = thresholds$IND) # dat$STB <- calibrate(LR$STB, type = "fuzzy", thresholds = thresholds$STB) # dat$SURV <- calibrate(LR$SURV, type = "fuzzy", thresholds = thresholds$SURV) # # tt <- truthTable( # data = dat, # outcome = outcome, # conditions = conditions, # incl.cut = 0.8, # n.cut = 1 # ) # # sol <- minimize(tt, include = "?", dir.exp = dir_exp) # sol.df(intermediate = sol, solution = "intermediate") ## ----incl-ncut---------------------------------------------------------------- # incl_out <- incl.test( # data = dat, # outcome = outcome, # conditions = conditions, # incl.cut = 0.8, # n.cut = 1, # step = 0.02, # max_steps = 5, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # incl_out # as.data.frame(incl_out) # incl_out$diagnostics # # ncut_out <- ncut.test( # data = dat, # outcome = outcome, # conditions = conditions, # n.cut = 1, # incl.cut = 0.8, # step = 1, # max_steps = 3, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # ncut_out # as.data.frame(ncut_out) ## ----calib-------------------------------------------------------------------- # calib_spec <- list( # DEV = list(raw = "DEV", type = "fuzzy", thresholds = thresholds$DEV), # URB = list(raw = "URB", type = "fuzzy", thresholds = thresholds$URB), # LIT = list(raw = "LIT", type = "fuzzy", thresholds = thresholds$LIT), # IND = list(raw = "IND", type = "fuzzy", thresholds = thresholds$IND), # STB = list(raw = "STB", type = "fuzzy", thresholds = thresholds$STB) # ) # # calib_spec_outcome <- calib_spec # calib_spec_outcome$SURV <- list( # raw = "SURV", # type = "fuzzy", # thresholds = thresholds$SURV # ) # # calib_out <- calib.test( # raw.data = LR, # calib.data = dat, # outcome = outcome, # conditions = conditions, # calib_spec = calib_spec, # test.conditions = c("DEV", "URB"), # unit_step = NULL, # unit_step_divisor = 10, # max_steps = 5, # incl.cut = 0.8, # n.cut = 1, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # calib_out # as.data.frame(calib_out) # calib_out$bounds ## ----calib-outcome------------------------------------------------------------ # calib_outcome <- calib.test( # raw.data = LR, # calib.data = dat, # outcome = outcome, # conditions = conditions, # calib_spec = calib_spec_outcome, # test.conditions = NULL, # test.outcome = TRUE, # unit_step = NULL, # unit_step_divisor = 10, # max_steps = 5, # incl.cut = 0.8, # n.cut = 1, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) ## ----cases-samples------------------------------------------------------------ # loo_out <- loo.test( # data = dat, # outcome = outcome, # conditions = conditions, # cases = 1:5, # incl.cut = 0.8, # n.cut = 1, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # loo_out # as.data.frame(loo_out) # # subsample_out <- subsample.test( # data = dat, # outcome = outcome, # conditions = conditions, # sample_prop = 0.8, # reps = 25, # seed = 123, # incl.cut = 0.8, # n.cut = 1, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # subsample_out # subsample_out$summary ## ----altsets------------------------------------------------------------------ # altset_out <- altset.test( # raw.data = LR, # calib.data = dat, # outcome = outcome, # conditions = conditions, # calib_spec = calib_spec, # test.conditions = c("DEV", "URB"), # unit_step = NULL, # unit_step_divisor = 10, # calib_max_steps = 5, # incl.cut = 0.8, # incl_step = 0.02, # incl_max_steps = 5, # n.cut = 1, # ncut_step = 1, # ncut_max_steps = 2, # n_draws = 50, # seed = 123, # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # altset_out # as.data.frame(altset_out) # altset_out$summary ## ----theory------------------------------------------------------------------- # theories <- list( # development = c("DEV", "URB", "LIT"), # industrial = c("DEV", "URB", "IND"), # broad = c("DEV", "URB", "LIT", "IND", "STB") # ) # # dir_exp_theories <- list( # development = c("1", "1", "1"), # industrial = c("1", "1", "1"), # broad = c("1", "1", "1", "1", "1") # ) # # theory_out <- theory.test( # data = dat, # outcome = outcome, # theories = theories, # incl.cut = 0.8, # n.cut = 1, # solution = "all", # dir.exp = dir_exp_theories, # progress = TRUE # ) # # theory_out # as.data.frame(theory_out) # theory_out$results$solutions # theory_out$results$pairwise ## ----clusters----------------------------------------------------------------- # cluster_data <- dat # cluster_data$region <- ifelse(seq_len(nrow(cluster_data)) %% 2 == 0, "A", "B") # cluster_data$unit <- rownames(cluster_data) # # cluster_out <- cluster.test( # data = cluster_data, # tt = tt, # cluster_id = "region", # unit_id = "unit", # solution = "all", # dir.exp = dir_exp, # progress = TRUE # ) # # cluster_out # as.data.frame(cluster_out) # cluster_out$results$clusters # cluster_out$results$units ## ----plots-------------------------------------------------------------------- # plot(incl_out, solution_type = "conservative") # plot(calib_out, solution_type = "conservative") # plot(calib_out, solution_type = "conservative", type = "heatmap") # plot(calib_out, solution_type = "conservative", type = "trace", set = "DEV", anchor = "E1", direction = "lower") # plot(theory_out, solution_type = "conservative")