绘制多个时间序列的x值而不是完整值-使用ggplotly的Shinydashboard

问题描述 投票：0回答：2

我的发光应用程序已经完成了99％，但是我一生都无法弄清楚为什么当我从“区域”输入选择器向第一张图表中的图表添加多个系列时，x值是change /跳过。

[当我只有一个系列（默认值=澳大利亚）时，将绘制所有月份的图。当我添加其他区域（例如，维多利亚州）时，将为每个系列绘制第二个月（交替显示），而当我添加第三个区域时，将每三个月绘制一次（再次交替绘制）。最终，这导致看不到每条线的最大值/最小值和月度值。

能够添加到绘图中的区域集在原始数据集中都具有相同的日期值（即，1978年2月至2020年4月的月度值。

检索数据

## app.R ##
library(dplyr)
library(raustats)
library(ggplot2)
library(lubridate)
library(shiny)
library(shinydashboard)
library(plotly)


#retrieve labour force dataset from ABS via abs.stat API
labour_force <- abs_stats(dataset = "LF", filter = list(ITEM=c(10,14,15,16), AGE=1599, TSEST=c(20, 30)))
lf <- select(labour_force, -c(frequency, obs_status, unknown, agency_id,agency_name, dataset_name))


#change datatype of 'time' to date format 
lf$time <- paste("01", lf$time, sep = "-")
lf$time <- strptime(lf$time, format = "%d-%b-%Y")
lf$time <- as.Date(lf$time, format = "%d-%b-%Y")
str(lf)

UI

#UI
ui <- dashboardPage(
  dashboardHeader(title = "this is a title"),
  ## Sidebar content
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("menu item", tabName = "menuItem1", icon = icon("th")),
      menuItem("ABS website", icon = icon("th"), href = "https://abs.gov.au"),
      menuSubItem("submenu")
    )
  ),

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

        # Boxes need to be put in a row or a column
       fluidRow(

          box(
            title = "Labour Force Data Description",
            status = "warning",
            solidHeader = TRUE,
            width = 9,
            height = 250
            )
          ),

        fluidRow(
          box(
            title = "Labour Force Data",
            status = "success",
            solidHeader = TRUE,
            dateRangeInput(
              inputId = "dateRange",
              label = "Select the date range:",
              start = min(lf$time),
              end = max(lf$time),
              min = min(lf$time),
              max = max(lf$time),
              format = "d M yyyy",
              startview = "year",
              separator = "to",
              autoclose = TRUE,
            ),
            actionButton("resetDate", label = "Reset date range"),

            selectizeInput(
              inputId = "dataItem",
              label = "Select data series:",
              choices = unique(lf$data_item),
              selected = "Unemployment rate (%)",
              multiple = FALSE
            ),

            selectizeInput(
              inputId = "regionID",
              label = "Select a region:",
              choices = unique(lf$region),
              selected = "Australia",
              multiple = TRUE
            ),

            selectizeInput(
              inputId = "adjustment",
              label = "Select estimate type:",
              choices = unique(lf$adjustment_type),
              selected = "Seasonally Adjusted",
              multiple = FALSE
            ),
            downloadButton(outputId = "downloadLF1", label = "Download"),
            width = 2
          ),

          box(
            title = 'Plot 1',
            status = "success",
            solidHeader = TRUE,
            plotlyOutput("LFplot1", height = 500),
            width = 10,
            )
          ),


        fluidRow(
          box(
            title = "Labour Force Data",
            status = "warning",
            solidHeader = TRUE,
            dateRangeInput(
              inputId = "dateRangeGender",
              label = "Select the date range:",
              start = min(lf$time),
              end = max(lf$time),
              min = min(lf$time),
              max = max(lf$time),
              format = "d M yyyy",
              startview = "year",
              separator = "to",
              autoclose = TRUE,
            ),
            actionButton("resetDateGender", label = "Reset date range"),

            selectizeInput(
              inputId = "dataItemGender",
              label = "Select data series:",
              choices = unique(lf$data_item),
              selected = "Unemployment rate (%)",
              multiple = FALSE
            ),

            selectizeInput(
              inputId = "adjustmentGender",
              label = "Select estimate type:",
              choices = unique(lf$adjustment_type),
              selected = "Seasonally Adjusted",
              multiple = FALSE
            ),
            downloadButton(outputId = "downloadLF2", label = "Download"),
            width = 2
          ),

          box(
            title = 'plot 2',
            status = "warning",
            solidHeader = TRUE,
            plotlyOutput("LFplot2", height = 500),
            width = 10
            )          
          ),
        ),

      # Second tab content
      tabItem(tabName = "menuItem1",
              h2("welcome to menu item 1")
        ),

      # third tab content
      tabItem(tabName = "SUBSUB",
              h2("Widgets tab content 111222")
        )
    )
  )
)

SERVER

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

  selector1 <- reactive({
    print(input$dateRange)
    lf %>% 
      dplyr::filter(time >= input$dateRange[1], time <= input$dateRange[2], 
                    adjustment_type == input$adjustment, data_item == input$dataItem, region == input$regionID)
  })



  selector2 <- reactive({
    print(input$dateRangeGender)
    lf %>% 
      dplyr::filter(time >= input$dateRangeGender[1], time <= input$dateRangeGender[2],
                    adjustment_type == input$adjustmentGender, data_item == input$dataItemGender)
  })


  observeEvent(input$resetDate, {
    updateDateRangeInput(session, "dateRange", 
                         start = min(lf$time),
                         end = max(lf$time),
                         min = min(lf$time),
                         max = max(lf$time)
                         )
  })

  observeEvent(input$resetDateGender, {
    updateDateRangeInput(session, "dateRangeGender", 
                         start = min(lf$time),
                         end = max(lf$time),
                         min = min(lf$time),
                         max = max(lf$time)
    )
  })


  output$downloadLF1 <- downloadHandler(
    filename = function() {
      paste(input$dataItem, ".csv", sep = "")
    },
    content = function(file) {
      write.csv(selector1(), file, row.names = FALSE)
    }
  )


  output$downloadLF2 <- downloadHandler(
    filename = function() {
      paste(input$dataItemGender, ".csv", sep = "")
    },
    content = function(file) {
      write.csv(selector2(), file, row.names = FALSE)
    }
  )

  output$LFplot1 <- renderPlotly({
    print(nrow(selector1()))
    req(nrow(selector1()) > 0)
    LFplt_1 <- selector1() %>%
      dplyr::filter(sex == "Persons") %>%
      ggplot() +
      geom_line(mapping = aes(x= time, y= values,colour= region))
    ggplotly(LFplt_1)
  })



  output$LFplot2 <- renderPlotly({
    print(nrow(selector2()))
    req(nrow(selector2()) > 0)
    LFplt_2 <- selector2() %>%
      dplyr::filter(region == "Australia") %>%
      ggplot() +
      geom_line(mapping = aes(x= time, y= values, colour= sex))
    ggplotly(LFplt_2)
  })


}

shinyApp(ui, server)
r ggplot2 shinydashboard shiny-reactivity ggplotly
2个回答
0
投票

您的Shinydashboard应用程序有很多活动部件，因此很难诊断出来。我没有时间详细了解所有细节，但是这里有一些初步的想法：

  1. 我认为您正在尝试在选择器内做太多事情。例如。在selector1内部，您尝试同时选择日期范围，adjustment_type，data_item和区域。
  selector1 <- reactive({
    print(input$dateRange)
    lf %>% 
      dplyr::filter(time >= input$dateRange[1], time <= input$dateRange[2], 
                    adjustment_type == input$adjustment, 
                    data_item == input$dataItem, 
                    region == input$regionID)
  })

您最好将其分解为多个部分-调整类型，数据项和区域的每个选择器都不同。

  1. 日期范围选择器是否绝对必要？ Plotly已经允许您放大特定的日期范围，您可能不需要单独的日期范围选择器。我知道您也将此按钮用于下载按钮，但也许可以考虑在确定其他问题之前忽略日期范围选择器。

  2. 通常，当我将过滤器函数连接到selectInput选择时，我将selectInput直接放在dplyr :: filter行中。

# you have
  output$LFplot2 <- renderPlotly({
    print(nrow(selector2()))
    req(nrow(selector2()) > 0)
    LFplt_2 <- selector2() %>%
      dplyr::filter(region == "Australia") %>%
      ggplot() +
      geom_line(mapping = aes(x= time, y= values, colour= sex))
    ggplotly(LFplt_2)
  })

# consider something like:
  output$LFplot2 <- renderPlotly({
    print(nrow(selector2()))
    req(nrow(selector2()) > 0)
    LFplt_2 <- selector2() %>%
      dplyr::filter(region == input$regionID) %>%  # region selection in filter here
      ggplot() +
      geom_line(mapping = aes(x= time, y= values, colour= sex))
    ggplotly(LFplt_2)
  })

看看是否有帮助。稍后会花更多时间。

0
投票

将输出$ LFplot1中的==运算符更改为%in%可解决此问题：

反应功能更改为：

  selector1 <- reactive({
    print(input$dateRange)
    lf %>% 
      dplyr::filter(time >= input$dateRange[1], time <= input$dateRange[2],
                    adjustment_type == input$adjustment, 
                    data_item == input$dataItem)
  })

输出图已更改为：

  output$LFplot1 <- renderPlotly({
    print("number of rows is: ")
    print(nrow(selector1()))
    req(nrow(selector1()) > 0)
    LFplt_1 <- selector1() %>%
      dplyr::filter(sex == "Persons", region %in% input$regionID) %>%
      ggplot() +
      geom_line(mapping = aes(x= time, y= values,colour= region))
    ggplotly(LFplt_1)
  })
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.