R-Shiny两个具有部分依赖关系的selectInput变量

我是Shiny的新手，我搜索了两个相关的问题：

如何创建第二个R闪亮的下拉列表，其选项取决于第一个下拉列表选择
R-Shiny使用Reactive renderUI值

两个例子都涉及嵌套在另一个变量中的一个变量。选择A后，您将获得第二级选项1、2和3。选择B后，将有选项4、5和6。我的问题相似但不同。我试图创建两个基于两个变量（Y:A、B、C和X:D、E、F）的selectInput菜单，但它们是部分依赖的，没有层次结构。我用下表来说明：

xy A   B   C
D   v   v   
E   v   v   
F       v   v

所以我想要的是当我：

从第一个下拉菜单中选择A，第二个菜单中只显示D和E
从第一个下拉菜单中选择B，D、E和F显示在第二个菜单中
从第一个下拉菜单中选择C，第二个菜单中只显示F

反之亦然

从第二个下拉菜单中选择D，第一个菜单中只显示A和B
从第二个下拉菜单中选择E，第一个菜单中只显示A和B
从第二个下拉菜单中选择F，第一个菜单中只显示B和C

解决这一问题的最佳方法是什么？我创建了一个玩具示例来说明我想要实现的目标：

library(lattice)
library(shiny)
y=c("A","A","A","A","A","A","A","A","A","A",
    "B","B","B","B","B","B","B","B","B","B",
    "B","B","B","B","B","C","C","C","C","C")
x=c("D","D","D","D","D","E","E","E","E","E",
    "D","D","D","D","D","E","E","E","E","E",
    "F","F","F","F","F","F","F","F","F","F")
mean.y=c(10.75,10.97,10.62,10.15,10.58,10.41,10.22,10.59,10.05,10.24,
         10.84,10.54,10.38,10.06,10.70,10.14,10.80,10.99,10.43,10.59,
         10.66,10.55,10.93,10.71,10.90,10.28,10.62,10.76,10.63,10.86)   
mean.x=c(5.19,5.22,5.99,5.05,5.38,5.72,5.14,5.22,5.78,5.05,
         5.94,5.39,5.71,5.45,5.66,5.61,5.46,5.24,5.79,5.67,
         5.00,5.30,5.44,5.27,5.60,5.20,5.94,5.67,5.06,5.25)
dat=as.data.frame(cbind(y,x,mean.y,mean.x))
X=as.list(unique(as.character(dat$x)))
Y=as.list(unique(as.character(dat$y)))
ui=fluidPage(
  titlePanel("X vs. Y Scatter Plots"),
  uiOutput("x"),
  uiOutput("y"),
  plotOutput(outputId="scatter")
)
server=function(input,output){
  output$x=renderUI({
    selectInput("x","X",x)
  })
  output$y=renderUI({
    selectInput("y","Y",y)
  })
  output$scatter=renderPlot({
    dat=subset(dat,x==input$x & y==input$y)
    xyplot(dat$mean.y~dat$mean.x)
  })
}
shinyApp(ui=ui,server=server)

编辑：顺便说一句，我想从数据中检索这些级别，而不是在代码中调用级别，因为我会有几个文件，这些文件将以不同的依赖关系进行分析。

非常感谢大家的帮助！

我认为您需要isolate和updateSelectInput尝试

   library(shiny)
y=c("A","A","A","A","A","A","A","A","A","A",
    "B","B","B","B","B","B","B","B","B","B",
    "B","B","B","B","B","C","C","C","C","C")
x=c("D","D","D","D","D","E","E","E","E","E",
    "D","D","D","D","D","E","E","E","E","E",
    "F","F","F","F","F","F","F","F","F","F")
dd=data.frame(x,y,stringsAsFactors = F)
ui=fluidPage(
  titlePanel("X vs. Y Scatter Plots"),
  selectInput("x","X",c("",unique(dd$x))),
  selectInput("y","Y",c("",unique(dd$y)))
)
server=function(input,output,session){
  observeEvent(input$x,{
    if(input$x==""){
      updateSelectInput(session,"y",choices = c("",unique(dd$y))) 
    }else{
    updateSelectInput(session,"y",choices = unique(dd$y[dd$x==input$x]),selected = isolate(input$y))
    }
      })
  observeEvent(input$y,{
    if(input$y==""){
      updateSelectInput(session,"x",choices = c("",unique(dd$x))) 
    }else{
    updateSelectInput(session,"x",choices = unique(dd$x[dd$y==input$y]),selected = isolate(input$x))
    }
  } )
}
shinyApp(ui=ui,server=server)

更新

尝试添加""作为重置选项（任何时候""关闭）

ui=fluidPage(
  titlePanel("X vs. Y Scatter Plots"),
  selectInput("x","X",c("_",unique(dd$x))),
  selectInput("y","Y",c("_",unique(dd$y)))
)
server=function(input,output,session){
  observeEvent(input$x,{
    if(input$x=="_"){
      updateSelectInput(session,"y",choices = c("_",unique(dd$y))) 
    }else{
      updateSelectInput(session,"y",choices = c("_",unique(dd$y[dd$x==input$x])),selected = isolate(input$y))
    }
  })
  observeEvent(input$y,{
    if(input$y=="_"){
      updateSelectInput(session,"x",choices = c("_",unique(dd$x))) 
    }else{
      updateSelectInput(session,"x",choices = c("_",unique(dd$x[dd$y==input$y])),selected = isolate(input$x))
    }
  } )
}
shinyApp(ui=ui,server=server)

相关内容

最新更新

热门标签：