diff --git a/R/asSQL.R b/R/asSQL.R new file mode 100644 index 0000000..d22782e --- /dev/null +++ b/R/asSQL.R @@ -0,0 +1,33 @@ +asSQL <- function(model, ...) UseMethod("asSQL") + +asSQL.rpart <- function(model, ...) +{ + if (!inherits(model, "rpart")) stop(Rtxt("Not a legitimate rpart tree")) + target <- as.character(attr(model$terms, "variables")[2]) # name of the dependent variable + frm <- model$frame # a dataframe containing the nodes of the tree + names <- row.names(frm) # the (unique) node numbers that follow a binary ordering indexed by node depth + ds.size <- model$frame[1,]$n # total number of rows in the data + ordered <- sort(frm$n, decreasing = TRUE, index.return = TRUE)$ix + + cat("CASE ") + for (i in ordered) + { + if (frm[i,1] == "") + { + cat("WHEN \n") + yval <- frm[i,]$yval + pth <- path.rpart(model, + nodes = as.numeric(names[i]), + print.it = FALSE, + sql = TRUE) + pth <- unlist(pth)[-1] + if (length(pth) == 0) {pth <- "True"} + + cat(sprintf(" %s\n", pth, sep = "")) + cat(sprintf(" %s %s\n", + "THEN", yval)) + } + } + cat("\n") + invisible(ordered) +} diff --git a/R/labels.rpart.R b/R/labels.rpart.R index 8a5e839..87a2f2a 100644 --- a/R/labels.rpart.R +++ b/R/labels.rpart.R @@ -14,7 +14,7 @@ ## ... = other args for abbreviate() ## labels.rpart <- function(object, digits = 4, minlength = 1L, pretty, - collapse = TRUE, ...) + collapse = TRUE, sql = FALSE, ...) { if (missing(minlength) && !missing(pretty)) { minlength <- if (is.null(pretty)) 1L @@ -75,7 +75,7 @@ labels.rpart <- function(object, digits = 4, minlength = 1L, pretty, j <- jrow[i] splits <- object$csplit[crow[i], ] ## splits will contain 1=left, 3=right, 2= neither - cl <- if (minlength == 1L) "" else "," + cl <- if (minlength == 1L) "" else if (sql) "', '" else "," lsplit[j] <- paste((xlevels[[cindex[i]]])[splits == 1L], collapse = cl) rsplit[j] <- @@ -90,8 +90,17 @@ labels.rpart <- function(object, digits = 4, minlength = 1L, pretty, return(cbind(ltemp, rtemp)) } - lsplit <- paste0(ifelse(ncat < 2L, "", "="), lsplit) - rsplit <- paste0(ifelse(ncat < 2L, "", "="), rsplit) + if (sql) { + lsplit <- ifelse(ncat < 2L, + paste0( "", lsplit), + paste0(paste0(" in ('", lsplit), "')")) + rsplit <- ifelse(ncat < 2L, + paste0( "", rsplit), + paste0(paste0(" in ('", rsplit), "')")) + } else { + lsplit <- paste0(ifelse(ncat < 2L, "", "="), lsplit) + rsplit <- paste0(ifelse(ncat < 2L, "", "="), rsplit) + } ## Now match them up to node numbers ## The output will have one label per row of object$frame, each diff --git a/R/path.rpart.R b/R/path.rpart.R index 4a78669..f04b2ad 100644 --- a/R/path.rpart.R +++ b/R/path.rpart.R @@ -1,10 +1,10 @@ ## submitted by Anantha Prasad 1/26/98 -path.rpart <- function(tree, nodes, pretty = 0, print.it = TRUE) +path.rpart <- function(tree, nodes, pretty = 0, print.it = TRUE, sql = FALSE) { if (!inherits(tree, "rpart")) stop("Not a legitimate \"rpart\" object") - splits <- labels.rpart(tree, pretty = pretty) + splits <- labels.rpart(tree, pretty = pretty, sql = sql) frame <- tree$frame n <- row.names(frame) node <- as.numeric(n)