Question

我的问题是关于具有高度可变日期范围的数据集。我想允许用户选择一个人/或事件，然后将dateRangeInput中的默认出现日期范围作为这些日期的最小值和最大值。我希望从这些日期范围创建的初始图形由数据集的该行内的值的最小值和最大值限制，这很容易。但是，我还需要用户能够随意更改这些内容以扩展范围或放大到更近的范围。出于示例的目的，我创建了一个显示我的难度的基本代码/数据示例。我寻找其他答案，但我的搜索证明不成功。我从r帮助文件和 http://shiny.rstudio.com/tutorial/lesson4/ 以及本网站上的其他许多问题，但都无济于事。

ui.R

shinyUI(fluidPage(
  titlePanel("Default Date Range"),

  sidebarLayout(
    sidebarPanel(
      helpText("Problem initiating a date range default based on selected input"),

  selectInput("var", 
              label = "Choose a variable to display",
              choices = c("White", "Red", "Blue"),
              selected = "White"),


  dateRangeInput('dateRange2',
                 label = paste('Date range selection'),
                 start = textOutput("text1"),
                 end = Sys.Date(), 
                 separator = " - ", 
                 weekstart = 1
  )
),

mainPanel(
  textOutput("text1"),
  textOutput("text2")
 ) #end of main panel
 )#end of SidebarLayout
))#end of fluid page and UI

对于server.r文件

server.R

my.data <- t(data.frame(White = c(as.Date("2010-01-01"), as.Date(Sys.Date())),
                  Red = c(as.Date("1943-01-01"), as.Date("1960-05-19")),
                  Blue = c(as.Date("1975-01-01"), as.Date("2010-03-09"))))


shinyServer(function(input, output){

output$text1 <- renderText({ 
  paste("You have selected", input$var)
})



output$text2 <- renderText({ 
  my.row = match(input$var, rownames(my.data))
 paste("You need the default date range",
       my.data[my.row,1], "to", my.data[my.row,2])
    })

})

Answer 1

这个怎么样。更改您的selectInput，您将看到日期范围将相应于颜色。

server.R
library(shiny)

my.data <- as.data.frame(t(data.frame(White = c(as.Date("2010-01-01"), as.Date(Sys.Date())),
                        Red = c(as.Date("1943-01-01"), as.Date("1960-05-19")),
                        Blue = c(as.Date("1975-01-01"), as.Date("2010-03-09")))))

my.data$V1 <- as.Date(my.data$V1)
my.data$V2 <- as.Date(my.data$V2)

shinyServer(function(input, output){


  output$inVar2 <- renderUI({

    my.row = match(input$var, rownames(my.data))

    dateRangeInput("inVar2", 
                   label = paste('Date range selection'),
                   start = my.data[my.row,1],
                   end = my.data[my.row,2], 
                   separator = " - ", 
                   weekstart = 1

                   )

  })


  output$text1 <- renderText({ 
    paste("You have selected", input$var)
  })



  output$text2 <- renderText({ 
    my.row = match(input$var, rownames(my.data))
    paste("You need the default date range",
          my.data[my.row,1], "to", my.data[my.row,2])
  })

})

和ui.R

ui.R
library(shiny)

shinyUI(fluidPage(
  titlePanel("Default Date Range"),

  sidebarLayout(
    sidebarPanel(
      helpText("Problem initiating a date range default based on selected input"),

      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("White", "Red", "Blue"),
                  selected = "White"),


      uiOutput("inVar2")

    ),

    mainPanel(
      textOutput("text1"),
      textOutput("text2")
    ) #end of main panel
  )#end of SidebarLayout
))#end of fluid page and UI

R闪亮反应默认日期范围

1 个答案: