在 R Shiny 中获取反应数据框的行名并创建日期范围滑块

Question

我有一个以时间序列为索引的数据框。数据框中的数据由仪表板操作（例如下载按钮）更新，因此数据框是反应式的。使用滑块，我希望能够仅选择数据框的某些行。因此，滑块的最小最大值是指反应数据帧的行名。到目前为止，我无法实现这一点。代码下方。 SERVER 部分中的if(0) 部分就是我正在谈论的部分。任何帮助表示赞赏。

require(shiny)

AquireData <- function(){
  # In this function the data are created
  df <- data.frame(replicate(3,sample(0:50,1000,rep=TRUE)))
  rownames(df)  <- seq(from = as.POSIXct("2012-05-15 07:00"), 
                       to = as.POSIXct("2019-05-17 18:00"), by = "min")[0:dim(df)[1]]
  names(df) <- c('A','B','C')
  return (df)
}


ui <- fluidPage(
  # App title
  titlePanel("my dashboard"),

  # define stuff for the sidebar (buttons, selectlists etc.). These items will
  # be displayed for all panels
  sidebarLayout(
    sidebarPanel(
      actionButton("Button_GetAndUpdate", "Update data"),
      sliderInput("start_end_dates", "Date range", min =0, max=0, value=1)
    ),

    # Main panel. Here you can display your graphs, plots and tables
    mainPanel("observed data", tableOutput("rawdata"))      

  )
)


server <- function(input, output,session) {
  # When the app is called an update of the data is drawn
  df_data <- reactive({AquireData()})

  # Check what the update button is doing. If its getting pressed pull and update
  observeEvent (input$Button_GetAndUpdate,{df_data <<- reactive({AquireData()})})  


  # set date range slider values using the dates from the data frame index
  if(0){
    updateSliderInput(session, "start_end_dates",
                      label = "Date range",
                      min = as.POSIXct(min(rownames(df_data())),"%Y-%m-%d %H:%M:%S",tz=""),
                      max = as.POSIXct(max(rownames(df_data())),"%Y-%m-%d %H:%M:%S",tz="")
    )
  }
  # get the head of the dataframe
  data_head <- reactive({
    input$Button_GetAndUpdate
    isolate({
      head(df_data())
    })
  })

  output$rawdata <- renderTable({
    data_head()
  })   
}

shinyApp(ui = ui, server = server)
runApp("Header_dashboard")

Answer 1

您可以分别使用shinyWidgets::sliderTextInput 和shinyWidgets::updateSliderTextInput 代替sliderInput为此：

shinyWidgets::updateSliderTextInput(
  session, "start_end_dates",
  choices = rownames(df_data())
)

这对您的应用意味着：

require(shiny)

AquireData <- function(){
  # In this function the data are created
  df <- data.frame(replicate(3,sample(0:50,1000,rep=TRUE)))
  rownames(df)  <- seq(from = as.POSIXct("2012-05-15 07:00"), 
                       to = as.POSIXct("2019-05-17 18:00"), by = "min")[0:dim(df)[1]]
  names(df) <- c('A','B','C')
  return (df)
}


ui <- fluidPage(
  # App title
  titlePanel("my dashboard"),

  # define stuff for the sidebar (buttons, selectlists etc.). These items will
  # be displayed for all panels
  sidebarLayout(
    sidebarPanel(
      actionButton("Button_GetAndUpdate", "Update data"),
      shinyWidgets::sliderTextInput(
        "start_end_dates", 
        label = "Time range",
        choices = c(as.POSIXct("2019-01-01 12:00:00"), as.POSIXct("2019-12-31 14:00:00")), 
      )
    ),

    # Main panel. Here you can display your graphs, plots and tables
    mainPanel("observed data", tableOutput("rawdata"))      

  )
)


server <- function(input, output,session) {
  # When the app is called an update of the data is drawn
  df_data <- reactive({AquireData()})

  # Check what the update button is doing. If its getting pressed pull and update
  observeEvent (input$Button_GetAndUpdate,{df_data <<- reactive({AquireData()})})  


  # set date range slider values using the dates from the data frame index
  observe({
    shinyWidgets::updateSliderTextInput(
      session, "start_end_dates",
      choices = rownames(df_data())
    )
  })
  # get the head of the dataframe
  data_head <- reactive({
    input$Button_GetAndUpdate
    isolate({
      head(df_data())
    })
  })

  output$rawdata <- renderTable({
    data_head()
  })   
}

shinyApp(ui = ui, server = server)