根据checkboxGroupInput的多个图

时间:2019-01-14 13:46:58

标签: r shiny

我正在尝试使用R Shiny创建一个简单的应用程序。但是我无法获得想要的输出。我既没有光泽的经验,也没有R的专家。这是代码:

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)

我希望根据checkboxGroupInput的选择来动态更改布局。当我单击histogramqq时,我希望它将未拆分的帧绘制成一个绘图帧。而当我单击both时,我希望在两行的拆分框中一起显示这些图。取消单击时,必须再次将布局重置为一帧。我知道我首先在ui中拆分布局是不对的。我看到了一些关于renderUI函数的信息,但无法理解它是如何工作的。提前致谢。 我也遇到了一些与if语句有关的错误:

  

警告是否(!is.na(attribValue)){:   条件的长度> 1,并且仅使用第一个元素   charToRaw(enc2utf8(text))中的警告:   参数应为长度为1的字符向量   除了第一个元素之外的所有元素都将被忽略

2 个答案:

答案 0 :(得分:1)

这是一个开始,您不需要观察者,只需向每个if添加一个renderPlot语句。

更新:动态更新地块的技巧是将其分配到列表中,然后使用renderUI呈现地块列表,对此,唯一的警告是我目前尚不知道如何使这些图并排渲染,这可能与添加一些div标签有关...

更新2:要并排绘制图,我们只需要将plotOutput包裹在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)

答案 1 :(得分:1)

您可以拥有一个plotOutput,然后使用mfrow将其分成两个面板,如下所示:

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)

如果要两行而不是两列,只需将par(mfrow = c(1, 2))更改为par(mfrow = c(2, 1))

(我也仍然在if上遇到错误,但是它似乎并没有影响应用程序的功能,至少在图形方面没有影响。我不确定它在哪里来自。)