如何使用可拖动图中的高度值更新滑块输入的值？答案

【问题标题】：How to update value of sliderInput with height value from draggable plot?如何使用可拖动图中的高度值更新滑块输入的值？
【发布时间】：2021-08-27 17:06:49
【问题描述】：

我正在尝试获取可调整大小的绘图的值（使用 shinyjqui）并使用它来更新滑块输入。但是，我能够获得该值，但无法将其更新为滑块输入。我尝试使用观察和观察事件，但我被卡住了。

代码

library(shiny)
library(shinyjqui)
library(ggplot2)


ui <- fluidPage(
  tags$p("Height value from draggable plot"),
  verbatimTextOutput('size_obj'),
 # textInput("plotsize", label = "Plot height", value = "300"),
  sliderInput("plotsize", label = "Plot height", value = 300, min = 200, max = 500),
  tabsetPanel(
    id = 'tabs',
    tabPanel(
      title = 'ggplot',
      jqui_resizable(plotOutput('gg'))
    )
  )
)


server <- function(input, output, session) {
  output$gg <- renderPlot({
    ggplot(mtcars, aes(x = cyl, y = mpg)) + geom_point()
  }, 
  height=exprToFunction(as.numeric(input$plotsize))
  )
  
  # observe({
  #  size_obj()
  #   updateTextInput(session, "plotsize", value = size_obj())
  # })
  
  
  output$size_obj <- renderPrint({
    name <- paste0('gg', '_size')
    cat(#sprintf('%s(height: %s',
      #    input$tabs,
      input[[name]]$height)
    #    input[[name]]$width))
  })
  
}
shinyApp(ui, server)

如果从右下角拖动绘图，您会注意到 verbatimTextOutput 的变化。拖动事件结束后，它将变为默认值。我想扭转这一点，使滑块更改为 verbatimTextOutput 的值，以便当我拖动到不同的高度时，sliderInput 更新为新的高度值。

【问题讨论】：

标签： r shiny

【解决方案1】：

你想这样做：

library(shiny)
library(shinyjqui)
library(ggplot2)


ui <- fluidPage(
    tags$p("Height value from draggable plot"),
    verbatimTextOutput('size_obj'),
    # textInput("plotsize", label = "Plot height", value = "300"),
    sliderInput("plotsize", label = "Plot height", value = 300, min = 200, max = 500),
    tabsetPanel(
        id = 'tabs',
        tabPanel(
            title = 'ggplot',
            jqui_resizable(plotOutput('gg', height = "300px"))
        )
    )
)


server <- function(input, output, session) {
    name <- paste0('gg', '_size')
    height <- reactive({
        if(is.null(input[[name]]$height)) 300 
        else as.numeric( input[[name]]$height)
    })
    output$gg <- renderPlot({
        updateTextInput(session, "plotsize", value = height())
        ggplot(mtcars, aes(x = cyl, y = mpg)) + geom_point()
    }, 
    height=exprToFunction(height())
    )
    
    # observe({
    #  size_obj()
    #   updateTextInput(session, "plotsize", value = size_obj())
    # })
    
    
    output$size_obj <- renderPrint({
        
        cat(#sprintf('%s(height: %s',
            #    input$tabs,
            input[[name]]$height)
        #    input[[name]]$width))
    })
    
}
shinyApp(ui, server)

【讨论】：

有没有办法提高剧情的表现。太慢了。