I'm trying to plot the individual nodes from a regression tree created by the ctree function (party package). I have an action button and the code that generates the ctree only runs after this button is pressed. This part seems to work. After the tree is generated though what needs to happen is a group of radioButtons should appear with numbers corresponding to the terminal node numbers of the ctree that was just generated.
When the user selects a radioButton, the corresponding terminal node is plotted.
I have an observe clause that monitors the radioButton widget. It does not get updated after clicking the action button. Why?
Run the following server and ui code and you'll see my problem (sample data included. Tree plot should look the same as the one at this post). After you press the action button the plot appears. However, there remains only one radioButton. Observe({}) doesn't update it.
NOTE: Be sure to use rm(list=ls()) to clear the workspace before running the app.
# server.R
#rm(list=ls())
CCS<-c(41, 45, 50, 50, 38, 42, 50, 43, 37, 22, 42, 48, 47, 48, 50, 47, 41, 50, 45, 45, 39, 45, 46, 48, 50, 47, 50, 21, 48, 50, 48, 48, 48, 46, 36, 38, 50, 39, 44, 44, 50, 49, 40, 48, 48, 45, 39, 40, 44, 39, 40, 44, 42, 39, 49, 50, 50, 48, 48, 47, 48, 47, 44, 41, 50, 47, 50, 41, 50, 44, 47, 50, 24, 40, 43, 37, 44, 32, 43, 42, 44, 38, 42, 45, 50, 47, 46, 43,
37, 47, 37, 45, 41, 50, 42, 32, 43, 48, 45, 45, 28, 44,38, 41, 45, 48, 48, 47 ,49, 16, 45, 50, 47, 50, 43, 49, 50)
X1.2Weeks<-c(NA,NA,NA,NA,NA,1,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,1,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,2,2,1,2,2,2)
X2.2Weeks<-c(NA,NA,NA,NA,NA,NA,2,2,2,NA,NA,2,2,2,2,2,2,NA,2,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2)
X3.2Weeks<-c(NA,35,40,NA,10,NA,31,NA,14,NA,NA,15,17,NA,NA,16,10,15,14,39,17,35,14,14,22,10,15,0,34,23,13,35,32,2,14,10,14,10,10,10,40,10,13,13,10,10,10,13,13,25,10,35,NA,13,NA,10,40,0,0,20,40,10,14,40,10,10,10,10,13,10,8,NA,NA,14,NA,10,28,10,10,15,15,16,10,10,35,16,NA,NA,NA,NA,30,19,14,30,10,10,8,10,21,10,10,35,15,34,10,39,NA,10,10,6,16,10,10,10,10,34,10)
X4.2Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,849,NA,NA,NA,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
x4.3Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,0,NA,NA,72,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
dat<-as.data.frame(cbind(CCS,X1.2Weeks,X2.2Weeks,X3.2Weeks,X4.2Weeks,x4.3Weeks))
library(shiny)
library(party)
shinyServer(function(input, output, clientData, session) {
observe({
if(exists("datSubset")&&!is.null(datSubset$node)){
updateRadioButtons(session,"nodesRadio",
h3("Choose Node to Display"),
choices = sort(unique(datSubset$node)),
selected = 1)
nodesRadioUpdated<<-TRUE
}
else{
nodesRadioUpdated<<-FALSE
}
})
# Construct URP-Ctree
output$plot <- renderPlot({
if(input$go==0){
return()
}
else {
isolate({
an<-"CCS"
# Only columns with "2Weeks" as part of their title are selected as predictors
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
node<-where(urp)
datSubset<<-cbind(anchor,node,dat)
plot(urp,height = 1000, width = 1000)
})
}
})
output$nodePlot <- renderPlot({
if(exists("datSubset")&&!is.null(datSubset$node)&&nodesRadioUpdated){
if(!is.numeric(datSubset[node==input$nodesRadio,][,"anchor"])){
barplot(table(datSubset[node==input$nodesRadio,][,"anchor"]))
}
else{
boxplot(datSubset[node==input$nodesRadio,][,"anchor"])
}
}
})
})
And here is ui.R
#rm(list=ls())
library(shiny)
library(party)
# Define the overall UI
shinyUI(fluidPage(
titlePanel("Unbiased Recursive Partitioning"),
fluidRow(
column(2, wellPanel(
actionButton("go", "Plot URP-Ctree")
)),
column(8, wellPanel(
# Create a new row for the URP plot.
plotOutput("plot",height = 1000, width = 1000),
# Create a starting point for the radioButtons. More radioButtons should be added after pressing the actionButton because then the ctree will be created and terminal nodes will be defined
radioButtons("nodesRadio", label = h3("Choose Node to Display"),
choices = 1,
selected = NULL),
plotOutput("nodePlot",height = 1000, width = 1000)
))
)
)
)
As a sanity check I wrote the following to check if the tree generated is identical outside of R shiny and that you'd expect the if statement in the observe clause to have TRUE after datSubset is assigned as a global variable
library(party)
load("NotWorking.RData")
an<-"CCS"
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
node<-where(urp)
datSubset<<-cbind(anchor,node,dat)
plot(urp)
# Generates the same tree
sort(unique(datSubset$node))
# Generates the correct set of nodes
exists("datSubset")&&!is.null(datSubset$node)
# TRUE
And thus my sanity isn't doing so well... Seems in order so why isn't it working? :S Any help is appreciated.
