CODEWITHSUNDEEP
rshinyinteractivereactiverhandsontable
Bence Gaspar
Bence Gaspar

Reputation: 21

Interactive plot in Shiny with rhandsontable and reactiveValues

I would really appreciate some help with the following code:

library(shiny)
library(rhandsontable)
library(tidyr)

dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))

ui <- fluidPage(fluidRow(
  plotOutput(outputId = "plot", click="plot_click")),
  fluidRow(rHandsontableOutput("hot"))
  )

server <- function(input, output) {

  values <- reactiveValues(
    df=thresholds
  )

  observeEvent(input$plot_click, {
    values$trsh <- input$plot_click$x
  })

  observeEvent(input$hot_select, {
    values$trsh <- 1
  })

  output$hot = renderRHandsontable({
    rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
  })

  output$plot <- renderPlot({
  if (!is.null(input$hot_select)) {
    x_val = colnames(dataa)[input$hot_select$select$c]

    dens.plot <- ggplot(ldataa) +
      geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) + 
      geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
      geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
      geom_vline(xintercept = values$trsh) 

    dens.plot
  }
  })
}

shinyApp(ui = ui, server = server)

I have a plot and a handsontable object in the app. Clicking on whichever cell loads a corresponding plot, with a threshold value. Clicking the plot changes the position of one of the vertical lines.

I would like to get the x value from clicking the plot into the corresponding cell, and I would like to be able to set the position of the vertical line by typing in a value in the cell too.

I'm currently a bit stuck with how I should feed back values into a reactiveValue dataframe.

Many thanks in advance.

Upvotes: 1

Views: 1052

Answers (2)

Bence Gaspar
Bence Gaspar

Reputation: 21

This works as I imagined:

(The trick was to fill right columns of "df" with input$plot_click$x by indexing them with values$df[,input$hot_select$select$c].)

library(shiny)
library(rhandsontable)
library(tidyr)

dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))

ui <- fluidPage(fluidRow(
  plotOutput(outputId = "plot", click="plot_click")),
  fluidRow(rHandsontableOutput("hot"))
)

server <- function(input, output) {

  values <- reactiveValues(
    df=thresholds
  )

  observeEvent(input$plot_click, {
    values$df[,input$hot_select$select$c]  <- input$plot_click$x
  })

  output$hot = renderRHandsontable({
    rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
  })

  output$plot <- renderPlot({
    if (!is.null(input$hot_select)) {
      x_val = colnames(dataa)[input$hot_select$select$c]

      dens.plot <- ggplot(ldataa) +
        geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) + 
        geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
        geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
        geom_vline(xintercept = values$df[,input$hot_select$select$c]) 

      dens.plot
    }
  })
}

shinyApp(ui = ui, server = server)

Upvotes: 1

Lespied
Lespied

Reputation: 342

Update your reactiveValue dataframe from inside of an observeEvent, where you are watching for whichever event is useful, i.e. a click or something.

observeEvent(input$someInput{
    values$df <- SOMECODE})

Upvotes: 0

Related Questions