Как выбрать несколько входов на основе другого входа - PullRequest
0 голосов
/ 01 ноября 2019

Дело

У меня есть следующая проблема. У меня есть четыре случая, скажем, A, B, C и D. Основываясь на них, мне нравится фильтровать свой график и дальнейшие результаты. Пока все прямо.

Кроме того, существует два типа пользователей, например, group1 и group2. Group1 обычно (!) Хочет видеть только A и B и Group2 C и D. Однако иногда они хотят смешать это и просто видеть A, или A и C, и т. Д. ...

Поэтому мойцель состоит в том, чтобы можно было просто выбрать или group1 или group2, и A & B или C & D выбираются автоматически. Но также должно быть возможно выбрать group1 и group2 (выбирая A & B & C & D) или ни один, и выбрать группы вручную. Вот небольшой пример:

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

server <- shinyServer(function(session, input, output) { 

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))


  output$plot<- renderPlot({ 
    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

Примечание:

Я хочу видеть вторую строку флажков, помеченных как выбранные, и фильтровать их. Пользователь должен иметь возможность снять флажки, даже если выбрана его соответствующая группа. Коробки верхнего уровня должны быть просто удобными помощниками. Поскольку у меня есть только четыре группы, selectPicker () не является опцией (с точки зрения UX).

O у меня такое ощущение, что это должно быть уже каким-то образом реализовано, и я не хочу настраивать renderUI и подобные вещи. Любые подсказки приветствуются!

1 Ответ

1 голос
/ 01 ноября 2019

См. Ниже код, трюк находил updatePrettyCheckbox!

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

server <- shinyServer(function(session, input, output) { 

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))

  observeEvent(input$g1, {

    if(input$g1 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "a",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "b",
                         value = TRUE)

    }
  })
  observeEvent(input$g2, {

    if(input$g2 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "c",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "d",
                         value = TRUE)

    }
  })



  output$plot<- renderPlot({ 


    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

Я не включил снятие отметки Group1 или Group 2 отключит A & B / C & D, но вы просто добавите к кодучто-то вроде этого:

observeEvent(input$g1, {

if(input$g1 == TRUE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = TRUE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = TRUE)

}
if(input$g1 == FALSE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = FALSE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = FALSE)

}

})

Также проверьте исходный код, у вас неправильный inputId для группы 2

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...