How to update value of sliderInput with height value from draggable plot? - r

Question

I'm trying to get the value of a resizable plot (using shinyjqui) and use it to update the sliderInput. I am able to get the value however, but I'm unable to update it to the sliderInput. I tried using observe and observeEvent but I'm stuck.
Code
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)
If you drag the plot from the bottom right, you will notice the verbatimTextOutput change. Once the drag event is over, it goes to the default value. I would like to reverse this and make it so that the slider changes to the value of the verbatimTextOutput so that when I drag to a different height, the sliderInput updates to the new height value.

Answer 1

You want to do this:
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)