基于条件、日期x轴和valueBoxOutput的ggplot未显示

问题描述 投票:0回答:1

我的数据框 df:

  df<- structure(list(Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L
  ), Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L), Recovered = c(30L,0L, 18L, 13L, 19L, 
  10L, 0L,16L, 0L, 1L), Critical = c(0L, 0L, 0L,                                                                                                                               
  0L, 8L, 4L, 0L, 3L, 2L, 0L), Date = c("18/03/2020", "17/03/2020",                                                                                                                                                                    
  "16/03/2020", "15/03/2020", "14/03/2020", "13/03/2020", "12/03/2020",                                                                                                                                                                    
  "11/03/2020", "10/03/2020", "09/03/2020")), class = "data.frame", row.names = c(NA,                                                                                                                                                                                                                                                    
  10L))

我的MWE:

library(shiny)
library(plotly)
library(ggplot2)
df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
 title = 'testing',
 sidebarLayout(
   sidebarPanel(
   helpText(),
   selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
   selectInput("y", "Choose Y-axis data", choices = names(df)),
  # Input: Slider for the number of observations to generate ----
  sliderInput("n",
              "No. of bins:",
              value = 5,
              min = 1,
              max = 15) ,
   ),
 mainPanel(
   tabsetPanel(
     tabPanel("ggplot", plotlyOutput("regPlot1")),
     tabPanel("default plot", plotOutput("regPlot2")),
     tabPanel("Histogram", plotOutput("regPlot3"))
   ),
  fluidRow(
    shinydashboard::valueBoxOutput("totalCases",width = 2)
    )
   )
  )
 )

server <- function(input, output, session) {
 #calculation for box values
 total.cases <- sum(df$Case)
  ## Value1: Total cases ## 
  output$totalCases <- renderValueBox({
  shinydashboard::valueBox(
  formatC(total.cases, format="d", big.mark=','),
  paste('Total Cases:',total.cases),
  icon = icon("stats",lib='glyphicon'),
  color = "purple")
  })
    Graphcase <- reactive({
     Gchoice<-input$x
    })
 myData <- reactive({
   df[, c(input$x, input$y)]
 })
 #plot
  output$regPlot1 <- renderPlotly({
   # comment the if and else(block) to make run the code
   if(Graphcase=="Date"){

       ggplotly(ggplot(data = myData(), 
                aes_string(x = input$x, y = input$y)) +
                geom_line( color="blue") +
                geom_point(shape=21, color="black", fill="gray", size=4) +
                theme(axis.text.x = element_text(color="#993333", 
                                            size=10, angle=45,hjust = 1),
                 axis.text.y = element_text(color="#993333", 
                                            size=10, angle=45,hjust = 1)))
                     +scale_x_date(date_labels = "%b/%d")
  
    }else{
         ggplotly(ggplot(data = myData(), 
                  aes_string(x = input$x, y = input$y)) +
                  geom_line( color="blue") +
                 geom_point(shape=21, color="black", fill="gray", size=4) +
                 theme(axis.text.x = element_text(color="#993333", 
                                              size=10, angle=45,hjust = 1),
                   axis.text.y = element_text(color="#993333", 
                                              size=10, angle=45,hjust = 1)))
  
     }
   })

    # plot2
    output$regPlot2 <- renderPlot({
       par(mar = c(4, 4, .1, .1)) # margin lines
       plot(myData(), data = df)
    })
    #plot 3
     output$regPlot3 <- renderPlotly({
             ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
             geom_histogram(color="black", 
                            fill="blue",
                            binwidth=input$n)
      )
    })




     }

       shinyApp(ui, server)

我的问题有 3 个部分:

  1. 如果运行代码并将鼠标悬停在图形点上,您会注意到 ggplot 在 x 轴上没有显示正确的日期。我输入

     +scale_x_date(date_labels = "%b/%d")
    解决了问题,但是,它破坏了其他数据的图表。换句话说,如果我将 x 轴更改为数据的任何其他变量,它将无法正确显示。经过搜索,我发现使用
    if statements
    可以解决这个问题。所以我想设置一个条件:如果x轴是
    Date
    ,则图表将带有scale_x_date(..)。如果不是,我将在示例中使用相同的代码,并且如果选择日期,此条件也将应用于 y 轴。我添加了图 2“默认图”,只是为了表明即使使用日期,正常绘图功能也能正常工作。我尝试了代码中的条件,但出现错误。

  2. 我正在努力显示该框,因为您可以看到代码甚至显示了 icom 的值,但没有框。我根据建议使用了命名空间,没有希望。恕我直言,我认为这与软件包有关,因为我注意到警告,有些软件包正在屏蔽命令。!

  3. 日期作为数据不能用于计算直方图。是否有可能,当“直方图”选项卡打开时,仅显示一个输入字段而不是两个,即 input$x 并且从下拉列表菜单中排除日期?

r ggplot2 shiny shiny-reactivity
1个回答
1
投票

为了将来的参考,不要在同一个帖子中提出多个问题。 StackOverflow 不仅可以帮助您,还可以帮助其他人寻找代码中问题的答案。如果同时提出和回答了很多问题,那么很难看出一篇帖子及其答案是否有用。

回到你的问题:

  • 问题 1:你的括号有问题,我在你的帖子中更正了
  • 问题2:
    valueBox
    只能显示在
    dashboardPage
    中,不能显示在
    fluidPage
    中。这来自 Joe Cheng here 的回答:

    抱歉,valueBoxOutput 和闪亮仪表板的其他功能仅在与仪表板页面一起使用时才可用。

  • 问题3:您可以使用
    observe
    updateSelectInput
    根据所选的tabPanel更改
    selectInput
    中的选择。为此,您首先需要为
    id
    创建
    tabsetPanel

这是工作代码:

library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)

df <- structure(
  list(
    Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L),
    Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L),
    Recovered = c(30L, 0L, 18L, 13L, 19L,
                  10L, 0L, 16L, 0L, 1L),
    Critical = c(0L, 0L, 0L,
                 0L, 8L, 4L, 0L, 3L, 2L, 0L),
    Date = c(
      "18/03/2020",
      "17/03/2020",
      "16/03/2020",
      "15/03/2020",
      "14/03/2020",
      "13/03/2020",
      "12/03/2020",
      "11/03/2020",
      "10/03/2020",
      "09/03/2020"
    )
  ),
  class = "data.frame",
  row.names = c(NA,
                10L)
)

df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
  title = 'testing',
  sidebarLayout(
    sidebarPanel(
      helpText(),
      selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
      uiOutput("second_select"),
      # Input: Slider for the number of observations to generate ----
      sliderInput("n",
                  "No. of bins:",
                  value = 5,
                  min = 1,
                  max = 15) ,
    ),
    mainPanel(
      tabsetPanel(
        id = "tabs",
        tabPanel("ggplot", plotlyOutput("regPlot1")),
        tabPanel("default plot", plotOutput("regPlot2")),
        tabPanel("Histogram", plotlyOutput("regPlot3"))
      )
    )
  )
)

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

  Graphcase <- reactive({
    Gchoice<-input$x
  })
  myData <- reactive({
    df[, c(input$x, input$y)]
  })
  #plot
  output$regPlot1 <- renderPlotly({
    req(input$x)
    req(input$y)
    # comment the if and else(block) to make run the code
    if(Graphcase()=="Date"){

      ggplotly(ggplot(data = myData(),
                      aes_string(x = input$x, y = input$y)) +
                 geom_line( color="blue") +
                 geom_point(shape=21, color="black", fill="gray", size=4) +
                 theme(axis.text.x = element_text(color="#993333",
                                                  size=10, angle=45,hjust = 1),
                       axis.text.y = element_text(color="#993333",
                                                  size=10, angle=45,hjust = 1)) +
                 scale_x_date(date_labels = "%b/%d"))

    }else{
      ggplotly(ggplot(data = myData(),
                      aes_string(x = input$x, y = input$y)) +
                 geom_line( color="blue") +
                 geom_point(shape=21, color="black", fill="gray", size=4) +
                 theme(axis.text.x = element_text(color="#993333",
                                                  size=10, angle=45,hjust = 1),
                       axis.text.y = element_text(color="#993333",
                                                  size=10, angle=45,hjust = 1)))

    }
  })

  # plot2
  output$regPlot2 <- renderPlot({
    par(mar = c(4, 4, .1, .1)) # margin lines
    plot(myData(), data = df)
  })
  #plot 3

  observe({
    if(input$tabs == "Histogram"){
      updateSelectInput(session = session,
                        inputId = "x",
                        choices = names(subset(df, select = -c(Date))))

      output$second_select <- renderUI(NULL)
    }
    else {
      updateSelectInput(session = session,
                        inputId = "x",
                        choices = names(df),
                        selected = "Date")

      output$second_select <- renderUI({
        selectInput("y", "Choose Y-axis data", choices = names(df))
      })
    }
  })
  output$regPlot3 <- renderPlotly({
    ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
               geom_histogram(color="black",
                              fill="blue",
                              binwidth=input$n)
    )
  })

}

shinyApp(ui, server)

编辑:如果您想在单击“直方图”选项卡时删除第二个

selectInput
,则必须使用
uiOutput
renderUI
。另外,为了防止由于前两个图中缺少输入而出现错误,请使用
req()
向 Shiny 发出信号,表明您在开始计算两个图之前需要这两个输入。我因此修改了上面的代码。

© www.soinside.com 2019 - 2024. All rights reserved.