## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( echo = TRUE, message = FALSE, warning = FALSE, collapse = TRUE, comment = "#>" ) ## ----setup-data, eval = FALSE------------------------------------------------- # library(gdpar) # set.seed(2026L) # n <- 300L # # df <- data.frame(x1 = rnorm(2L * n)) # df$arm <- rep(c("treat", "ctrl"), each = n) # df$y <- with(df, ifelse(arm == "treat", 0.5, 0) + # 0.8 * x1 + # rnorm(2L * n, sd = 0.5)) # df_t <- subset(df, arm == "treat"); df_t$arm <- NULL # df_c <- subset(df, arm == "ctrl"); df_c$arm <- NULL # # fit_t <- gdpar(y ~ x1, amm = amm_spec(a = ~ x1), data = df_t, # iter_warmup = 300, iter_sampling = 300, chains = 2) # fit_c <- gdpar(y ~ x1, amm = amm_spec(a = ~ x1), data = df_c, # iter_warmup = 300, iter_sampling = 300, chains = 2) # # newdata <- data.frame(x1 = seq(-2, 2, length.out = 21L)) # bridge <- gdpar_causal_bridge(fit_t, fit_c, newdata = newdata) ## ----grf-quick, eval = FALSE-------------------------------------------------- # adapter_grf <- gdpar_adapter_grf(num_trees = 500L, seed = 2026L) # cmp <- gdpar_compare_meta_learners( # bridge, # methods = list(grf = adapter_grf) # ) # print(cmp) # summary(cmp) ## ----grf-predict, eval = FALSE------------------------------------------------ # newdata2 <- data.frame(x1 = seq(-1.5, 1.5, length.out = 15L)) # cmp_new <- predict(cmp, newdata = newdata2) ## ----econml-install, eval = FALSE--------------------------------------------- # # 1. Install reticulate (R-side) if absent. # install.packages("reticulate") # # # 2. Register econml as a Python requirement, then install it. # reticulate::py_require("econml") # reticulate 1.46+ ephemeral-env style # reticulate::py_install("econml") # adds econml to the active env # # # 3. Verify. # reticulate::py_module_available("econml") # should be TRUE ## ----econml-use, eval = FALSE------------------------------------------------- # adapter_econml <- gdpar_adapter_econml(n_estimators = 500L, seed = 2026L) # cmp2 <- gdpar_compare_meta_learners( # bridge, # methods = list(grf = adapter_grf, # econml = adapter_econml) # ) # print(cmp2) # summary(cmp2) ## ----doubleml-sketch, eval = FALSE-------------------------------------------- # fit_predict_dml <- function(X, Y, T, X_newdata, level, seed_run) { # if (!requireNamespace("DoubleML", quietly = TRUE) || # !requireNamespace("mlr3learners", quietly = TRUE)) { # stop("DoubleML and mlr3learners are required for this adapter.") # } # d <- cbind(X, Y = as.numeric(Y), T = as.integer(T)) # dml_data <- DoubleML::DoubleMLData$new(d, y_col = "Y", d_cols = "T", # x_cols = setdiff(colnames(d), # c("Y", "T"))) # learner_g <- mlr3::lrn("regr.ranger", num.trees = 200L) # learner_m <- mlr3::lrn("classif.ranger", num.trees = 200L, # predict_type = "prob") # model <- DoubleML::DoubleMLPLR$new(dml_data, ml_g = learner_g$clone(), # ml_m = learner_m$clone()) # model$fit() # est <- as.numeric(model$coef) # est_se <- as.numeric(model$se) # z <- stats::qnorm(1 - (1 - level) / 2) # n_new <- nrow(X_newdata) # list( # cate_mean = rep(est, n_new), # cate_ci = cbind(lower = rep(est - z * est_se, n_new), # upper = rep(est + z * est_se, n_new)), # state = list(model = model), # notes = "DoubleMLPLR returns a single ATE coefficient; broadcast to a constant CATE." # ) # } # # predict_dml <- function(state, X_newdata, level) { # n_new <- nrow(X_newdata) # est <- as.numeric(state$model$coef) # est_se <- as.numeric(state$model$se) # z <- stats::qnorm(1 - (1 - level) / 2) # list( # cate_mean = rep(est, n_new), # cate_ci = cbind(lower = rep(est - z * est_se, n_new), # upper = rep(est + z * est_se, n_new)) # ) # } # # adapter_dml <- gdpar_meta_learner_adapter( # name = "doubleml_plr", # fit_predict_fun = fit_predict_dml, # predict_fun = predict_dml, # requires_r = c("DoubleML", "mlr3", "mlr3learners"), # native_ci = TRUE, # description = "DoubleMLPLR (constant CATE; useful as a robust ATE benchmark)" # ) # # cmp_with_dml <- gdpar_compare_meta_learners( # bridge, # methods = list(grf = adapter_grf, dml = adapter_dml) # )