R閃亮代碼 - ggplot直方圖的反應滑塊

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)