R宽度和高度don'；t更新

我正在编写一个闪亮的应用程序，我试图根据一些输入更新绘图的大小。问题是，当情节变得更大时，它不会回到更小的尺寸

代码如下：

library(dplyr)
library(plotly)
library(shiny)

dat <- data.frame(xval = sample(100,1000,replace = TRUE),
                  group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)),
                  group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)),
                  group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)),
                  group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE)))


create_plot <- function(dat, group, color, shape) {
    p <- dat %>%
      plot_ly() %>%
      add_trace(x = ~as.numeric(get(group)), 
                y = ~xval, 
                color = ~get(group),
                type = "box") %>%
      add_markers(x = ~jitter(as.numeric(get(group))), 
                  y = ~xval, 
                  color = ~get(color),
                  symbol = ~get(shape),
                  marker = list(size = 4)
      )
  p
}

calc_boxplot_size <- function(facet) {

  if (facet) {
    width <- 1000
    height <- 700
  } else {
    width <- 500
    height <- 400
  }
  cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n")
  list(width = width, height = height)
}



ui <- fluidPage(
  selectizeInput("group", label = "group", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("color", label = "color", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("shape", label = "shape", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)),
                 multiple = FALSE, selected = "none"),
  textOutput("size"),
  uiOutput("plotbox")
)

server <- function(input, output, session) {

  output$plotbox <- renderUI({
    psize <- calc_boxplot_size((input$facet != "none"))
    plotlyOutput("plot", height = psize$height, width = psize$width)
  })

  output$size <- renderText({
    psize <- calc_boxplot_size((input$facet != "none"))
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height)
  })

  output$plot <- renderPlotly({
    if (input$facet == "none") {
      p <- create_plot(dat, input$group, input$color, input$shape)
    } else {
      plots <- dat %>%
        group_by_(.dots = input$facet) %>%
        do(p = {
          create_plot(., input$group, input$color, input$shape)
        })
      p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02)
    }
  })

}

shinyApp(ui, server)

---

有没有其他方法可以像那样更新绘图的大小？请帮助。

我添加了自定义宽度和高度输入，它可以工作。。。也许我就是不明白这个问题

库（dplyr）
图书馆（绘本）
图书馆（闪亮）
dat%
添加_标记（x=~jitter（as.numeric（get（group）），
y=~xval，
颜色=~get（颜色），
symbol=~get（形状），
标记=列表（大小=4）
)
P
}
calc_boxplot_大小我相信您知道可以直接从UI更新放大/缩小绘图图。你为什么不使用这个功能并编写代码呢？因为有时候你想知道情节的大致情况，有时候情节太大以至于不适合这个区域（不是在我的示例中，而是在我正在制作的应用程序中）。当一个绘图中有很多箱线图时，放大和缩小都很烦人。是的，但我想根据功能自动更新大小。这一个允许您通过用户输入更新大小，这样就不会解决我的问题。
library(dplyr)
library(plotly)
library(shiny)

dat <- data.frame(xval = sample(100,1000,replace = TRUE),
                  group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)),
                  group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)),
                  group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)),
                  group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE)))


create_plot <- function(dat, group, color, shape, width, height) {
    p <- dat %>%
      plot_ly(width = width, height = height) %>%
      add_trace(x = ~as.numeric(get(group)), 
                y = ~xval, 
                color = ~get(group),
                type = "box") %>%
      add_markers(x = ~jitter(as.numeric(get(group))), 
                  y = ~xval, 
                  color = ~get(color),
                  symbol = ~get(shape),
                  marker = list(size = 4)
      )
  p
}

calc_boxplot_size <- function(facet) {

  if (facet) {
    width <- 1000
    height <- 700
  } else {
    width <- 500
    height <- 400
  }
  cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n")
  list(width = width, height = height)
}



ui <- fluidPage(
  selectizeInput("group", label = "group", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("color", label = "color", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("shape", label = "shape", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)),
                 multiple = FALSE, selected = "none"),
  textOutput("size"),
  uiOutput("plotbox")
)

server <- function(input, output, session) {

  output$plotbox <- renderUI({
    psize <- calc_boxplot_size((input$facet != "none"))
    plotlyOutput("plot")
  })

  output$size <- renderText({
    psize <- calc_boxplot_size((input$facet != "none"))
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height)
  })

  output$plot <- renderPlotly({
    psize <- calc_boxplot_size((input$facet != "none"))
    if (input$facet == "none") {
      p <- create_plot(dat, input$group, input$color, input$shape, psize$width, psize$height)
    } else {
      plots <- dat %>%
        group_by_(.dots = input$facet) %>%
        do(p = {
          create_plot(., input$group, input$color, input$shape, psize$width, psize$height)
        })
      p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02)
    }
  })

}

shinyApp(ui, server)

library(dplyr)
library(plotly)
library(shiny)

dat <- data.frame(xval = sample(100,1000,replace = TRUE),
                  group1 = as.factor(sample(c("a","b","c"),1000,replace = TRUE)),
                  group2 = as.factor(sample(c("a1","a2","a3","a4"),1000, replace = TRUE)),
                  group3 = as.factor(sample(c("b1","b2","b3","b4"),1000, replace = TRUE)),
                  group4 = as.factor(sample(c("c1","c2","c3","c4"),1000, replace = TRUE)))


create_plot <- function(dat, group, color, shape, width, height) {
  p <- dat %>%
    plot_ly(width = width, height = height) %>%
    add_trace(x = ~as.numeric(get(group)), 
              y = ~xval, 
              color = ~get(group),
              type = "box") %>%
    add_markers(x = ~jitter(as.numeric(get(group))), 
                y = ~xval, 
                color = ~get(color),
                symbol = ~get(shape),
                marker = list(size = 4)
    )
  p
}

calc_boxplot_size <- function(facet) {

  if (facet) {
    width <- 1000
    height <- 700
  } else {
    width <- 500
    height <- 400
  }
  cat(sprintf("WIDTH: %s, HEIGHT: %s", width, height), sep = "\n")
  list(width = width, height = height)
}



ui <- fluidPage(
  selectizeInput("group", label = "group", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("color", label = "color", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("shape", label = "shape", choices = paste0("group", 1:4),
                 multiple = FALSE),
  selectizeInput("facet", label = "facet", choices = c("none", paste0("group", 1:4)),
                 multiple = FALSE, selected = "none"),
  textOutput("size"),
  tagList(
    textInput("plot.width", "width:", 1000),
    textInput("plot.height", "height", 700)
  ),
  uiOutput("plotbox")
)

server <- function(input, output, session) {

  output$plotbox <- renderUI({
    # column(9,
    #        psize <- calc_boxplot_size((input$facet != "none")),
    #        plotlyOutput("plot")
    # )

    psize <- calc_boxplot_size((input$facet != "none"))
    plotlyOutput("plot")

  })

  output$size <- renderText({
    psize <- calc_boxplot_size((input$facet != "none"))
    sprintf("WIDTH: %s, HEIGHT: %s", psize$width, psize$height)

  })

  output$plot <- renderPlotly({
    psize <- calc_boxplot_size((input$facet != "none"))
    if (input$facet == "none") {
      p <- create_plot(dat, input$group, input$color, input$shape, input$plot.width, input$plot.height)
    } else {
      plots <- dat %>%
        group_by_(.dots = input$facet) %>%
        do(p = {
          create_plot(., input$group, input$color, input$shape, input$plot.width, input$plot.height)
        })
      p <- subplot(plots, shareX = TRUE, shareY = TRUE, nrows = 3, margin = 0.02)
    }
  })

}

shinyApp(ui, server)