Shiny 应用程序仅在一个选项卡中显示绘图。是啥原因？

Posted 2023-02-16

【中文标题】Shiny 应用程序仅在一个选项卡中显示绘图。是啥原因？

【英文标题】：Shiny app displays plot only in one tab. What is the reason?Shiny 应用程序仅在一个选项卡中显示绘图。是什么原因？

【发布时间】：2022-01-07 03:55:36

【问题描述】：

目前我正在学习如何在 Web 应用程序中可视化预测数据与原始数据。 由于我想为原始数据和预测数据设置单独的选项卡，因此我使用的是导航栏面板。

在给定的表示中，两个数据帧都包含相同的数据，因为它仅用于技术说明。

目前我正在努力显示代表预测图的 plot2 数据。我猜这与错误的语法有关。否则可能是 html 问题。

请帮帮我：

library(shiny)
library(ggplot2)
library(dplyr)
library(hrbrthemes)
library(shinythemes)

dates <- ymd("2016-01-01")+ months(0:59)
fake_values <- 
  c(661,678,1094,1987,3310,2105,1452,983,1107)

replicate <- rep(1,60) %*% t.default(fake_values)
replicate <- as.data.frame(replicate)

df <- bind_cols(replicate, dates) %>%
  rename(c(dates = ...10))

## melt it down
data <- reshape2::melt(df, id.var='dates')
data$variable <- as.character(data$variable)
data$dates <- as.Date(data$dates)
data2 <- reshape2::melt(df, id.var='dates')
data2$variable <- as.character(data2$variable)
data2$dates <- as.Date(data2$dates)


#### UI

ui <- 
  navbarPage(
    
    title="Zeitreihenvorhersage",
    theme=shinytheme("spacelab"),
    inverse=TRUE,
    
    # first tab
    tabPanel(
      "Original Zeitreihe",
      fluidPage(
        sidebarPanel(
          selectInput(
            inputId = "variable",
            label = "Zeitreihe selektieren",
            choices = unique(data$variable),
            selected = "V1")
        ),
        mainPanel(
          plotOutput("plot", click = "plot_click"),
          verbatimTextOutput("info")
        )
      )
    ),
    
    # second tab
    tabPanel(
      "Forecast",
      fluidPage(
        sidebarPanel(
          selectInput(
            inputId = "variable",
            label = "Zeitreihe selektieren",
            choices = unique(data2$variable),
            selected = "V6")
            ),
      mainPanel(
        plotOutput("plot2", click = "plot_click2"),
        verbatimTextOutput("info2")
      )
    )
  )
)



#### SERVER

server <- function(input, output,  session) 
  
  output$plot <- renderPlot(
    data %>%
      filter(variable == input$variable) %>%
      ggplot(aes(dates, value, group = 1)) +
      geom_line( color="steelblue", size = 1.2) + 
      geom_point(size = 2.5) +
      xlab("") +
      ylab("Absatzmenge") +
      scale_x_date(date_breaks = "2 months")  +
      theme_bw() + 
      theme(
        panel.border = element_blank(),
        axis.text.x = element_text(angle = 60, vjust = 1, hjust = 1)
      )
  
  )
  output$info <- renderText(
    paste0("x=", input$plot_click$x, "\ny=", input$plot_click$y)
  
  )
  #
  
  
  output$plot2 <- renderPlot(
    data2 %>%
      filter(variable == input$variable) %>%
      ggplot(aes(dates, value, group = 1)) +
      geom_line( color="steelblue", size = 1.2) +
      geom_point(size = 2.5) +
      xlab("") +
      ylab("Absatzmenge") +
      scale_x_date(date_breaks = "2 months")  +
      theme_bw() +
      theme(
        panel.border = element_blank(),
        axis.text.x = element_text(angle = 60, vjust = 1, hjust = 1)
      )
    output$info2 <- renderText(
      paste0("x=", input$plot_click2$x, "\ny=", input$plot_click2$y)
    
    )
  
  ) 


runApp(list(ui = ui, server = server),host="127.x.x.x",port=9999, launch.browser = TRUE)

【参考方案1】：

您错过了在渲染output$info2 之前关闭第二个renderPlot - 如您所见，output$info2 之前没有右大括号。

这是改进版：

output$plot2 <- renderPlot(
    data2 %>%
      filter(variable == input$variable) %>%
      ggplot(aes(dates, value, group = 1)) +
      geom_line( color="steelblue", size = 1.2) +
      geom_point(size = 2.5) +
      xlab("") +
      ylab("Absatzmenge") +
      scale_x_date(date_breaks = "2 months")  +
      theme_bw() +
      theme(
        panel.border = element_blank(),
        axis.text.x = element_text(angle = 60, vjust = 1, hjust = 1)
      )
  )
    output$info2 <- renderText(
      paste0("x=", input$plot_click2$x, "\ny=", input$plot_click2$y)
    
    )