Несколько графиков в соответствии с checkboxGroupInput

Question

Я пытаюсь создать простое приложение с R блестящим. Однако я не мог получить желаемый результат, который я хочу. Я не опытный в блестящем и не эксперт 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. Когда я нажимаю histogram или qq, я хочу построить неразделенный кадр только в одном кадре. Принимая во внимание, что когда я нажимаю both, я хочу, чтобы графики были видны вместе в разделенной рамке из двух рядов. При отсутствии щелчка макет должен быть сброшен на один кадр снова. Я знаю, что делаю неправильно, сначала разбив макет в ui. Я видел кое-что о renderUI функции, но не мог понять, как она работает. Заранее спасибо. Также я получил ошибку, связанную с оператором if:

Предупреждение в if (! Is.na (attribValue)) {: условие имеет длину> 1, и будет использоваться только первый элемент Предупреждение в charToRaw (enc2utf8 (текст)): аргумент должен быть символьным вектором длины 1 все элементы, кроме первого, будут игнорироваться

Answer 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, но, похоже, это не влияет на работу приложения, по крайней мере, в том, что касается графиков. Я не уверен, откуда это исходит .)

Answer 2

Вот начало, вам не нужен наблюдатель, вы можете просто добавить оператор 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)