R Shiny app with excel like features using rhandsontable

Question

I want to create an app where the user can see regression results based on the data he/she selects. I would like the user to select two ranges of data (each range belonging to one column, like you'd do in excel), and my app should create a scatter plot and show linear regression coefficients. I'm having difficulty with the data selection part. Additionally, the user should also have the option to update the data, and then click an action button to update the plot and the results. So far I have achieved data updating feature using this example. Also, I know I can get the selected data from doing something like this answer does. However, I need two selection ranges instead of one. How can I build this? I started with rhandsontable since it looked like the suitable library for this kind of a feature. I'm open to suggestions that can point me to other libraries that can help.

Reproducible Minimal App: The current plot shows col1 vs col2.

library(shiny)
library(rhandsontable)
library(plotly)

test_data <- structure(list(Id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14), 
               col1 = c(12.4, 12.5, 14.3, 14.8, 8.4, 8.1, 12, 12.4, 11.8, 11.9, 13.6, 13, 11, 11.2), 
               col2 = c(12.54, 11.96, 14.92, 14.11, 7.97, 7.91, 11.41, 12.18, 12.12, 12.53, 12.69, 13.18, 11.01, 11.24), 
               col3 = c(98, 98.7, 95, 95.2, 103.7, 104, 89.1, 89.5, 85.8, 85.3, 91, 90.3, 84.4, 83.6), 
               col4 = c(109.61, 109.9, 105.51, 103.35, 124.49, 120.42, 101, 101.7, 97.54, 90.45, 103.27, 97.37, 93.04, 80.54)), 
               row.names = c(NA, -14L), class = c("tbl_df", "tbl", "data.frame"))
# UI
ui <- tabsetPanel(
  tabPanel("Regression Analysis",
           fluidPage(
             sidebarPanel(actionButton("go", "Plot"),
                      hr(),
                      width = 3
             ),
             # Output
             mainPanel(
               br(),
               plotlyOutput("reg.plot"),
               hr(),
               rHandsontableOutput("data.as.hot"),
               hr() 
             )
           ))
)
# Server
server <- function(input, output, session){
  output$data.as.hot <- renderRHandsontable({
    rhandsontable(test_data)
  })

  mydata <- reactiveValues()

  observe({
    if(!is.null(input$data.as.hot))
      mydata$data <- hot_to_r(input$data.as.hot)
  })

  vals <- eventReactive(input$go, {
    return(mydata$data)
  })

  output$reg.plot <- renderPlotly({
    # Create plot
    plot_ly() %>%
      add_trace(data = vals(), x = vals()$col1, y = vals()$col2,
                type = 'scatter', mode = 'markers')
  })
}

# Create a Shiny app object
shinyApp(ui = ui, server = server)

What I want

The user selects range for predictor:

The user selects range for response:

The user clicks on an action button and the app displays a scatter plot and regression coefficients.

Also, in my original app the user uploads data from an excel file which I display using rhandsontable. The excel file does not have a specific format (data can start from anywhere in the file), thus increasing the complexity of the problem. Otherwise, I had thought of using something like colnames to generate two selectInput dropdowns and nrow to create two sliderInputs to help the user select the variables and range of rows.

score 2 · Accepted Answer · answered Nov 19 '18 at 18:45

Self-Answer

To make the table editable and to access selected values, readOnly and selectCallback parameters in rhandsontable() should be set to FALSE and TRUE respectively. I iterate over the selected values row wise, using input$table_select$data to get values belonging to the selected column. $data[i] gives all elements in the ith row in the order [[1]][[1]], [[1]][[2]] and so on where where [[1]][[n]] is the value in the nth column.

I use eventReactive to assign the selected values to vectors which can then be plotted, used for fitting a regression model etc.

The user selects the range of values they want to assign as predictor and clicks on the "Set Predictor" action button.

The user selects the range of values they want to assign as response and clicks on the "Set Response" action button. The plot etc is generated.

library(shiny)
library(rhandsontable)
library(plotly)

test_data <- structure(list(Id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14), 
           col1 = c(12.4, 12.5, 14.3, 14.8, 8.4, 8.1, 12, 12.4, 11.8, 11.9, 13.6, 13, 11, 11.2), 
           col2 = c(12.54, 11.96, 14.92, 14.11, 7.97, 7.91, 11.41, 12.18, 12.12, 12.53, 12.69, 13.18, 11.01, 11.24), 
           col3 = c(98, 98.7, 95, 95.2, 103.7, 104, 89.1, 89.5, 85.8, 85.3, 91, 90.3, 84.4, 83.6), 
           col4 = c(109.61, 109.9, 105.51, 103.35, 124.49, 120.42, 101, 101.7, 97.54, 90.45, 103.27, 97.37, 93.04, 80.54)), 
               row.names = c(NA, -14L), class = c("tbl_df", "tbl", "data.frame"))

# UI
ui <- tabsetPanel(
  tabPanel("Regression Analysis",
            fluidPage(
             sidebarPanel(
                          actionButton("button.fv", "Set Predictor"),
                          hr(),
                          actionButton("button.sv", "Set Response"),
                          width = 3
             ),
             # Output
             mainPanel(
               br(),
               plotlyOutput("reg.plot"),
               hr(),
               rHandsontableOutput("hot"),
               hr() 
             )
           ))
)

# Server
server <- function(input, output, session){
 output$hot <- renderRHandsontable({
  rhandsontable(test_data, readOnly = F, selectCallback = TRUE)
})

# Create vector of selected values
first.vector <- eventReactive(
  input$button.fv, {
    req(input$hot_select)
    start.row <- input$hot_select$select$r
    end.row <- input$hot_select$select$r2
    selected.col <- input$hot_select$select$c

    selected.vector <- list()

  for (i in start.row:end.row){
    value <- input$hot_select$data[i][[1]][[selected.col]]
    selected.vector[i] <- value
  }
  return(unlist(selected.vector))
}
)

second.vector <- eventReactive(
input$button.sv, {
  req(input$hot_select)
  start.row <- input$hot_select$select$r
  end.row <- input$hot_select$select$r2
  selected.col <- input$hot_select$select$c

  selected.vector <- list()

  for (i in start.row:end.row){
    value <- input$hot_select$data[i][[1]][[selected.col]]
    selected.vector[i] <- value
  }
  return(unlist(selected.vector))
}
)

output$reg.plot <- renderPlotly({
req(input$hot_select)
validate(
  need(length(first.vector()) == length(second.vector()), "Selected ranges should be equal in length")
)
plot_ly(x = first.vector(), y = second.vector(), type = 'scatter', mode = 'markers')
})
}

# Create a Shiny app object
shinyApp(ui = ui, server = server)

R Shiny app with excel like features using rhandsontable

1 Answers1