Фильтрация данных по условию ввода данных пользователем в приложении Shiny - PullRequest
0 голосов
/ 26 июня 2019

Я пишу модуль Shiny для фильтрации моих данных в зависимости от ввода пользователя.В основном, если пользователь выбирает страну и регион, программа выберет набор данных, соответствующий этой стране, и отфильтрует конкретный регион.После фильтрации определенного региона он фильтрует пол.


# ui part
target_pop_UI <- function(id){
  ns <- NS(id)
  tagList( 
    selectInput(inputId = ns("input1"), label = "Country", choices = c("ITA", "BFA", "ZMB")),
    selectInput(inputId = ns("input2"), label = "Region", choices = NULL),
    selectInput(inputId = ns("input3"), label = "Sex", choices = NULL)
   )
}

# server part

target_pop <- function(input, output, session){
  observeEvent(input$input1,{
    updateSelectInput(session = session, inputId = "input2", label = "Region", choices = c(get(input$input1)%>%
                        distinct(REGION), "All")
  })

  observeEvent(input$input2,{
    updateSelectInput(session = session, inputId = "input3", label = "Sex", choices = c(get(input$input1)%>%
                        filter(if(input$input2 != "All") {REGION == input$input2})%>%
                        distinct(SEX_LABELS)
)}
}

Это работает, если пользователь выбирает определенный регион.Но если он выберет «Все», я не хочу фильтровать набор данных.

Я пробовал разные варианты (во втором наблюдении за событием), но он не работает:

filter(if(input$input2 != "All") {REGION == input$input2})

#or

filter(if(input$input2 != "All") {REGION == input$input2} else{})

#or

filter(if(input$input2 != "All") {REGION == input$input2} else{NULL})


Отображаемая ошибка:

Error in : Argument 2 filter condition does not evaluate to a logical vector

Подводя итог, я хочу отфильтровать, если Region! = "All", тогда FILTER else НЕ НИЧЕГО.

Спасибо, если кто-то может мне помочь.

1 Ответ

0 голосов
/ 26 июня 2019

Я наконец нашел решение с назначением реактивного условия и затем оценил его в операторе фильтрации.Вот мой код:

target_pop_UI <- function(id){
  ns <- NS(id)
  tagList( 
    selectInput(inputId = ns("input1"), label = "Country", choices = c("ITA", "BFA", "ZMB")),
    selectInput(inputId = ns("input2"), label = "Region", choices = NULL),
    selectInput(inputId = ns("input3"), label = "Sex", choices = NULL)
  )
}

target_pop <- function(input, output, session){

  #update of region propositions depending on chosen country
  observeEvent(input$input1,{
    updateSelectInput(session = session, inputId = "input2", label = "Region", choices = c(get(input$input1)%>%
                        distinct(REGION), "All"))

  })


  cond1 <- reactive({if (input$input2 != "All") quote(REGION == input$input2) else TRUE})

  #Update of "sex propositions" depending on chosen region and country
  observeEvent(input$input2,{

    updateSelectInput(session = session, inputId = "input3", label = "Sex", choices = 
                        c(get(input$input1)%>%
                          filter(!!cond1())%>%
                          left_join(sex_labels)%>%
                          distinct(SEX_LABELS)%>%
                          rename(Sex = SEX_LABELS), "All"))
  })

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