229229# ' See \strong{Ensemble Strategy} section for details.
230230# ' @param individual_id Required when the dataset is a panel (e.g., individuals
231231# ' observed over multiple time periods). Specifies the column that identifies
232- # ' individuals so that (1) all observations for the same individual are placed
233- # ' in the same cross-fitting fold, and (2) cluster-robust standard errors are
234- # ' used in all downstream analyses.
232+ # ' the unit used to build cross-fitting folds, so that all observations for
233+ # ' the same unit are placed in the same fold. By default this identifier is
234+ # ' also used to cluster the standard errors in all downstream analyses; supply
235+ # ' \code{se_cluster_id} to cluster at a different level (see below).
235236# '
236237# ' Example: for a panel of students observed across semesters, set
237238# ' \code{individual_id = student_id}.
238239# '
239240# ' Can be an unquoted column name, a quoted string (\code{"student_id"}),
240241# ' or a vector of identifiers.
242+ # ' @param se_cluster_id Optional identifier for the level at which cluster-robust
243+ # ' standard errors are computed in the downstream analyses (\code{\link{blp}},
244+ # ' \code{\link{gates}}, \code{\link{clan}}, ...). Decouples SE clustering from
245+ # ' fold splitting: \code{individual_id} controls how folds are formed, while
246+ # ' \code{se_cluster_id} controls SE clustering. If only one of
247+ # ' \code{individual_id} / \code{se_cluster_id} is supplied, that identifier is
248+ # ' used for both roles. A message reporting the split level and the clustering
249+ # ' level is printed when the fit starts.
250+ # '
251+ # ' A typical use is predicting outcomes for unobserved units within observed
252+ # ' clusters (e.g., new villagers in sampled villages): split at the individual
253+ # ' level (\code{individual_id = id}) but cluster SEs at the village level
254+ # ' (\code{se_cluster_id = village}).
255+ # '
256+ # ' Accepts an unquoted column name, a quoted string, or a vector of
257+ # ' identifiers. Defaults to \code{individual_id}.
241258# ' @param n_cores Integer. Number of cores for parallel processing of repetitions.
242259# ' Default is 1 (sequential). Set to higher values to parallelize the M repetitions.
243260# ' Uses the \code{future} framework, so users can also set up their own parallel
297314# ' \item{task_type}{Task type (regr or classif)}
298315# ' \item{scale_covariates}{Whether covariates were scaled}
299316# ' \item{tune, tune_params}{Tuning settings}
300- # ' \item{individual_id}{Vector of individual identifiers (if panel data)}
317+ # ' \item{individual_id}{Vector of fold-splitting identifiers (if panel data)}
318+ # ' \item{se_cluster_id}{Vector of SE-clustering identifiers (if supplied or
319+ # ' inherited from \code{individual_id})}
301320# ' \item{n_cores}{Number of cores used for parallel processing}
302321# ' }
303322# '
@@ -432,6 +451,7 @@ ensemble_hte <- function(formula = NULL, treatment = NULL, data = NULL,
432451 train_idx = NULL ,
433452 ensemble_strategy = c(" cv" , " average" ),
434453 individual_id = NULL ,
454+ se_cluster_id = NULL ,
435455 n_cores = 1 ,
436456 store_baseline = c(" ensemble" , " none" , " all" )) {
437457
@@ -763,42 +783,57 @@ ensemble_hte <- function(formula = NULL, treatment = NULL, data = NULL,
763783 stop(" Y must not have NA values for training observations (where train_idx = TRUE)" )
764784 }
765785
766- # Handle individual_id for panel data
767- individual_id_vec <- NULL
786+ # Handle panel / cluster identifiers.
787+ # `individual_id` governs fold splitting (all its observations stay together
788+ # in one cross-fitting fold); `se_cluster_id` governs cluster-robust standard
789+ # errors in the downstream analyses. If only one is supplied, it is used for
790+ # BOTH roles.
791+ id_ind <- NULL
768792 if (! is.null(individual_id )) {
769- # Try to resolve individual_id as column name (like treatment)
770- id_expr <- substitute(individual_id )
771- id_resolved <- tryCatch(
772- parse_column_name(id_expr , parent.frame(), " individual_id" , data ),
773- error = function (e ) NULL
774- )
775-
776- if (! is.null(id_resolved ) && id_resolved %in% names(data )) {
777- individual_id_vec <- data [[id_resolved ]]
778- } else if (is.character(individual_id ) && length(individual_id ) == 1 && individual_id %in% names(data )) {
779- individual_id_vec <- data [[individual_id ]]
780- } else if (length(individual_id ) == n ) {
781- individual_id_vec <- individual_id
782- } else {
783- stop(" individual_id must be a column name in the data or a vector of length n (" , n , " )" )
793+ id_ind <- .resolve_panel_id(individual_id , substitute(individual_id ),
794+ parent.frame(), data , n , " individual_id" )
795+ }
796+ id_se <- NULL
797+ if (! is.null(se_cluster_id )) {
798+ id_se <- .resolve_panel_id(se_cluster_id , substitute(se_cluster_id ),
799+ parent.frame(), data , n , " se_cluster_id" )
800+ }
801+
802+ split_id_vec <- NULL ; split_id_name <- NULL
803+ cluster_id_vec <- NULL ; cluster_id_name <- NULL
804+ if (! is.null(id_ind ) && ! is.null(id_se )) {
805+ split_id_vec <- id_ind $ vec ; split_id_name <- id_ind $ name
806+ cluster_id_vec <- id_se $ vec ; cluster_id_name <- id_se $ name
807+ } else if (! is.null(id_ind )) {
808+ split_id_vec <- id_ind $ vec ; split_id_name <- id_ind $ name
809+ cluster_id_vec <- id_ind $ vec ; cluster_id_name <- id_ind $ name
810+ } else if (! is.null(id_se )) {
811+ split_id_vec <- id_se $ vec ; split_id_name <- id_se $ name
812+ cluster_id_vec <- id_se $ vec ; cluster_id_name <- id_se $ name
813+ }
814+
815+ if (! is.null(split_id_vec )) {
816+ if (anyNA(split_id_vec )) {
817+ stop(" The fold-splitting identifier ('" , split_id_name , " ') contains NA " ,
818+ " values. All observations must have an identifier." )
784819 }
785-
786- if (anyNA( individual_id_vec )) {
787- stop( " individual_id contains NA values. All observations must have an individual identifier." )
820+ if (anyNA( cluster_id_vec )) {
821+ stop( " The SE-clustering identifier (' " , cluster_id_name , " ') contains NA " ,
822+ " values. All observations must have an identifier." )
788823 }
789-
790- n_individuals <- length(unique(individual_id_vec ))
791- if (n_individuals == n ) {
792- warning(" Every observation has a unique individual_id (" , n_individuals ,
793- " unique IDs for " , n , " observations). " ,
794- " This is equivalent to no panel structure. " ,
795- " If your data is not panel data, you can omit individual_id." )
824+ n_split_groups <- length(unique(split_id_vec ))
825+ if (n_split_groups == n && ! (! is.null(id_ind ) && ! is.null(id_se ))) {
826+ warning(" Every observation has a unique '" , split_id_name , " ' value (" ,
827+ n_split_groups , " for " , n , " observations). " ,
828+ " This is equivalent to no panel structure for fold splitting." )
796829 }
797- if (n_individuals < K ) {
798- stop(" Number of unique individuals (" , n_individuals ,
830+ if (n_split_groups < K ) {
831+ stop(" Number of unique ' " , split_id_name , " ' groups (" , n_split_groups ,
799832 " ) must be at least K (" , K , " )" )
800833 }
801-
834+ message(" ensembleHTE: splitting cross-fitting folds by '" , split_id_name ,
835+ " ' (" , n_split_groups , " groups); clustering standard errors by '" ,
836+ cluster_id_name , " ' (" , length(unique(cluster_id_vec )), " clusters)." )
802837 }
803838
804839 # Propensity score handling
@@ -874,7 +909,7 @@ ensemble_hte <- function(formula = NULL, treatment = NULL, data = NULL,
874909 # Split the sample - stratify by D and train_idx
875910 stratify_var <- interaction(D , train_idx , drop = TRUE )
876911 splits <- create_folds(n , M = M , K = K , stratify_var = stratify_var ,
877- cluster_id = individual_id_vec )
912+ cluster_id = split_id_vec )
878913
879914 # Train learners and compute ensemble predictions
880915 ite_cols <- paste0(" ite_" , algorithms )
@@ -918,7 +953,10 @@ ensemble_hte <- function(formula = NULL, treatment = NULL, data = NULL,
918953 ite_rep <- rowMeans(predictions_m [, ite_cols , drop = FALSE ], na.rm = TRUE )
919954 } else if (ensemble_strategy == " cv" ) {
920955 # Cross-validated BLP ensemble
921- ens_splits <- create_folds(n , M = 1 , K = ensemble_folds , stratify_var = splits [[m ]])[[1 ]]
956+ # Cluster by individual_id_vec (when panel) so all observations for the same
957+ # unit stay in the same ensemble fold, mirroring the outer cross-fitting split.
958+ ens_splits <- create_folds(n , M = 1 , K = ensemble_folds , stratify_var = splits [[m ]],
959+ cluster_id = split_id_vec )[[1 ]]
922960 dt_ens <- data.table(
923961 Y = Y ,
924962 D = D ,
@@ -1085,7 +1123,10 @@ ensemble_hte <- function(formula = NULL, treatment = NULL, data = NULL,
10851123 prop_score = prop_score ,
10861124 weights = W ,
10871125 train_idx = train_idx ,
1088- individual_id = individual_id_vec ,
1126+ individual_id = split_id_vec ,
1127+ individual_id_name = split_id_name ,
1128+ se_cluster_id = cluster_id_vec ,
1129+ se_cluster_id_name = cluster_id_name ,
10891130 splits = splits ,
10901131 n = n ,
10911132 n_train = n_train ,
@@ -1207,8 +1248,9 @@ print.ensemble_hte_fit <- function(x, ...) {
12071248 cat(" Treatment: " , x $ treatment , " \n " , sep = " " )
12081249 cat(" Covariates: " , ncol(x $ X ), " \n " , sep = " " )
12091250 if (! is.null(x $ individual_id )) {
1210- n_individuals <- length(unique(x $ individual_id ))
1211- cat(" Panel data: " , n_individuals , " individuals\n " , sep = " " )
1251+ split_lbl <- if (! is.null(x $ individual_id_name )) x $ individual_id_name else " individual"
1252+ cat(" Split by: " , split_lbl , " (" ,
1253+ length(unique(x $ individual_id )), " groups)\n " , sep = " " )
12121254 }
12131255 cat(" \n " )
12141256 cat(" Model specification:\n " )
@@ -1229,8 +1271,13 @@ print.ensemble_hte_fit <- function(x, ...) {
12291271 }
12301272 cat(" Covariate scaling: " , scale_status , " \n " , sep = " " )
12311273 cat(" Hyperparameter tuning: " , tune_status , " \n " , sep = " " )
1232- if (! is.null(x $ individual_id )) {
1233- cat(" Standard errors: cluster-robust (at individual level)\n " , sep = " " )
1274+ cluster_vec <- if (! is.null(x $ se_cluster_id )) x $ se_cluster_id else x $ individual_id
1275+ if (! is.null(cluster_vec )) {
1276+ cl_lbl <- if (! is.null(x $ se_cluster_id_name )) x $ se_cluster_id_name
1277+ else if (! is.null(x $ individual_id_name )) x $ individual_id_name
1278+ else " individual"
1279+ cat(" Std. errors: cluster-robust by " , cl_lbl , " (" ,
1280+ length(unique(cluster_vec )), " clusters)\n " , sep = " " )
12341281 }
12351282 if (! is.null(x $ store_baseline ) && x $ store_baseline != " none" ) {
12361283 baseline_desc <- switch (x $ store_baseline ,
0 commit comments