如何使用可拖动绘图中的高度值更新sliderInput的值？

Question

我正在尝试获取一个可调整大小的绘图的值(使用shinyjqui)，并使用它来更新sliderInput。但是，我可以获取该值，但无法将其更新为sliderInput。我试着使用observe和observeEvent，但是我卡住了。

代码

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将更新为新的高度值。

​

​

Answer 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)