How hover plot inputs over the plot itself in R Shiny?

Question

In running the code at the bottom and as shown in this image, the four plot slider inputs rigidly appear at the top-left of the screen. Is there a way to make these four inputs instead hover over the plot, with the ability to drag/move, or hide, those inputs out of the way if they block the view of the plot? Of course they'd have to be shrunk etc. but that's OK. I'm open to any ideas! Trying to economize the visual impact of the presentation.

Code:

library(plotly)
library(purrr)
library(shiny)

ui <- fluidPage(
  fluidRow(
    column(6,
      sliderInput('periods','Nbr of periods:',min=0,max=24,value=12),
      sliderInput('start','Start value:',min=0,max=1,value=0.15),
      sliderInput('end','End value:',min=0,max=1,value=0.70),
      sliderInput('exponential','Exponential:',min=-100,max=100,value=50)
      ),
    column(3,tableOutput('data'))
    ),
  fluidRow(plotlyOutput('plot'))
)

server <- function(input, output, session) {
  x <- reactive(data()$Periods)
  y <- reactive(data()$ScaledLog)
  
  data <- reactive({
    data.frame(
      Periods = c(0:input$periods),
      ScaledLog = c(
        (input$start-input$end) *
        (exp(-input$exponential/100*(0:input$periods))-
        exp(-input$exponential/100*input$periods)*(0:input$periods)/input$periods)) +
        input$end
    )
  })
  
  output$data <- renderTable(data())
  
  output$plot <- renderPlotly(plot_ly(data(),x = ~x(), y = ~y(), type = 'scatter', mode = 'lines') %>%
    layout(title = 'Scaled Logarithmic Curve', 
           plot_bgcolor = "#e5ecf6", 
           xaxis = list(title = 'Period'), 
           yaxis = list(title = 'Scaled Logarithmic Value')
           ) %>%
    config(edits = list(shapePosition = TRUE))  
  )
}

shinyApp(ui,server)

Answer 1

Please check shinyjqui::jqui_draggable, which we can combine with shinyWidgets::dropdown.

However, I'm not sure yet, why the dropdown itself is not draggable.

In addition we need to make sure to set a proper z-index for the column:

library(plotly)
library(purrr)
library(shiny)
library(shinyjqui)
library(shinyWidgets)
library(DT)

ui <- fluidPage(
  fluidRow(
    jqui_draggable(column(6, dropdown(sliderInput('periods','Nbr of periods:',min=0,max=24,value=12),
                                      sliderInput('start','Start value:',min=0,max=1,value=0.15),
                                      sliderInput('end','End value:',min=0,max=1,value=0.70),
                                      sliderInput('exponential','Exponential:',min=-100,max=100,value=50)),
                          style = "z-index:1; position: fixed; top: 5vh; left: 5vw;"
    ))
  ),
  fluidRow(plotlyOutput('plot')),
  fluidRow(column(12, DTOutput('data')))
)

server <- function(input, output, session) {
  x <- reactive(data()$Periods)
  y <- reactive(data()$ScaledLog)
  
  data <- reactive({
    data.frame(
      Periods = c(0:input$periods),
      ScaledLog = c(
        (input$start-input$end) *
          (exp(-input$exponential/100*(0:input$periods))-
             exp(-input$exponential/100*input$periods)*(0:input$periods)/input$periods)) +
        input$end
    )
  })
  
  output$data <- renderDT({
    datatable(
      data(),
      filter = 'top',
      options = list(pageLength = 10, autoWidth = FALSE),
      rownames = FALSE
    )
  }, server = FALSE)
  
  output$plot <- renderPlotly({plot_ly(data(),x = ~x(), y = ~y(), type = 'scatter', mode = 'lines') %>%
      layout(title = 'Scaled Logarithmic Curve', 
             plot_bgcolor = "#e5ecf6", 
             xaxis = list(title = 'Period'), 
             yaxis = list(title = 'Scaled Logarithmic Value')
      ) %>%
      config(edits = list(shapePosition = TRUE))  
  })
}

shinyApp(ui,server)