#' Metaprogramming function to return vectorized R code from rpart object
#'
#' @param frame This should be rpart$frame that has been supplied by prepare_rpart4code.R
#' @param f_depth Please don't change this. It's only meant to change itself during recursion.
#' @param f_row_order Please don't change this. It's only meant to change itself during recursion.
#' @examples
#' prepare_rpart4code(tree_2010_2015) %>% rpart2r() %>% message()
rpart2r_vec <- function(frame, f_depth = 1, f_row_order = 1, sep_char = "\t"){
frame_subset_1 <-
frame %>%
filter(depth == f_depth, row_order >= f_row_order) %>%
slice(1)
frame_subset_2 <-
frame %>%
filter(depth == f_depth, row_order >= f_row_order) %>%
slice(2)
if(frame_subset_1$sign == " = "){
insert_value <-
frame_subset_1$value %>%
str_replace_all(",",'","') %>%
paste0('c("',.,'")')
output_row_1 <- paste0(paste(rep(sep_char,(f_depth-1)*2),collapse = ""),"if_else(",frame_subset_1$variable," %in% ",insert_value,",\n")
} else output_row_1 <- paste0(paste(rep(sep_char,(f_depth-1)*2),collapse = ""),"if_else(",frame_subset_1$split,",\n")
if(frame_subset_1$terminal){
output_row_2 <- paste0(paste(rep(sep_char,f_depth*2),collapse = ""),frame_subset_1$yval,",")
} else{
#output_row_2 <-"recursion, "
#recursive call with increased depth and increased row_order based on the larger number than that row_order
output_row_2 <- paste0(rpart2r_vec(frame, f_depth = f_depth + 1, f_row_order = frame_subset_1$row_order),",")
}
if(frame_subset_2$terminal){
output_row_4 <- paste0("\n",paste(rep(sep_char,f_depth*2),collapse = ""),frame_subset_2$yval)
} else{
#output_row_4 <- "recursion2)"
#recursive call with increased depth and increased row_order based on the larger number than that row_order
output_row_4 <- paste0("\n",rpart2r_vec(frame, f_depth = f_depth + 1, f_row_order = frame_subset_2$row_order))
}
output_row_5 <- paste0("\n",paste(rep(sep_char,(f_depth)*2),collapse = ""),")")
return(paste0(output_row_1,output_row_2,output_row_4, output_row_5))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.