CODEWITHSUNDEEP
rggplot2shinyshiny-reactivity
SimpleNEasy
SimpleNEasy

Reputation: 889

ggplot based on condition, date x-axis, and valueBoxOutput not showing

My dataframe 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))

my 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)

My question has 3 parts:

  1. If you run the code and hover on the graph points, you will notice that ggplot is not showing the correct date on the x-axis. I put +scale_x_date(date_labels = "%b/%d") which solves the issue, however, it breaks the graph for other data. In other words, if I change the x-axis to be any other variable of the data, it won't show it correctly. After searching I found that using if statements would solve the issue. So I want to put a condition as: if the x-axis is Date, the graph will be with scale_x_date(..). If not I will use the same code in the example and this condition will be applied also for y-axis if date is chosen. I have added plot 2 "default plot" just to show that normal plot function is working fine even with date. I tried the condition in the code, and I'm getting errors.

  2. I'm struggling with showing the box , as you can see the code showing the values even the icom, but no box. I used the namespace based on suggestion, no hope. IMHO, I think it has to do with the packages, as I notices the warnings, some packages are masking commands.!

  3. Date as data can not be used for calculating Histogram. Is it possible, when the Histogram tab opened, only one input field is shown instead of two i.e. input$x and from the drop list menu date is excluded ?

Upvotes: 0

Views: 499

Answers (1)

bretauv
bretauv

Reputation: 8567

For future reference, do not ask several questions in the same post. StackOverflow is not just here to help you, it also helps other people looking for an answer to a problem in their code. It is not easy to see if a post and its answer are useful if they are many questions asked and answered in the same time.

Going back to your questions:

  • question 1: you had a problem with a parenthesis that I corrected in your post
  • question 2: valueBox can only be displayed in a dashboardPage, not in a fluidPage. That comes from an answer of Joe Cheng here:

    Sorry but valueBoxOutput and the other features of shinydashboard, are only available when being used with a dashboardPage.

  • question 3: you can use observe and updateSelectInput to change the choices in selectInput according to the selected tabPanel. To do so, you first need to create the id for tabsetPanel.

Here's the working code:

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)

Edit: if you want to remove the second selectInput when you click on the tab "Histogram", you have to use uiOutput and renderUI. Also, to prevent an error due to a missing input in the first two plots, use req() to signal to Shiny that you need these two inputs before starting the computation of the two plots. I modified the code above in consequence.

Upvotes: 1

Related Questions