Есть ли способ выбрать или вернуть выбранную переменную из раскрывающегося списка в selected через selectInput? - PullRequest
1 голос
/ 29 мая 2020

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

Здесь я могу добавить файл и показать переменные данных в раскрывающемся списке на вкладке «Фильтр», однако я не могу поймать текущую выбранную переменную на сервере, чтобы применить фильтр.

Ниже приведен код

server.R

library(shiny)
library(shinyBS)
library(shinyjs)
server <- function(input, output, session) {

  myValue <- reactiveValues()

  # Import Data File 
  observeEvent(input$data_import,{
    if(is.null(input$datafile))
      myValue$data<-NULL
    inFile<-input$datafile
    myValue$data <- rio::import(inFile$datapath) 
   })

  # Render Input DataTable 
    output$show_data <- DT::renderDataTable(
     myValue$data, server = FALSE, escape = FALSE, selection = 'none'
   )

    #Functions 

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  SingleshinyInput <- function(FUN, i, id, ...) {
    inputs <- character(i)
        inputs <- as.character(FUN(paste0(id, i), ...))
        inputs
  }


  #Display Dynamic Input Filter table
  observe({
  if(is.null(myValue$data))
    return()

    Names <- colnames(myValue$data)
    myValue$Filter  = data.frame(
                                  Logic = c(NA,shinyInput(selectInput, 4, 'logic_', label = "", choices = c("And","Or"))),
                                  Variable = shinyInput(selectInput, 5, 'var_', label = "", choices = Names ),
                                  Filter = shinyInput(actionButton, 5, 'go_button_', label = "Filter", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
                                  Remove = shinyInput(actionButton, 5, 'remove_button_', "", icon = icon("close"), onclick = 'Shiny.onInputChange(\"select_remove_button\",  this.id)' ),

                                  stringsAsFactors = FALSE,
                                  row.names = 1:5
                                  )


      }
      )

  #Add new Filter Row 

  observeEvent(input$addnewRow,{
        if(is.null(myValue$Filter))
          return()
          i <- as.character(max(as.numeric(row.names(myValue$Filter)))+1)      
          newRow <- data.frame(Logic = SingleshinyInput(selectInput, i, 'logic_', label = "", choices = c("And","Or")),
                             Variable = SingleshinyInput(selectInput, i, 'var_', label = "", choices = Names ),
                             Filter = SingleshinyInput(actionButton, i, 'go_button_', label = "Filter", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),
                             Remove = SingleshinyInput(actionButton, i, 'remove_button_', "", icon = icon("close"), onclick = 'Shiny.onInputChange(\"select_remove_button\",  this.id)' ),

                             stringsAsFactors = FALSE,
                             row.names = i)
        myValue$Filter <- rbind(myValue$Filter,newRow)

      })

  # Render Filter Data Table
   output$data <- DT::renderDataTable(
    myValue$Filter, server = FALSE, escape = FALSE, selection = 'none'
   )


  # Remove filter Row  
  observeEvent(input$select_remove_button,{
    if(is.null(myValue$Filter))
      return()
    rowToRemove<-unlist(strsplit(input$select_remove_button,"_"))
    rowToRemove<-rowToRemove[length(rowToRemove)]
    rowToRemove<-which(row.names(myValue$Filter)==rowToRemove)
    myValue$Filter<-myValue$Filter[-rowToRemove,]
    if(!is.na(myValue$Filter$Logic[1]))
      myValue$Filter$Logic[1]<-NA
  })

  # Display bsModal for filter 
  observeEvent(input$select_button, {
    toggleModal(session,"CustomDataFilter",toggle="open")


  })


  # Select the variable value selected in the select Input 
  output$FilterDataSettings <- renderUI({
    selected<-unlist(strsplit(input$select_button,"_"))
    selected<-as.numeric(selected[length(selected)])

    Names <- colnames(myValue$data)

    selected_var<-Names[selected]
    print(selected_var)
    selected<-as.numeric(selected)

    print(input[[paste0("var_",selected)]])




    return(NULL)


  })

  output$result <- renderText({
    selected<-unlist(strsplit(input$select_button,"_"))
    selected<-as.numeric(selected[length(selected)])
    paste("You chose", input[[paste0("var_",selected)]])
    print(input[[paste0("var_",selected)]])
  })



  # Show Table Dimensions 
  output$showDataDimensions.FilterData <- renderUI({
    if(is.null(myValue$data)){

      return(paste("The data is not selected "))
    }
      Dim<-dim(myValue$data)
      paste("Dimensions", Dim[1], "X" , Dim[2])

  })
}

ui.r

shinyUI(fluidPage(



    tags$button(
    id = "reset_button",
    class="btn action-button",
    icon("close")
  ),


  bsModal("CustomDataFilter","Settings","go_CustomDataFilter_Settings",size="small",

       # radioButtons("Less_Than_Greater_Than","Less Than or Greater Than",choices=c("Less Than","Greater Than"),selected="Less Than",inline = TRUE),
        uiOutput("FilterDataSettings"),
        textOutput("result")


  ),



  tabsetPanel(
    tabPanel("Data", 
             titlePanel("Custom Data Filter"),

             sidebarLayout(
               sidebarPanel(
                 fileInput('datafile', h4('Import File'),
                           accept=c('text/csv', 'text/comma-separated-values,text/plain')),
                 actionButton("data_import","Import") 

               ),


               mainPanel(

                 DT::dataTableOutput("show_data")

               )

             )

    ), 
    tabPanel("Filter", 
             sidebarLayout(
               sidebarPanel(
                 uiOutput("showDataDimensions.FilterData")

               ),


               mainPanel(


                 DT::dataTableOutput("data"), 
                 actionButton("addnewRow"," Add New Filter "),
                 actionButton("applyFilter"," Apply Filter to Data ")

               )
             )
    )
  )
)
)

Спасибо за просмотр кода и благодарность за ответ.

...