How do you use R shiny to construct the ctree nodes, given that the action button controls when the ctree is output?

I am trying to plot individual nodes from a regression tree generated by the ctree (batch batch) function. I have an action button and the code that generates the ctree only fires after that button is clicked. This part seems to work. After the tree is generated, but what should happen is a group of radioButtons that should appear with numbers corresponding to the terminal node numbers of the ctree just generated.

When the user selects a radioButton, the corresponding terminal node is applied to it.

I have a watch condition that controls a radioButton widget. It doesn't update after clicking the action button. Why?

Run the following server and ui code and you will see my problem (including sample data. The tree should look the same as in this post ). After pressing the action button, the story will appear. However, only one radio button remains. Observe ({}) does not update it.

NOTE. Be sure to use rm (list = ls ()) to clear the workspace before starting the application.

# 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 generated tree is identical outside the R brilliant and that you would expect the if statement in the Obs clause to be TRUE after assigning datSubset 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 so my sanity isn't that good ... Seems okay, so why isn't it working ?: S Any help is appreciated.

+3


source to share





All Articles