R Блестящее приложение с отличными функциями, используя Rhandsontable - PullRequest
Новая
       10

R Блестящее приложение с отличными функциями, используя Rhandsontable

0 голосов
/ 09 ноября 2018

Я хочу создать приложение, в котором пользователь может видеть результаты регрессии на основе данных, которые он / она выбирает. Я хотел бы, чтобы пользователь выбрал два диапазона данных (каждый диапазон принадлежит одному столбцу, как вы сделали бы в Excel), и мое приложение должно создать точечный график и показать коэффициенты линейной регрессии. У меня трудности с выбором данных. Кроме того, пользователь также должен иметь возможность обновить данные, а затем нажать кнопку действия, чтобы обновить график и результаты. До сих пор я достиг функции обновления данных, используя этот пример . Кроме того, я знаю, что могу получить выбранные данные, выполнив что-то вроде этого ответа . Однако мне нужно два диапазона выбора вместо одного. Как я могу построить это? Я начал с rhandsontable, так как он выглядел как подходящая библиотека для такого рода функций. Я открыт для предложений, которые могут указать мне на другие библиотеки, которые могут помочь.

Воспроизводимое минимальное приложение : текущий график показывает col1 против 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)

Что я хочу

  1. Пользователь выбирает диапазон для предиктора:

enter image description here

  1. Пользователь выбирает диапазон для ответа:

enter image description here

  1. Пользователь нажимает кнопку действия, и приложение отображает график рассеяния и коэффициенты регрессии.

Кроме того, в моем исходном приложении пользователь загружает данные из файла Excel, который я отображаю с помощью rhandsontable. Файл Excel не имеет определенного формата (данные могут начинаться с любого места в файле), что увеличивает сложность проблемы. В противном случае я думал о том, чтобы использовать что-то вроде colnames для генерации двух selectInput выпадающих меню и nrow для создания двух sliderInput с, чтобы помочь пользователю выбрать переменные и диапазон строк.

1 Ответ

0 голосов
/ 19 ноября 2018

Self-ответ

Чтобы сделать таблицу редактируемой и получить доступ к выбранным значениям, параметры readOnly и selectCallback в rhandsontable() должны быть установлены на FALSE и TRUE соответственно. Я перебираю выбранные значения по строкам, используя input$table_select$data, чтобы получить значения, принадлежащие выбранному столбцу. $data[i] дает все элементы в i-й строке в порядке [[1]][[1]], [[1]][[2]] и т. Д., Где [[1]][[n]] - это значение в n-м столбце.

Я использую eventReactive, чтобы назначить выбранные значения векторам, которые затем можно построить, использовать для подгонки регрессионной модели и т. Д.

  1. Пользователь выбирает диапазон значений, которые он хочет назначить в качестве предиктора, и нажимает кнопку действия «Установить предиктор».

  2. Пользователь выбирает диапазон значений, которые он хочет назначить в качестве ответа, и нажимает кнопку действия «Установить ответ». Сюжет и т. Д. Генерируется. 

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