Question

我正在尝试使用直方图对闪亮的仪表板进行编程，该直方图允许您根据日期对输入数据进行子集化。

我有日期输入栏功能，但它只提供单个时间点的数据，而不是范围。有人能指出我在代码中出错了吗？

我将提供我的server.r和ui.r代码，以及可重现的数据。

SERVER.R

library(reshape)
library(shiny)
library(ggplot2)


# GEN DATA -----------------------------------------------

dates = c("2014-01-01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01-    01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01-01", "2014-02-01")
value = c  ("3.2", "4.1", "3.8", "5.6", "2.1", "2.0", "1.0" , "4.5", "1.6", "2.9")
dataset = cbind(dates, value)
dataframe = data.frame(dataset)
dataframe$dates <- as.Date(dataframe$dates, format = "20%y-%m-%d")
dataframe$value <- as.numeric(dataframe$value)

# SERVER -----------------------------------------------
shinyServer(function (input, output) {


  # DATA

  data.r = reactive({
    a = subset(dataframe, dates %in% input$daterange)
return(a)
  })



  # GGPLOT

  mycolorgenerator = colorRampPalette(c('sienna','light grey')) 

  output$myplot = renderPlot({

    dd<-data.r()
    # ggplot with proper reference to reactive function <<data.r()>>
    s = ggplot(data=subset(dataframe, dates %in% input$daterange ), aes   (x=value))  + geom_histogram(data=subset(dd, dates%in% input$daterange ) , aes(x=value))

print(s)
  })
})

ui.R

# INPUT PART

library(shiny)

shinyUI(pageWithSidebar(
  # Application title
  headerPanel("My App"),

  sidebarPanel( 

  dateRangeInput("daterange", "Date range:",
               start  = "2014-01-01",
               end    = "2014-03-31",
               min    = "2014-01-01",
               max    = "2014-03-31",
               format = "yyyy/mm/dd",
               separator = "-"),

    submitButton(text="Update!")
  ),
  # -----------------------------------------------

  # OUTPUT PART

   mainPanel(
   tabsetPanel(
   tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
    )
  )
))

Answer 1

您在这里进行字符串匹配而不是日期间隔检查。对于您必须工作的内容，daterange需要包含与您的数据完全相同的值，并返回UI控件未设置的两个以上日期。

我认为这样的事情对你有用。

# inside interval
start <- ymd("2014-01-01") 
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-01-05") %within% my.interval
[1] TRUE

# outside interval
start <- ymd("2014-01-01") 
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-03-21") %within% my.interval
[1] FALSE

您不必使用lubridate，您可以使用基本日期包来管理它，但这需要一些工作。

另一个解决方法是使用不同的控件，所有日期都是硬编码的，并在输入上启用多选。例如selectizeInput(...)。

Answer 2

修改您的代码，如下所示，您的子集不正确：

server <- shinyServer(function (input, output) {
  # DATA
  data.r = reactive({
    a = subset(dataframe, dates >= input$daterange[1] & 
                          dates <= input$daterange[2]) # add some validation code here 
                          # to validate that input$daterange[2] >= input$daterange[1]
    return(a)
  })
  # GGPLOT
  mycolorgenerator = colorRampPalette(c('sienna','light grey')) 
  output$myplot = renderPlot({
    dd<-data.r()
    # ggplot with proper reference to reactive function <<data.r()>>
    print(ggplot(dd, aes(x=value)) + geom_histogram())
  })
})

# INPUT PART
library(shiny)
ui <- shinyUI(pageWithSidebar(
  # Application title
  headerPanel("My App"),
  sidebarPanel( 
    dateRangeInput("daterange", "Date range:",
                   start  = "2014-01-01",
                   end    = "2014-03-31",
                   min    = "2014-01-01",
                   max    = "2014-03-31",
                   format = "yyyy/mm/dd",
                   separator = "-"),

    submitButton(text="Update!")
  ),
  # OUTPUT PART
  mainPanel(
    tabsetPanel(
      tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
    )
  )
))

shinyApp(ui = ui, server = server)

R闪亮代码 - ggplot直方图的反应滑块

2 个答案: