3

我正在尝试从由 ctree 函数(party 包)创建的回归树中绘制各个节点。我有一个操作按钮,生成 ctree 的代码仅在按下此按钮后运行。这部分似乎工作。在树生成之后,虽然需要发生的是一组单选按钮应该出现,其编号对应于刚刚生成的 ctree 的终端节点编号。

当用户选择一个单选按钮时,会绘制相应的终端节点。

我有一个监视 radioButton 小部件的观察子句。单击操作按钮后它不会更新。为什么?

运行以下服务器和 ui 代码,您将看到我的问题(包括示例数据。树状图应该与本文中的相同。按下操作按钮后,情节就会出现。但是,只剩下一个radioButton。Observe({}) 不会更新它。

注意:请务必在运行应用程序之前使用 rm(list=ls()) 清除工作区。

# 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"])
      }
    }
  })
})

这是 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) 
    ))
  )
)  
)

作为健全性检查,我编写了以下内容来检查生成的树是否在 R 闪亮之外是相同的,并且您希望在 datSubset 被分配为全局变量之后,observe 子句中的 if 语句具有 TRUE

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

因此我的理智不太好......看起来很正常,为什么它不起作用?:S 任何帮助表示赞赏。

4

0 回答 0