CODEWITHSUNDEEP
rshiny
Cengover
Cengover

Reputation: 89

Multiple plots according to checkboxGroupInput

I am trying to create an easy application with R shiny. However I could not get the desired output I want. I am neither experienced in shiny nor an expert of R. Here is the code:

library(shiny)

ui <- fluidPage(
  headerPanel("deneme"),
  checkboxGroupInput("plots", "draw plots:", 
                 choices=list("histogram", "qq","both"), 
                 selected="histogram"),
  sidebarPanel(
    numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
    numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
    numericInput("n", " number of observations ", value=seq(30,50))
    ),

  mainPanel(
    textOutput("text1"),
    fluidRow(splitLayout(cellWidths = c("60%", "40%"), 
                     plotOutput("graph1"), plotOutput("graph2")))
  )
)

server <- function(input, output) {

  norm<-reactive({
    set.seed(6)
    rnorm(input$n,mean=input$mean,sd=input$sd)
    })  

  output$text1<-renderText({
                    paste("A random normal distrubution of", 
                          input$n, "observations is generated with parameters mean",
                          input$mean,"and standart deviation", input$sd)
    })

  output$graph1<-renderPlot({    
    if(identical(input$plots,"histogram")){
    req(norm())
    hist(norm())
    }  
  })

  output$graph2<- renderPlot({ 
    if(identical(input$plots,"qq")) {
      req(norm())
      qqnorm(norm(), pch = 1, frame = FALSE)
      qqline(norm(), col = "steelblue", lwd = 2)
      }
  })

  observe({
    if(identical(input$plots,"both")) { 
      req(norm())
      output$graph1<- renderPlot({
        hist(norm())
        })
      output$graph2<- renderPlot({
        qqnorm(norm(), pch = 1, frame = FALSE)
        qqline(norm(), col = "steelblue", lwd = 2) 
        })
    }
  })
}

shinyApp(ui = ui, server = server)

I want the plot layout change dynamically according to selection of checkboxGroupInput. When I click histogram or qq I want it to plot an unsplit frame, into only one plotting frame. Whereas when I click both I want the plots to be seen together in a split frame of two rows. When unclicked the layout must be reset to one frame again. I know I am not doing it right by splitting the layout in ui first. I saw something about renderUI function but could not understand how it works. Thanks in advance. Also I got some error related to if statement:

Warning in if (!is.na(attribValue)) { : the condition has length > 1 and only the first element will be used Warning in charToRaw(enc2utf8(text)) : argument should be a character vector of length 1 all but the first element will be ignored

Upvotes: 0

Views: 1281

Answers (2)

emilliman5
emilliman5

Reputation: 5966

Here is a start, you don't need the observer, you can just add an if statement to each renderPlot.

Update: The trick to getting the plots to update dynamically is to assign them into a list and then render the list of plots with renderUI, the only caveat to this is that I am unaware of a way to get these plots to render side-by-side at the moment, it probably has something to do with adding some div tags...

Update 2: To get the plots side by side we just need to wrap the plotOutput in column

library(shiny)

ui <- fluidPage(
  headerPanel("deneme"),
  checkboxGroupInput("plots", "draw plots:", 
                     choices=list("histogram", "qq"), 
                     selected="histogram"),
  sidebarPanel(
    numericInput("mean", "rn mean", value=1, min=0, max=5),
    numericInput("sd","standart deviation",value=1,min=0,max=5),
    numericInput("n", " number of observations ", value=30)
  ),

  mainPanel(
    textOutput("names"),
    textOutput("text1"),
    fluidRow(uiOutput("plot_list"))
  )
 )


server <- function(input, output) {
  norm<-reactive({
    set.seed(6)
    rnorm(input$n,mean=input$mean,sd=input$sd)
  })  

  output$text1<-renderText({
    paste("A random normal distribution of", 
          input$n, "observations is generated with parameters mean",
          input$mean,"and standart deviation", input$sd)
  })

  output$histogram <- renderPlot({    
    req(norm())
    if("histogram" %in% input$plots){
      hist(norm())
    }
  })

  output$qq <- renderPlot({ 
    req(norm())
    if("qq" %in% input$plots){
      qqnorm(norm(), pch = 1, frame = FALSE)
      qqline(norm(), col = "steelblue", lwd = 2)
    }
  })

  output$plot_list <- renderUI({
    plot_output_list <- lapply(input$plots, 
                               function(plotname) {
                                 column(width=5, plotOutput(plotname)) ##wrap the plotOutput in column to render side-by-side
                               })

    # Convert the list to a tagList - this is necessary for the list of items
    # to display properly.
    do.call(tagList, plot_output_list)
  })
}


shinyApp(ui = ui, server = server)

Upvotes: 1

A. S. K.
A. S. K.

Reputation: 2816

You can have a single plotOutput and use mfrow to split it into two panels, like this:

library(shiny)

ui <- fluidPage(
  headerPanel("deneme"),
  radioButtons("plots", "draw plots:", 
               choices=list("histogram", "qq","both"), 
               selected="histogram"),
  sidebarPanel(
    numericInput("mean", "rn mean", value=seq(0:5), min=0, max=5),
    numericInput("sd","standart deviation",value=seq(0:5),min=0,max=5),
    numericInput("n", " number of observations ", value=seq(30,50))
  ),

  mainPanel(
    textOutput("text1"),
    plotOutput("graph")
  )
)

server <- function(input, output) {

  norm<-reactive({
    set.seed(6)
    rnorm(input$n,mean=input$mean,sd=input$sd)
  })  

  output$text1<-renderText({
    paste("A random normal distrubution of", 
          input$n, "observations is generated with parameters mean",
          input$mean,"and standart deviation", input$sd)
  })

  output$graph = renderPlot({
    if(input$plots == "both") {
      par(mfrow = c(1, 2))
    }
    if(is.element(input$plots, c("histogram", "both"))) {
      req(norm())
      hist(norm())
    }
    if(is.element(input$plots, c("qq", "both"))) {
      req(norm())
      qqnorm(norm(), pch = 1, frame = FALSE)
      qqline(norm(), col = "steelblue", lwd = 2)
    }
  })

}

shinyApp(ui = ui, server = server)

If you want two rows instead of two columns, just change par(mfrow = c(1, 2)) to par(mfrow = c(2, 1)).

(I'm still getting the error on if too, but it doesn't seem to affect the functioning of the app, at least as far as the graphs are concerned. I'm not sure where it's coming from.)

Upvotes: 1

Related Questions