Множественный реактивный отбор в R Блестящий - PullRequest
Новая
       30

Множественный реактивный отбор в R Блестящий

0 голосов
/ 29 апреля 2018

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

l <- NULL
l$name <- c('b','e','d','b','b','d','e')
l$age <- c(20,20,21,21,20,22,22)
l <- as.data.frame(l)
l$name <- as.character(l$name)
l$age <- as.numeric(l$age)
library(shiny)

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

  data1 <- reactive({
    if(input$Box1 == "All"){
      l
    }else{
      l[which(l$name == input$Box1),]
    }
  })

  data2 <- reactive({
    if (input$Box2 == "All"){
      l
    }else{
      l[which(l$age == input$Box2),]
    }
  })

  observe({

    if(input$Box1 != "All"){
      updateSelectInput(session,"Box2","Choose an age", choices = c("All",unique(data1()$age)))
    }

    else if(input$Box2 != 'All'){
      updateSelectInput(session,"Box1","Choose a name", choices = c('All',unique(data2()$name)))
    }

    else if (input$Box1 == "All" & input$Box2 == "All"){
      updateSelectInput(session,"Box2","Choose an age", choices = c('All',unique(l$age)))
      updateSelectInput(session,"Box1","Choose a name", choices = c('All',unique(l$name)))
    }
  })


  data3 <- reactive({
    if(input$Box2 == "All"){
      data1()
    }else if (input$Box1 == "All"){
      data2()
    }else if (input$Box2 == "All" & input$Box1 == "All"){
      l
    }
    else{
      l[which(l$age== input$Box2 & l$name == input$Box1),]
    }
  })

  output$table1 <- renderTable({
    data3()
  })


})



ui <-shinyUI(fluidPage(
  selectInput("Box1","Choose a name", choices = c("All",unique(l$name))),
  selectInput("Box2","Choose an age", choices = c("All",unique(l$age))),
  tableOutput("table1")
))

shinyApp(ui,server)

Это прекрасно работает для 2 полей ввода, но я не знаю, как добавить еще.

У меня есть 4 выбранных входа, которые должны реагировать друг на друга (а также обновлять реактивный кадр данных).

Я новичок в R и Shiny.

1 Ответ

0 голосов
/ 01 мая 2018

Если вы просто пытаетесь получить заданные данные и / или значения фильтра, значит, вы слишком усердно работаете. Пакет DT заполняет входное значение индексами отфильтрованных строк и автоматически предоставляет фильтры, соответствующие классу. Обратите внимание, что мы используем subsetted_data() в другом рендере для создания большего количества элементов пользовательского интерфейса. 

library("shiny")
library("DT")

ldata <- data.frame(
  name = c('b','e','d','b','b','d','e'),
  age  = c(20,20,21,21,20,22,22)
)

#

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

  output$ldata_table <- renderDataTable({
    datatable(ldata, filter = "top")
  })

  subsetted_data <- reactive({
    # the input$<shiny-id>_rows_all populated by the DT package,
    # gets the indices of all the filtered rows
    req(length(input$ldata_table_rows_all) > 0)

    ldata[as.numeric(input$ldata_table_rows_all),]
  })

  output$state <- renderPrint({
    summary(subsetted_data())
  })
})

ui <- fluidPage(
  dataTableOutput("ldata_table"),
  verbatimTextOutput("state")
)

shinyApp(ui, server)

enter image description here

...