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

Question

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

How to create a second R shiny dropdown list whose options depend on a first dropdown list selection
R-Shiny using Reactive renderUI value

这两个示例都涉及一个变量嵌套在另一个变量中。选择 A 时，您有第二级选项 1、2 和 3。选择 B 时，您有选项 4、5 和 6。我的问题类似但又不同。我正在尝试基于两个变量（Y：A、B、C 和 X：D、E、F）创建两个 selectInput 菜单，但它们部分依赖，没有层次结构。我用下面的table来说明：

x\y 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)

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

非常感谢大家的帮助！

Answer 1

我认为你需要 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)

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

R-Shiny two selectInput variables with partial dependency

r

rstudio

shiny