Question

您好我有一个简单的闪亮应用程序，其中包含一个折线图。首先，用户选择复选框组的BOTH CHOICES，然后dateRangeInput()加载相对日期，然后我希望能够创建一个在x轴上具有此日期范围的折线图。我不确定将日期范围作为我的情节输入的正确方法。

OriginId = c("INT", "DOM", "INT","DOM","INT","DOM") 
RequestedDtTm = c("2017-01-16 16:43:33
", "2017-01-17 16:43:33
", "2017-01-18 16:43:33
","2017-01-19 16:43:33",
                  "2017-01-18 16:43:33
","2017-01-19 16:43:33"                  )
ClientZIP=c(20000,24455,56000,45000,80000,45000)
testdata = data.frame(OriginId,RequestedDtTm,ClientZIP)  

## ui.R ##
library(shinydashboard)
library(plotly)

dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody()
)

library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),

  ## Sidebar content
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Change View", tabName = "widgets", icon = icon("th"))
    )
  ),

  ## Body content
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",

              fluidRow(

                box(plotlyOutput("plot3",height = 250))

              )
      ),

      # Second tab content
      tabItem(tabName = "widgets",

              fluidRow(
                box(title="Line Graph",width = 12,
                    column(4,

                           checkboxGroupInput("checkGroup4", label = h3("Checkbox group"), 
                                              choices = list("Show Domestic" = "DOM", "Show International" = "INT"),
                                              selected = "DOM")
                    ),
                    column(4,
                           uiOutput("dt3")

                    ),
                    column(4,
                           uiOutput("n3")

                    )
                ))
      )

    )
  )
)
server <- function(input, output) {



  output$plot3 <- renderPlotly({

    data<-subset(testdata[,c(2,3)],testdata$OriginId %in% input$checkGroup4)
    p <- plot_ly(data, x = format(as.Date(input$dateRange3), "%Y-%m"), y = ~ClientZIP, type = 'scatter', mode = 'lines')
  })

  output$dt3<-renderUI({
  dateRangeInput('dateRange3',
                 label = 'Date range',
                 start = min(subset(as.POSIXct(testdata$RequestedDtTm),testdata$OriginId %in% input$checkGroup4)), end = max(subset(as.POSIXct(testdata$RequestedDtTm),testdata$OriginId %in% input$checkGroup4))
  )
  })


    }

Answer 1

这是一个工作示例。使用dateRangeInput()时，您需要同时提取min（input$dateRange3[1]）和max（input$dateRange3[2]）值。希望它有所帮助。

OriginId = c("INT", "DOM", "INT","DOM","INT","DOM") 
RequestedDtTm = c("2017-01-16", "2017-01-17", "2017-01-18","2017-01-19", "2017-01-18","2017-01-19")
ClientZIP=c(20000,24455,56000,45000,80000,45000)
testdata = data.frame(OriginId,RequestedDtTm,ClientZIP)  

dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody()
)

library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),

  ## Sidebar content
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Change View", tabName = "widgets", icon = icon("th"))
    )
  ),

  ## Body content
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",

              fluidRow(

                box(plotlyOutput("plot3"))

              )
      ),

      # Second tab content
      tabItem(tabName = "widgets",

              fluidRow(
                box(title="Line Graph",width = 12,
                    column(4,

                           checkboxGroupInput("checkGroup4", label = h3("Checkbox group"), 
                                              choices = list("Show Domestic" = "DOM", "Show International" = "INT"),
                                              selected = "DOM")
                    ),
                    column(4,
                           uiOutput("dt3")

                    ),
                    column(4,
                           uiOutput("n3")

                    )
                ))
      )

    )
  )
)
server <- function(input, output) {



  output$plot3 <- renderPlotly({

    data <- dplyr::tbl_df(subset(testdata[,c(2,3)],testdata$OriginId %in% input$checkGroup4))

    date_start <- as.character(input$dateRange3[1])
    date_end <- as.character(input$dateRange3[2])

    data$RequestedDtTm <- as.Date(data$RequestedDtTm, format = "%Y-%m-%d")
   # data <- data %>% filter(RequestedDtTm >= date_start & RequestedDtTm <= date_end)
    data <- data[as.Date(data$RequestedDtTm) >= date_start & as.Date(data$RequestedDtTm) <= date_end, ]

    p <- plot_ly(data, x = ~RequestedDtTm, y = ~ClientZIP, type = 'scatter', mode = 'lines')
  })

  output$dt3<-renderUI({
    dateRangeInput('dateRange3',
                   label = 'Date range',
                   start = min(subset(as.POSIXct(testdata$RequestedDtTm),testdata$OriginId %in% input$checkGroup4)), end = max(subset(as.POSIXct(testdata$RequestedDtTm),testdata$OriginId %in% input$checkGroup4))
    )
  })


}


shinyApp(ui, server)

根据闪亮的dateRangeInput（）设置折线图的x轴

1 个答案: