Как установить значения блестящего виджета на основе значений другого блестящего виджета - PullRequest
0 голосов
/ 29 апреля 2020

У меня есть блестящее приложение, в котором пользователь загружает файл. Затем есть столбец с именем EventDate, который содержит даты. Эти даты передаются в диапазон дат ввода. Существует также второй виджет, который принимает в качестве входных данных уникальные значения 1-го столбца загруженного файла. Когда нажата кнопка действия, фрейм данных подразделяется на основе ввода средства выбора.

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

#dat<-subset(dat, EventDate>=input$dateRange[1]&EventDate<=input$dateRange[2])

но тогда все пусто. Это как «ничего не выбрано». Как я могу установить значения входных значений средства выбора на основе ввода диапазона дат?

library(shiny)
library(DT)
library(shinyWidgets)

ui <- pageWithSidebar(
  headerPanel('Iris k-means clustering'),
  sidebarPanel(
    fileInput("file1", "Choose CSV File",
              accept = c(
                "text/csv",
                "text/comma-separated-values,text/plain",
                ".csv")
    ),
    uiOutput("dr"),
    uiOutput("picker"),
    actionButton("go","Go")
  ),
  mainPanel(
    DTOutput("dtable")
  )
)

server <- function(input, output, session) {
  output$dr<-renderUI({

    inFile <- input$file1
    df<-data.frame(read.csv(inFile$datapath, header = TRUE))
    df$EventDate <-as.Date(df$EventDate, "%Y-%m-%d")

    dateRangeInput('dateRange',
                   label = 'Date range Input',
                   start = min(df$EventDate) ,end= max(df$EventDate) 
    )

  })
  filteredCSV <- reactiveVal(NULL)

  CSV <- eventReactive(input[["file1"]], {
    dat <- read.csv(input[["file1"]]$datapath, header = TRUE)
    dat<-data.frame(subset(dat, as.Date(EventDate)>=as.Date(input$dateRange[1], "%Y-%m-%d") & 
                         as.Date(EventDate)<=as.Date(input$dateRange[2], "%Y-%m-%d")))

    filteredCSV(dat)
    dat
  })


  output[["picker"]] <- renderUI({
    req(CSV())
    choices <- unique(as.character(CSV()[,1]))
    pickerInput("select", "Select ID", 
                choices = choices, 
                multiple = TRUE, options = list(`actions-box` = TRUE),
                selected = choices)
  })

  observeEvent(input[["go"]], {
    req(CSV())
    filteredCSV(CSV()[CSV()[,1] %in% input[["select"]],])
  })

  output[["dtable"]] <- renderDT({
    req(filteredCSV())
    datatable(
      filteredCSV(), 
      options = list(scrollX = TRUE, pageLength = 5)      
    )
  })

}

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