R语言 选择一个闪亮的小部件禁用其他3闪亮的小部件

svmlkihl  于 5个月前  发布在  其他
关注(0)|答案(1)|浏览(75)

我有下面的shiny应用程序与4输入.他们包含的mtcars数据集的所有变量.现在,我想如果一个值选择,例如在一个输入(例如mpg在第一)这个值不能选择在任何其他输入.所以每次这4输入将有一个不同的值选择.

library(shiny)
library(shinydashboard)

choices <- c("Pop", "RC", "RT","R4")

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("Pr", "Select the price for analysis", choices = choices, multiple = F, selected = choices[1]),
    selectInput("Pr2", "Select the price for analysis", choices = choices, multiple = F, selected = choices[2]),
    selectInput("Pr3", "Select the price for analysis", choices = choices, multiple = F, selected = choices[3]),
    selectInput("Pr4", "Select the price for analysis", choices = choices, multiple = F, selected = choices[4])
    
  ),
  dashboardBody()
)

server <- function(input, output, session) {
  observeEvent(input$Pr, {
    updateSelectInput(session, "Pr2", choices = choices[!choices %in% input$Pr])
  })
  observeEvent(input$Pr3, {
    updateSelectInput(session, "Pr2", choices = choices[!choices %in%input$Pr3])
  })
  observeEvent(input$Pr4, {
    updateSelectInput(session, "Pr2", choices = choices[!choices %in%input$Pr4])
  })
  observeEvent(input$Pr2, {
    updateSelectInput(session, "Pr", choices = choices[!choices %in% input$Pr2])
  })
  observeEvent(input$Pr3, {
    updateSelectInput(session, "Pr", choices = choices[!choices %in% input$Pr3])
  })
  observeEvent(input$Pr4, {
    updateSelectInput(session, "Pr", choices = choices[!choices %in% input$Pr4])
  })
  observeEvent(input$Pr, {
    updateSelectInput(session, "Pr3", choices = choices[!choices %in% input$Pr])
  })
  observeEvent(input$Pr2, {
    updateSelectInput(session, "Pr3", choices = choices[!choices %in% input$Pr2])
  })
  observeEvent(input$Pr4, {
    updateSelectInput(session, "Pr3", choices = choices[!choices %in% input$Pr4])
  })
  observeEvent(input$Pr, {
    updateSelectInput(session, "Pr4", choices = choices[!choices %in% input$Pr])
  })
  observeEvent(input$Pr2, {
    updateSelectInput(session, "Pr4", choices = choices[!choices %in% input$Pr2])
  })
  observeEvent(input$Pr3, {
    updateSelectInput(session, "Pr4", choices = choices[!choices %in% input$Pr3])
  })
}

shinyApp(ui, server)

字符串

bqujaahr

bqujaahr1#

试试这个

library(shiny)
library(shinydashboard)

choices <- names(mtcars) # c("Pop", "RC", "RT","R4")

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    selectInput("Pr", "Select the price for analysis", choices = choices, multiple = F, selected = choices[1]),
    selectInput("Pr2", "Select the price for analysis", choices = choices, multiple = F, selected = choices[2]),
    selectInput("Pr3", "Select the price for analysis", choices = choices, multiple = F, selected = choices[3]),
    selectInput("Pr4", "Select the price for analysis", choices = choices, multiple = F, selected = choices[4])
    
  ),
  dashboardBody()
)

server <- function(input, output, session) {
  observeEvent(input$Pr, {
    choices1 <- choices[!choices %in% input$Pr]
    if (c(input$Pr) %in% input$Pr2) updateSelectInput(session, "Pr2", selected = choices1[1])
    choices2 <- choices[!choices %in% c(input$Pr,input$Pr2)]
    if (sum(c(input$Pr,input$Pr2) %in% input$Pr3)>0) updateSelectInput(session, "Pr3", selected = choices2[1])
    choices3 <- choices[!choices %in% c(input$Pr,input$Pr2,input$Pr3)]
    if (sum(c(input$Pr,input$Pr2,input$Pr3) %in% input$Pr4)>0) updateSelectInput(session, "Pr4", selected = choices3[1])
  })
  
  observeEvent(input$Pr2, {
    choices1 <- choices[!choices %in% input$Pr2]
    if (c(input$Pr) %in% input$Pr2) updateSelectInput(session, "Pr", selected = choices1[1])
    choices2 <- choices[!choices %in% c(input$Pr,input$Pr2)]
    if (sum(c(input$Pr,input$Pr2) %in% input$Pr3)>0) updateSelectInput(session, "Pr3", selected = choices2[1])
    choices3 <- choices[!choices %in% c(input$Pr,input$Pr2,input$Pr3)]
    if (sum(c(input$Pr,input$Pr2,input$Pr3) %in% input$Pr4)>0) updateSelectInput(session, "Pr4", selected = choices3[1])
  })
  
  observeEvent(input$Pr3, {
    choices1 <- choices[!choices %in% input$Pr3]
    if (c(input$Pr3) %in% input$Pr2) updateSelectInput(session, "Pr2", selected = choices1[1])
    choices2 <- choices[!choices %in% c(input$Pr3,input$Pr2)]
    if (sum(c(input$Pr3,input$Pr2) %in% input$Pr)>0) updateSelectInput(session, "Pr", selected = choices2[1])
    choices3 <- choices[!choices %in% c(input$Pr,input$Pr2,input$Pr3)]
    if (sum(c(input$Pr,input$Pr2,input$Pr3) %in% input$Pr4)>0) updateSelectInput(session, "Pr4", selected = choices3[1])
  })
  
  observeEvent(input$Pr4, {
    choices1 <- choices[!choices %in% input$Pr4]
    if (c(input$Pr4) %in% input$Pr2) updateSelectInput(session, "Pr2", selected = choices1[1])
    choices2 <- choices[!choices %in% c(input$Pr4,input$Pr2)]
    if (sum(c(input$Pr4,input$Pr2) %in% input$Pr3)>0) updateSelectInput(session, "Pr3", selected = choices2[1])
    choices3 <- choices[!choices %in% c(input$Pr4,input$Pr2,input$Pr3)]
    if (sum(c(input$Pr4,input$Pr2,input$Pr3) %in% input$Pr)>0) updateSelectInput(session, "Pr", selected = choices3[1])
  })

}

shinyApp(ui, server)

字符串

相关问题