R Shiny 应用具有 excel 类使用 rhandsontable 的功能
R Shiny app with excel like features using rhandsontable
我想创建一个应用,用户可以在其中查看基于数据 he/she select 的回归结果。我希望用户 select 两个数据范围(每个范围属于一列,就像您在 excel 中所做的那样),我的应用程序应该创建一个散点图并显示线性回归系数。我在数据 selection 部分遇到困难。此外,用户还应该可以选择更新数据,然后单击操作按钮来更新绘图和结果。到目前为止,我已经使用 . Also, I know I can get the selected data from doing something like this answer 实现了数据更新功能。但是,我需要两个 selection 范围而不是一个。我怎样才能建立这个?我从 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)
我想要的
- 用户select的预测范围:
- 用户select的响应范围:
- 用户点击操作按钮,应用程序显示散点图和回归系数。
此外,在我原来的应用程序中,用户从我使用 rhandsontable 显示的 excel 文件上传数据。 excel文件没有特定的格式(数据可以从文件的任何地方开始),从而增加了问题的复杂性。否则,我曾想过使用类似 colnames
的东西来生成两个 selectInput
下拉菜单和 nrow
来创建两个 sliderInput
来帮助用户 select 变量和行的范围。
自答
要生成 table editable 并访问所选值,rhandsontable()
中的 readOnly
和 selectCallback
参数应设置为 FALSE
和 TRUE
分别。我逐行遍历所选值,使用 input$table_select$data
获取属于所选列的值。 $data[i]
给出第 i
行中的所有元素,顺序为 [[1]][[1]]
、[[1]][[2]]
等等,其中 [[1]][[n]]
是第 n 列中的值。
我使用 eventReactive
将所选值分配给向量,然后可以绘制这些向量,用于拟合回归模型等。
- 用户选择他们想要指定为预测变量的值范围,然后单击 "Set Predictor" 操作按钮。
用户选择他们想要分配的值范围作为响应并单击 "Set Response" 操作按钮。情节等生成。
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)
我想创建一个应用,用户可以在其中查看基于数据 he/she select 的回归结果。我希望用户 select 两个数据范围(每个范围属于一列,就像您在 excel 中所做的那样),我的应用程序应该创建一个散点图并显示线性回归系数。我在数据 selection 部分遇到困难。此外,用户还应该可以选择更新数据,然后单击操作按钮来更新绘图和结果。到目前为止,我已经使用
可重现的最小应用程序:当前绘图显示 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)
我想要的
- 用户select的预测范围:
- 用户select的响应范围:
- 用户点击操作按钮,应用程序显示散点图和回归系数。
此外,在我原来的应用程序中,用户从我使用 rhandsontable 显示的 excel 文件上传数据。 excel文件没有特定的格式(数据可以从文件的任何地方开始),从而增加了问题的复杂性。否则,我曾想过使用类似 colnames
的东西来生成两个 selectInput
下拉菜单和 nrow
来创建两个 sliderInput
来帮助用户 select 变量和行的范围。
自答
要生成 table editable 并访问所选值,rhandsontable()
中的 readOnly
和 selectCallback
参数应设置为 FALSE
和 TRUE
分别。我逐行遍历所选值,使用 input$table_select$data
获取属于所选列的值。 $data[i]
给出第 i
行中的所有元素,顺序为 [[1]][[1]]
、[[1]][[2]]
等等,其中 [[1]][[n]]
是第 n 列中的值。
我使用 eventReactive
将所选值分配给向量,然后可以绘制这些向量,用于拟合回归模型等。
- 用户选择他们想要指定为预测变量的值范围,然后单击 "Set Predictor" 操作按钮。
用户选择他们想要分配的值范围作为响应并单击 "Set Response" 操作按钮。情节等生成。
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)