Skip to content

ctree

3 messages · Achim Zeileis, mia88

#
Hello,
I plotted a nice tree with "ctree" . It shows 3 nodes with the prediction of
my 2 groups. (see picture)
Unfortunately I need a larger scale to read the exact prediction of my
groups to get the specificity and sensitivity. I tried to change the scale
with "axis" but it didn't work, my guess because it's not a normal graph
with x and y axis. 
Has someone an idea how to change the scales in the nodes of my tree?
Thank you very much! Mia
<http://r.789695.n4.nabble.com/file/n4649478/nodes.png> 



--
View this message in context: http://r.789695.n4.nabble.com/ctree-tp4649478.html
Sent from the R help mailing list archive at Nabble.com.
#
On Wed, 14 Nov 2012, mia88 wrote:

            
I'm not exactly sure how you would like to improve the visualization. I 
could think of two options: (1) Use a y-axis labeling with only the 
predicted probability (rounded to some precision). (2) Add some label, 
e.g., at the bottom of the bars, with the predicted probability.

While both options are in principle possible, neither is available out of 
the box. It requires some programming using the "grid" package in which 
the party plots are created. However, if you start out from the 
node_barplot() function provided in the package, not a lot of programming 
is necessary. As an example, I have created a function node_barplot2() 
with a modified grid.yaxis() call to implement option (1) outlined above. 
See the code below. To try it out, please source the entire function 
_including_ the class() assignment at the end. And then you can do:

## package and tree for Pima Indians Diabetes data
library("party")
data("PimaIndiansDiabetes", package = "mlbench")
ct <- ctree(diabetes ~ ., data = PimaIndiansDiabetes)

## visualizations: default and alternative y-axis and more spaces
plot(ct)
plot(ct, terminal_panel = node_barplot2)
plot(ct, terminal_panel = node_barplot2,
   tp_args = list(ylines = c(2, 4)))

Hope that helps,
Z


node_barplot2 <- function(ctreeobj,
                          col = "black",
       		         fill = NULL,
 			 beside = NULL,
 		         ymax = NULL,
 		         ylines = NULL,
 		         widths = 1,
 		         gap = NULL,
 			 reverse = NULL,
 		         id = TRUE)
{
     getMaxPred <- function(x) {
       mp <- max(x$prediction)
       mpl <- ifelse(x$terminal, 0, getMaxPred(x$left))
       mpr <- ifelse(x$terminal, 0, getMaxPred(x$right))
       return(max(c(mp, mpl, mpr)))
     }

     y <- response(ctreeobj)[[1]]

     if(is.factor(y) || class(y) == "was_ordered") {
         ylevels <- levels(y)
 	if(is.null(beside)) beside <- if(length(ylevels) < 3) FALSE else TRUE
         if(is.null(ymax)) ymax <- if(beside) 1.1 else 1
 	if(is.null(gap)) gap <- if(beside) 0.1 else 0
     } else {
         if(is.null(beside)) beside <- FALSE
         if(is.null(ymax)) ymax <- getMaxPred(ctreeobj at tree) * 1.1
         ylevels <- seq(along = ctreeobj at tree$prediction)
         if(length(ylevels) < 2) ylevels <- ""
 	if(is.null(gap)) gap <- 1
     }
     if(is.null(reverse)) reverse <- !beside
     if(is.null(fill)) fill <- gray.colors(length(ylevels))
     if(is.null(ylines)) ylines <- if(beside) c(3, 4) else c(1.5, 2.5)

     ### panel function for barplots in nodes
     rval <- function(node) {

         ## parameter setup
         pred <- node$prediction
 	if(reverse) {
 	  pred <- rev(pred)
 	  ylevels <- rev(ylevels)
 	}
         np <- length(pred)
 	nc <- if(beside) np else 1

 	fill <- rep(fill, length.out = np)
         widths <- rep(widths, length.out = nc)
 	col <- rep(col, length.out = nc)
 	ylines <- rep(ylines, length.out = 2)

 	gap <- gap * sum(widths)
         yscale <- c(0, ymax)
         xscale <- c(0, sum(widths) + (nc+1)*gap)

         top_vp <- viewport(layout = grid.layout(nrow = 2, ncol = 3,
                            widths = unit(c(ylines[1], 1, ylines[2]), c("lines", "null", "lines")),
                            heights = unit(c(1, 1), c("lines", "null"))),
                            width = unit(1, "npc"),
                            height = unit(1, "npc") - unit(2, "lines"),
 			   name = paste("node_barplot", node$nodeID, sep = ""))

         pushViewport(top_vp)
         grid.rect(gp = gpar(fill = "white", col = 0))

         ## main title
         top <- viewport(layout.pos.col=2, layout.pos.row=1)
         pushViewport(top)
 	mainlab <- paste(ifelse(id, paste("Node", node$nodeID, "(n = "), "n = "),
 	                 sum(node$weights), ifelse(id, ")", ""), sep = "")
         grid.text(mainlab)
         popViewport()

         plot <- viewport(layout.pos.col=2, layout.pos.row=2,
                          xscale=xscale, yscale=yscale,
 			 name = paste("node_barplot", node$nodeID, "plot",
                          sep = ""))

         pushViewport(plot)

 	if(beside) {
   	  xcenter <- cumsum(widths+gap) - widths/2
 	  for (i in 1:np) {
             grid.rect(x = xcenter[i], y = 0, height = pred[i],
                       width = widths[i],
 	              just = c("center", "bottom"), default.units = "native",
 	              gp = gpar(col = col[i], fill = fill[i]))
 	  }
           if(length(xcenter) > 1) grid.xaxis(at = xcenter, label = FALSE)
 	  grid.text(ylevels, x = xcenter, y = unit(-1, "lines"),
                     just = c("center", "top"),
 	            default.units = "native", check.overlap = TRUE)
           grid.yaxis()
 	} else {
   	  ycenter <- cumsum(pred) - pred

 	  for (i in 1:np) {
             grid.rect(x = xscale[2]/2, y = ycenter[i], height = min(pred[i], ymax - ycenter[i]),
                       width = widths[1],
 	              just = c("center", "bottom"), default.units = "native",
 	              gp = gpar(col = col[i], fill = fill[i]))
 	  }
           if(np > 1) {
 	    grid.text(ylevels[1], x = unit(-1, "lines"), y = 0,
                       just = c("left", "center"), rot = 90,
 	              default.units = "native", check.overlap = TRUE)
 	    grid.text(ylevels[np], x = unit(-1, "lines"), y = ymax,
                       just = c("right", "center"), rot = 90,
 	              default.units = "native", check.overlap = TRUE)
 	  }
           if(np > 2) {
 	    grid.text(ylevels[-c(1,np)], x = unit(-1, "lines"), y = ycenter[-c(1,np)],
                       just = "center", rot = 90,
 	              default.units = "native", check.overlap = TRUE)
 	  }
           grid.yaxis(at = round(1 - pred[i], digits = 3), main = FALSE)
 	}

         grid.rect(gp = gpar(fill = "transparent"))
         upViewport(2)
     }

     return(rval)
}
class(node_barplot2) <- "grapcon_generator"
#
Hey thanks for your help. Im afraid its a little bit too complicated for me..
Before I do al lot of research in the next days to finally understand it I
would like to make sure that it does help me with my problem. 
Maybe I explain it once again : For example in the first node I can read
that group 2 is selected between 0.3 and 0.4 but I need the exact number so
that I can use it to get the sensitivity and specifity...



--
View this message in context: http://r.789695.n4.nabble.com/ctree-tp4649478p4649538.html
Sent from the R help mailing list archive at Nabble.com.