Interactively choosing a plot location in R with Shiny

Question

I'm not really sure how to ask this, but here it goes:

I'm using the shiny package in R. I'm currently outputting a ggplot2 plot, which is just fine.

I'd like to plot two graphs, one above the other, to visually compare differences between them.

Ideally, I'd like to be able to select the plotting position (top or bottom) with a radio button. As I change the inputs to generate the plot I'm already getting now, it would appear in whichever position is selected by the top/bottom radio buttons.

trim_down<-function(LAB,TYPE,FORM,CLASS,AMI,DATE){

  ma<<-dft
  if (is.nan(TYPE)==FALSE){ma<<-subset(ma, type %in% TYPE)}
  if (is.nan(FORM)==FALSE){ma<<-subset(ma, form %in% FORM)}
  if (is.nan(CLASS)==FALSE){ma<<-subset(ma, class %in% CLASS)}
  if (is.nan(AMI)==FALSE){ma<<-subset(ma, ami %in% AMI)}

  ma<<-subset(ma, as.Date(dateStarted,"%m/%d/%Y")>=DATE[1]  )
  ma<<-subset(ma, as.Date(dateStarted,"%m/%d/%Y")<=DATE[2]  )
  dim(ma)
  ma<<-ma[,-(1:length(test_factors))]
  all_test_names<<-names(ma)
  ma<<-as.matrix(ma)
  ma<<-t(apply(ma, 1,as.numeric,na.rm=TRUE))
  aa<<-1-colMeans(ma,na.rm=TRUE)
  b<<-colSums(!is.na(ma))
  active_test_names<<-all_test_names[!is.nan(aa)]
  x<<-rbind(aa,b)
  graph.me(x,all_test_names,active_test_names,trimmed_up=FALSE)
 }




graph.me<-function(x,all_test_names,active_test_names,trimmed_up=TRUE){
  library(reshape2)
  aa<<-x[1,]
  b<<-x[2,]
  aa[aa==0]=-.1
  aa[is.na(aa)]=0
  XAXIS<<-all_test_names
  success <- as.data.frame(aa)
  rownames(success)<-XAXIS
  samples <- as.data.frame(b)
  data.long <- cbind(melt(success,id=1), melt(samples, id=1))

  names(data.long) <- c("success", "count")
  rownames(data.long)<-XAXIS


  threshold <- 25
  data.long$fill <- with(data.long,ifelse(count>threshold,max(count),count))
  data.long$fill[data.long$fill>threshold]<-threshold

  library(ggplot2)
  library(RColorBrewer)
  print(ggplot(data.long) +
    geom_bar(aes(x=XAXIS, y=success, fill=fill),colour="grey70",stat="identity")+
    scale_fill_gradientn(colours=brewer.pal(9,"RdYlGn")) +
    theme(axis.text.x=element_text(angle=-90,hjust=0,vjust=0.4)))

}
   ui.r
 library(shiny)

    # Define UI for miles per gallon application
    shinyUI(pageWithSidebar(

      # Application title
      headerPanel("Example"),


      sidebarPanel(
    #    checkboxGroupInput("_lab", "lab:",unique(dft$lab)),
        checkboxGroupInput("type", "Type:",unique(dft$type),selected=unique(dft$type)),
        checkboxGroupInput("form", "Form:",unique(dft$form),selected=unique(dft$form)),
        checkboxGroupInput("class", "Class:",unique(dft$class),selected=unique(dft$class)),
        checkboxGroupInput("ami", "AMI:",unique(dft$ami),selected=unique(dft$ami)),
        dateRangeInput("daterange", "Date range:",
                       start = min(as.Date(dft$date,"%m/%d/%Y")),
                       end   = max(as.Date(dft$date,"%m/%d/%Y")))

      ),

      mainPanel(
        h3(textOutput("caption")),

        plotOutput("Plot")
      )
    ))


server.r
library(shiny)



shinyServer(function(input, output) {

  # Compute the forumla text in a reactive expression since it is 
  # shared by the output$caption and output$mpgPlot expressions
  formulaText <- reactive({
    paste(input$type,input$form,input$class,input$ami)
  })



  # Return the formula text for printing as a caption
  output$caption <- renderText({
    formulaText()
  })

  # Generate a plot of the requested variable against mpg and only 
  # include outliers if requested
  output$Plot <- renderPlot(function(){

    print(trim_down(NA,input$type,input$form,input$class,input$ami,input$daterange))
    })
})

Thanks for the help...Sorry for so much code, but I'm not sure what's safe to omit for everyone's review. If it helps, I feel the problem could be resolved by addressing ggplot to plot on some layout-grid...Like, grid.arrange() that is driven by a radio button for top or bottom?

Based on a response, I have tried this:

ui.r
library(shiny)

shinyUI(pageWithSidebar(

  # Application title
  headerPanel("Example"),


  sidebarPanel(
    radioButtons("plotSpot", "Position", c(1,2)),
    checkboxGroupInput("type", "Type:",unique(dft$type),selected=unique(dft$type)),
    checkboxGroupInput("form", "Form:",unique(dft$form),selected=unique(dft$form)),
    checkboxGroupInput("class", "Class:",unique(dft$class),selected=unique(dft$class)),
    checkboxGroupInput("ami", "AMI:",unique(dft$ami),selected=unique(dft$ami)),
    dateRangeInput("daterange", "Date range:",
                   start = min(as.Date(dft$date,"%m/%d/%Y")),
                   end   = max(as.Date(dft$date,"%m/%d/%Y")))

  ),

  mainPanel(

    plotOutput("topPlot"),
    plotOutput("bottomPlot")
  )
))
server.r
library(shiny)
p<-list()

     output$Plot <- renderPlot({
       p[input$plotSpot]<-trim_down(NA,input$type,input$form,input$class,input$ami,input$daterange)
       output$topPlot <- renderPlot(ifelse(input$position == "Top", print(p[1]), print(p[2])))
       output$bottomPlot <- renderPlot(ifelse(input$position == "Top", print(p[2]), print(p[1])))

 })
})

But, that only makes one graph. I though switching the indices of the list that holds the ggplot and then keeping the order in which they're graphed the same would do the trick, but no luck.

Answer 1

OK, I wasn't going to work through all that code, but here's an example that may do what you want. If I've misunderstood, try to repost with a minimal example, that strips it all back to just the problem you're addressing.

ui.R

library(shiny)
shinyUI(pageWithSidebar(
  headerPanel("Plot position"),
  sidebarPanel(
    radioButtons("position", "Position", c("Top", "Bottom"))),
  mainPanel(
    plotOutput("topPlot"),
    plotOutput("bottomPlot"))))

server.R

library(shiny)
library(ggplot2)
dat <- data.frame(A = 1:10, B = rnorm(10))

shinyServer(function(input, output) {
  p1 <- ggplot(dat, aes(A, B)) + geom_point(colour = "red")
  p2 <- ggplot(dat, aes(A, B)) + geom_path(colour = "blue")
  output$topPlot <- renderPlot(ifelse(input$position == "Top", print(p1), print(p2)))
  output$bottomPlot <- renderPlot(ifelse(input$position == "Top", print(p2), print(p1)))
})

---

Edit

According to your new description of the problem, the following may help. I think you're making it too complicated - if the settings are going to be different for the different plots, have inputs for each of the different plots. It would be possible to just have one set, but would increase the complexity dramatically.

ui.R

library(shiny)
shinyUI(pageWithSidebar(
  headerPanel("Plot position"),
  sidebarPanel(
    h2("Top plot settings"),
    radioButtons("topPlotColour", "Colour:", 
                 list("Blue" = "blue",
                      "Red" = "red")),
    radioButtons("topPlotGeom", "Geom:", 
                 list("Point" = "point",
                      "Line" = "line")),
    h2("Bottom plot settings"),
    radioButtons("bottomPlotColour", "Colour:", 
                 list("Blue" = "blue",
                      "Red" = "red")),
    radioButtons("bottomPlotGeom", "Geom:", 
                 list("Point" = "point",
                      "Line" = "line"))),
  mainPanel(
    plotOutput("topPlot"),
    plotOutput("bottomPlot"))))

server.R

library(shiny)
library(ggplot2)
dat <- data.frame(A = 1:10, B = rnorm(10))

shinyServer(function(input, output) {
  p1_geom <-reactive({
    geom <- switch(input$topPlotGeom,
                   point = geom_point(colour = input$topPlotColour),
                   line = geom_line(colour = input$topPlotColour))
  })
  p2_geom <-reactive({
    geom <- switch(input$bottomPlotGeom,
                   point = geom_point(colour = input$bottomPlotColour),
                   line = geom_line(colour = input$bottomPlotColour))
  })
  p1_colour <- reactive({input$topPlotColour})
  output$topPlot <- renderPlot({print(ggplot(dat, aes(A, B), colour = p1_colour()) + p1_geom())})
  output$bottomPlot <- renderPlot(print(ggplot(dat, aes(A, B), colour = toString(quote(input$bottomPlotColour))) + p2_geom()))
})