R/rquery_treatment.R
as_rquery_plan.RdConvert vtreatment plans into a sequence of rquery operations.
as_rquery_plan(treatmentplans, ..., var_restriction = NULL)
| treatmentplans | vtreat treatment plan or list of vtreat treatment plan sharing same outcome and outcome type. |
|---|---|
| ... | not used, force any later arguments to bind to names. |
| var_restriction | character, if not null restrict to producing these variables. |
list(optree_generator (ordered list of functions), temp_tables (named list of tables))
if(requireNamespace("rquery", quietly = TRUE)) { dTrainC <- data.frame(x= c('a', 'a', 'a', 'b' ,NA , 'b'), z= c(1, 2, NA, 4, 5, 6), y= c(FALSE, FALSE, TRUE, FALSE, TRUE, TRUE), stringsAsFactors = FALSE) dTrainC$id <- seq_len(nrow(dTrainC)) treatmentsC <- designTreatmentsC(dTrainC, c("x", "z"), 'y', TRUE) print(prepare(treatmentsC, dTrainC)) rqplan <- as_rquery_plan(list(treatmentsC)) ops <- flatten_fn_list(rquery::local_td(dTrainC), rqplan$optree_generators) cat(format(ops)) if(requireNamespace("rqdatatable", quietly = TRUE)) { treated <- rqdatatable::ex_data_table(ops, tables = rqplan$tables) print(treated[]) } if(requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) { db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") source_data <- rquery::rq_copy_to(db, "dTrainC", dTrainC, overwrite = TRUE, temporary = TRUE) rest <- rquery_prepare(db, rqplan, source_data, "dTreatedC", extracols = "id") resd <- DBI::dbReadTable(db, rest$table_name) print(resd) rquery::rq_remove_table(db, source_data$table_name) rquery::rq_remove_table(db, rest$table_name) DBI::dbDisconnect(db) } }#> [1] "vtreat 1.6.3 inspecting inputs Fri Jun 11 07:01:16 2021" #> [1] "designing treatments Fri Jun 11 07:01:16 2021" #> [1] " have initial level statistics Fri Jun 11 07:01:16 2021" #> [1] " scoring treatments Fri Jun 11 07:01:16 2021" #> [1] "have treatment plan Fri Jun 11 07:01:16 2021" #> [1] "rescoring complex variables Fri Jun 11 07:01:16 2021" #> [1] "done rescoring complex variables Fri Jun 11 07:01:16 2021"#> Warning: possibly called prepare() on same data frame as designTreatments*()/mkCrossFrame*Experiment(), this can lead to over-fit. To avoid this, please use mkCrossFrame*Experiment$crossFrame.#> x_catP x_catB z z_isBAD x_lev_NA x_lev_x_a x_lev_x_b y #> 1 0.5000000 -0.6930972 1.0 0 0 1 0 FALSE #> 2 0.5000000 -0.6930972 2.0 0 0 1 0 FALSE #> 3 0.5000000 -0.6930972 3.6 1 0 1 0 TRUE #> 4 0.3333333 0.0000000 4.0 0 0 0 1 FALSE #> 5 0.1666667 9.2104404 5.0 0 1 0 0 TRUE #> 6 0.3333333 0.0000000 6.0 0 0 0 1 TRUE #> mk_td("dTrainC", c( #> "x", #> "z", #> "y", #> "id")) %.>% #> natural_join(., #> mk_td("vtreat_tmp_47164415312856458594_0000000000", c( #> "x", #> "x_catP")), #> jointype = "LEFT", by = c('x')) %.>% #> natural_join(., #> mk_td("vtreat_tmp_10375051208147029216_0000000000", c( #> "x", #> "x_catB")), #> jointype = "LEFT", by = c('x')) %.>% #> extend(., #> x_lev_NA := ifelse(is.na(x), 1, 0), #> x_lev_x_a := ifelse(is.na(x), 0, ifelse(x == "a", 1, 0)), #> x_lev_x_b := ifelse(is.na(x), 0, ifelse(x == "b", 1, 0)), #> x_catP := ifelse(is.na(x), 0.166666666666667, ifelse(is.na(x_catP), 0.0833333333333333, x_catP)), #> x_catB := ifelse(is.na(x), 9.21044036697607, ifelse(is.na(x_catB), 0, x_catB)), #> z := ifelse(is.na(z), 3.6, z)) %.>% #> extend(., #> z_isBAD := ifelse(is.na(z), 1, 0)) #> x id y z x_catP x_catB x_lev_NA x_lev_x_a x_lev_x_b z_isBAD #> 1 <NA> 5 TRUE 5.0 0.1666667 9.2104404 1 0 0 0 #> 2 a 1 FALSE 1.0 0.5000000 -0.6930972 0 1 0 0 #> 3 a 2 FALSE 2.0 0.5000000 -0.6930972 0 1 0 0 #> 4 a 3 TRUE 3.6 0.5000000 -0.6930972 0 1 0 0 #> 5 b 4 FALSE 4.0 0.3333333 0.0000000 0 0 1 0 #> 6 b 6 TRUE 6.0 0.3333333 0.0000000 0 0 1 0 #> z y id x_catP x_catB x_lev_NA x_lev_x_a x_lev_x_b z_isBAD #> 1 1.0 0 1 0.5000000 -0.6930972 0 1 0 0 #> 2 2.0 0 2 0.5000000 -0.6930972 0 1 0 0 #> 3 3.6 1 3 0.5000000 -0.6930972 0 1 0 0 #> 4 4.0 0 4 0.3333333 0.0000000 0 0 1 0 #> 5 5.0 1 5 0.1666667 9.2104404 1 0 0 0 #> 6 6.0 1 6 0.3333333 0.0000000 0 0 1 0