以交互方式选择R中的打印位置

我真的不知道该怎么问这个问题，但它是这样的：

我在R中使用了闪亮的包。我目前正在输出一个ggplot2绘图，这很好

我想画两个图，一个在另一个上面，以直观地比较它们之间的差异

理想情况下，我希望能够使用单选按钮选择打印位置（顶部或底部）。当我改变输入以生成我现在已经得到的绘图时，它将出现在顶部/底部单选按钮选择的任何位置

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

---

但是，这只是一个图表。我认为切换保存ggplot的列表的索引，然后保持它们的图形顺序不变，这会起到作用，但运气不好。

好的，我不打算处理所有代码，但下面的示例可能会满足您的需要。如果我误解了，试着用一个最小的例子来重新发布，这会把所有的问题都带回到你正在解决的问题上

ui.R

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

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

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

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()))
})

server.R

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

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

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

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()))
})

server.R

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

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

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

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()))
})

库（闪亮）
图书馆（GG2）
请提出你的问题，特别是一个最小的例子。这很接近。如果存在其他切换（如图形颜色、线条或点等），而不是让图形交换位置，那么最初的问题是如何将附加控件的更改应用于选定的图形（顶部或底部）。它们将保持不变，并将其他输入定向到所选图形（顶部或底部）。谢谢！太好了。现在来了解如何将这两组按钮堆叠在一起（我有一个长长的按钮列表，它们在屏幕上向下滚动）。再次感谢！