Question

我正在尝试设计一种新方法，可以在可变页面中创建可变数量的图表，到目前为止，它的方向是正确的，但是当我减少图表数量时，我会不断打印以下错误在控制台中

警告：[[：下标超出范围[无堆栈跟踪可用]

这与现在不再需要的图出现问题有关，但是我找不到解决该错误的方法。

我正试图防止我的应用程序打印任何错误，并且我想知道（也要学习）如何摆脱以下应用程序中的越界错误：

目前，在插入实际图块进行测试之前，仅使用虚拟plots

由于以下原因，一直没有使用网格排列解决方案：我计划在每个图上方添加按钮以进行选项，删除，保存等 -我想用plot使每个svgpanzoom缩放（据我所知，grid.arrange ggplot2不可能

要求（发光）

ui <- shinyUI(fluidPage(
  uiOutput('plot_quantity_MSP_RawPlot'),
  uiOutput('plots')
))

server <- shinyServer(function(input, output) {
  values <- reactiveValues()


  output[['plot_quantity_MSP_RawPlot']] <- renderUI({ selectInput(inputId = item.name, label= 'Nr of plots',
                                                choices = 1:9,
                                                selected = 6)})




  observe({
    req(input$plot_quantity_MSP_RawPlot)
    values$plots <-
    lapply(1:input$plot_quantity_MSP_RawPlot, function(i){
    plot(runif(50),main=sprintf('Plot nr #%d',i))
    p <- recordPlot()
    plot.new()
    p
  })
  # values$plots <- plots
  })

  observe({
    req(input$plot_quantity_MSP_RawPlot)
    n <- input$plot_quantity_MSP_RawPlot
  values$n.col <- if(n == 1) {
    1
  } else if (n %in% c(2,4)) {
    2
  } else if (n %in% c(3,5,6,9)) {
    3
  } else {
    4
  }
  })

  output$plots <- renderUI({
  req(values$plots)
  col.width <- round(12/values$n.col) # Calculate bootstrap column width
  n.row <- ceiling(length(values$plots)/values$n.col) # calculate number of rows
  cnter <<- 0 # Counter variable

  # Create row with columns
  rows  <- lapply(1:n.row,function(row.num){
    cols  <- lapply(1:values$n.col, function(i) {
      cnter    <<- cnter + 1
      if(cnter <= input$plot_quantity_MSP_RawPlot) {
      plotname <- paste("plot", cnter, sep="")
      column(col.width, plotOutput(plotname, height = 280, width = 350))
      } else {
        column(col.width, br())
        }
    })
    fluidRow( do.call(tagList, cols), style = "width:1200px" )
  })
      do.call(tagList, rows)
  })

observe({
req(values$plots)
for (i in 1:length(values$plots)) {
  local({
    n <- i # Make local variable
    plotname <- paste("plot", n , sep="")
    output[[plotname]] <- renderPlot({
      suppressWarnings(values$plots[[n]])
    })
  })
}
})
})

shinyApp(ui=ui,server=server)

Answer 1

您不需要单独的observe，因此根据此处的示例-https://gist.github.com/wch/5436415/，我重写了没有代码的代码。您可以使用n_cols

调整列数

  max_plots <- 10;
    n_cols = 3;

    server <- function(input, output) {
      output$plots <- renderUI({
        plot_output_list <- list()
        for(i in 1:ceiling(input$n/n_cols)) { 
          cols_ <- list();
          for(j in 1:round((input$n/n_cols - (i - 1))*n_cols)) {
            cols_ <- append(cols_,list(column(width = floor(12/n_cols), offset = 0, plotOutput(paste0("plot", (i-1)*n_cols+j)))));
          }
          plot_output_list <- append(plot_output_list, list(fluidRow(cols_, style = "width:1200px" )));
        }
        do.call(tagList, plot_output_list)
      })

      for (i in 1:max_plots) {
        local({
          my_i <- i; plotname <- paste0("plot", my_i)
          output[[plotname]] <- renderPlot({
            plot(1:my_i, 1:my_i, main = paste0("1:", my_i)
            )
          })
        })
      }
    }
    ui<- pageWithSidebar(
      headerPanel("Dynamic number of plots"),
      sidebarPanel(sliderInput("n", "Number of plots", value=1, min=1, max=max_plots)),
      mainPanel(uiOutput("plots")
      )
    )

    shinyApp(ui=ui,server=server)

Answer 2

稍微调整了Alex的答案，以稍微改善自动布局。

max_plots <- 12;

shinyApp(
  ui<- pageWithSidebar(
    headerPanel("Dynamic number of plots"),
    sidebarPanel(width = 2, sliderInput("n", "Number of plots", value=1, min=1, max=max_plots),
                 h4("Clicked points"),
                 verbatimTextOutput("click_info"),
                 h4('click points to see info'),
                 h4('select area to zoom'),
                 h4('Double click to unzoom')
    ),
    mainPanel(uiOutput("plots")
    )
  ),
server <- function(input, output) {

  ranges <- reactiveValues()
  values <- reactiveValues()


  output$plots <- renderUI({
    plot_output_list <- list()
    n <- input$n

    n_cols <- if(n == 1) {
      1
    } else if (n %in% c(2,4)) {
      2
    } else if (n %in% c(3,5,6,9)) {
      3
    } else {
      4
    }
    Pwidth <- 900/n_cols
    Pheigth <- 600/ceiling(n/n_cols) # calculate number of rows

    for(i in 1:ceiling(input$n/n_cols)) { 
      cols_ <- list();
      for(j in 1:round((input$n/n_cols - (i - 1))*n_cols)) {
        # print((i-1)*n_cols+j)
        n <- (i-1)*n_cols+j
        cols_ <- append(cols_,list(column(width = floor(12/n_cols), offset = 0, 
                                          # uiOutput(paste('Button', n, sep = '')),  ## problem part
                                          plotOutput(paste0("plot", (i-1)*n_cols+j), width = Pwidth, height = Pheigth,
                                                     dblclick =  paste0("plot", (i-1)*n_cols+j, '_dblclick'),
                        click = paste0("plot", (i-1)*n_cols+j, '_click'),
                        brush = brushOpts(
                          id =  paste0("plot", (i-1)*n_cols+j, '_brush'),
                          resetOnNew = TRUE
                        ))
                        )));
      }
      plot_output_list <- append(plot_output_list, list(fluidRow(cols_, style = "width:1000px" )));
    }
    do.call(tagList, plot_output_list)
  })

  observe({
  lapply(1:input$n, function(i){

      plotname <- paste0("plot", i)
      output[[plotname]] <- renderPlot({
          ggplot(mtcars, aes(wt, mpg, color = as.factor(cyl))) + geom_point() +
          coord_cartesian(xlim =ranges[[paste('plot', i, 'x', sep = '')]], 
                          ylim = ranges[[paste('plot', i, 'y', sep = '')]], 
                          # expand = FALSE
                          ) +
          theme_classic() +
          theme(legend.text=element_text(size=12), 
                legend.title=element_blank()) 
        })
      })

  })
  # }



  output$click_info <- renderPrint({
    nearPoints(mtcars, input$plot1_click, addDist = TRUE)
  })


    # When a double-click happens, check if there's a brush on the plot.
    # If so, zoom to the brush bounds; if not, reset the zoom.

  lapply(1:max_plots, function(i){
    observeEvent(input[[paste('plot', i, '_dblclick', sep = '')]], {
                 brush <- input[[paste('plot', i, '_brush', sep = '')]]
                 if (is.null(brush)) {

                   ranges[[paste('plot', i, 'x', sep = '')]] <- NULL
                   ranges[[paste('plot', i, 'y', sep = '')]] <- NULL
                   values[[paste('brushedPoints', i, sep = '')]] <- NULL 
                 }
  })
})

  lapply(1:max_plots, function(i){
    observeEvent(input[[paste('plot', i, '_brush', sep = '')]], {
      brush <- input[[paste('plot', i, '_brush', sep = '')]]
      if (!is.null(brush)) {
        ranges[[paste('plot', i, 'x', sep = '')]] <- c(brush$xmin, brush$xmax)
        ranges[[paste('plot', i, 'y', sep = '')]] <- c(brush$ymin, brush$ymax)
        values[[paste('brushedPoints', i, sep = '')]] <- nrow(brushedPoints(mtcars[mtcars$cyl == 4],  input[[paste('plot', i, '_brush', sep = '')]]))
       }
    })
  })





  observe({
    lapply(1:input$n, function(i){

    output[[paste0('Button', i)]] <- renderUI({
      actionButton(inputId = paste0('button', i), label = 'x')
    })
    })
  })
}

)

灵活布局中的动态地块数量：减少地块数量时出错

2 个答案: