Как применить реактивно JS отфильтрованные строки для загрузки данных - PullRequest
0 голосов
/ 22 октября 2018

Моя проблема - отфильтровать удобную таблицу из базы данных.Мне удалось привести в порядок БД, и пользователь может фильтровать столбцы в интерактивном режиме (не в коде примера).Затем пользователь может выбрать столбцы, в которых можно выбрать категории для фильтрации.Тогда я застреваю, так как мне не удается применить выбранные категории к таблице.Загрузка не должна быть проблемой после этого, но я не дохожу до этого момента.Я использовал код в следующей ссылке R Shiny: вложенные функции наблюдения и искал последующие действия, но не смог получить ответ.Я пытался назвать переменные напрямую, но это не решение и тоже не работает.Буду очень признателен за любые рекомендации.

# The application is based on the blog:

# https://stackoverflow.com/questions/40732767/r-shiny-nested-observe-functions
# The code is reduced to the lines where the problem is but contains also some lines as solutions which
# do not work but could help in answering my question
library(shiny)
library(dplyr)
ui <- fluidPage(

  titlePanel("Select rows"),
  pageWithSidebar(
    headerPanel(""),
    sidebarPanel(),
    mainPanel( 
      tags$script("$(document).on('click', '.dynamicSI button', function () {
                                      var id = document.getElementById(this.id).getAttribute('data');
                                      var name = document.getElementById(this.id).getAttribute('name');
                                      Shiny.onInputChange('lastSelectId',id);
                                      Shiny.onInputChange('lastSelectName',name);
                                      // to report changes on the same selectInput
                                      Shiny.onInputChange('lastSelect', Math.random());
                                      });"),  
      actionButton("showtab", "show table"),

      uiOutput("FILTERS"),
      hr(),
      uiOutput("FILTER_GROUP"),
      hr(),
      verbatimTextOutput("L")
      ,
      tableOutput('tidyrows')

    )
  )
)
# increased size of upload
server <- function(input, output, session) {
  options(shiny.maxRequestSize=30*1024^2)




  # here I would provide a table which was already heavily filtered. But to make it clear I use "iris"

  dt3 <- reactive({ data <- iris
  data})

  # here the code from https://stackoverflow.com/questions/40732767/r-shiny-nested-observe-functions starts

  output$FILTERS = renderUI({
    selectInput("filters","Filters",choices = names(dt3()),multiple = TRUE)
  }) 

  observe({

    req(input$filters)
    filter_names = input$filters

    # count how many filters I selected
    n = length(filter_names)     

    # to render n selectInput    
    lapply(1:n,function(x){
      output[[paste0("FILTER_",x)]] = renderUI({
        req(input$filters)
        div( class = "dynamicSI",
             selectInput(paste0("filter_",x),
                         paste0(filter_names[x]),
                         choices = unique(dt3()[,filter_names[x]]),
                         multiple = TRUE,
                         selected = unique(dt3()[,filter_names[x]])
             ),
             actionButton(paste0("filter_all_",x),"(Un)Select All", 
                          data = paste0("filter_",x), # selectInput id
                          name = paste0(filter_names[x])) # name of column
        )
      })
    })

    output$FILTER_GROUP = renderUI({
      div(class="dynamicSI",
          lapply(1:n, function(i){
            uiOutput(paste0("FILTER_",i))
          })
      )

    })

  })

  observeEvent(input$lastSelect, {

    if (!is.null(input$lastSelectId)) {
      cat("lastSelectId:", input$lastSelectId, "\n")
      cat("lastSelectName:", input$lastSelectName, "\n")
    }  
    # selectInput id
    Filter = input$lastSelectId
    # column name of dataset, (label on select input)
    NAME = input$lastSelectName
    choices = unique(dt3()[,NAME])

    if (length(input[[Filter]]) == 0) {
      # in corresponding selectInput has no elements selected
      updateSelectInput(
        session = session, inputId = Filter, selected = as.character(choices)
      )
    } else {
      # has at least one element selected
      updateSelectInput(
        session = session, inputId = Filter, selected = ""
      )
    }

  })

  output$L = renderPrint({
    input$lastSelectId
  })


  # this is my last try with another dataset; I tried to name the variables directly but was not successful

  output$tidyrows <- renderTable({ # eventReactive(input$showtab, {
    data <- dt3()
    data2 <- eventReactive( input$showtab, {
      uni <- unique(as.character(data$Sepal.Length))
      updateSelectInput(session, "Sepal.Length","Sepal.Length", choices = uni)
      uni2 <- unique(as.character(data$Petal.Length)) 
      updateSelectInput(session, "Petal.Length","Petal.Length", choices = uni2)

      data <- data[which(data$Sepal.Length == input$Sepal.Length & 
                           data$Petal.Length == input$Petal.Length ), ]

      data      
    })
    test <- data2()

    data2() 
  })

}
# Run the application 
shinyApp(ui = ui, server = server)*
...