如何在 Shiny 应用程序中汇总来自渲染函数外部的反应数据？
How can I summarize reactive data from outside a render function in a Shiny app?
对于这个特别闪亮的例子，我试图应用一个圆形模型并在 ggplot 和摘要中显示和总结它 table。在尝试添加响应式 'brushplot' 功能之前，这很简单。每个数据点代表一个日期，选择图的点是能够丢弃不需要的日期。据我所知，这需要过滤和模型拟合在 renderPlot 内，这会导致尝试调用过滤后的数据和循环的并发症（无法找到 data/model）模型在另一个反应函数内的函数 and/or 之外的统计输出。这会产生 Error: object 'k_circ.lm' not found 所以我的问题是：
- 如何从
renderPlot 函数中读取过滤后的数据
到 summarytable 矩阵？
- 我怎样才能类似地添加来自
k_circ.lm 的拟合模型值和残差？
- 是否有更好或更简单的方法来安排应用程序来避免这种情况？
备选代码行已被注释掉以用于工作摘要（如果格式不正确）table。
library(dplyr) # For data manipulation
library(ggplot2) # For drawing plots
library(shiny) # For running the app
library(plotly) # For data manipulation
library(circular) # For Circular regressions
library(gridExtra)
# Define UI ----
ui <- fluidPage(
# App title ----
titlePanel("Circular Brushplot Demo"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
),
# Main panel for displaying outputs ----
mainPanel(
#reactive plot output with point and 'brush' selection
fluidRow(plotOutput("k", height = 400,
click = "k_click",
brush = brushOpts(
id = "k_brush" ))),
plotOutput("s", height = 400)
)
)
)
# Define server logic
server <- function(input, output) {
psideg <- c(356,97,211,232,343,292,157,302,335,302,324,85,324,340,157,238,254,146,232,122,329)
thetadeg <- c(119,162,221,259,270,29,97,292,40,313,94,45,47,108,221,270,119,248,270,45,23)
## Data in radians then to "circular format"
psirad <- psideg*2*pi/360
thetarad <- thetadeg*2*pi/360
cpsirad <- circular(psirad)
cthetarad <- circular(thetarad)
cdat <- data.frame(cpsirad, cthetarad)
###### reactive brush plot ########
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(cdat)))
output$k <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- cdat[ vals$keeprows, , drop = FALSE]
exclude <- cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
k_circlm
ggplot(keep, aes(cthetarad, cpsirad)) +
geom_point(aes(cthetarad, cpsirad, colour = keep$Vmag, size = 5))+
scale_colour_gradient(low ="blue", high = "red")+
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 13, size = 5, fill = NA, color = "black", alpha = 0.25) +
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 1,
label = paste0("p value 1 = ", round(k_circlm$p.values[1], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 2.5,
label = paste0("p value 2 = ", round(k_circlm$p.values[2], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 4,
label = paste0("rho = ", round(k_circlm$rho, 2)), size = 7)+
xlab("Lighthouse Direction (radians)")+ ylab("ADCP site direction (radians)")+
theme(axis.title.x = element_text(size = 20), axis.title.y = element_text(size = 20))
})
# Toggle points that are clicked
observeEvent(input$k_click, {
res <- nearPoints(cdat, input$k_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(cdat, input$k_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(cdat))})
output$s <- renderPlot({
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
colnames(summarytable) <- c( "Psi_dir", "Theta_dir", "Fitted_values", "Residuals")
# Un-comment lines below to read from non-reactive data for working summary table
#summarytable$Psi_dir <- round(cdat$cpsirad, 2)
#summarytable$Theta_dir <- round(cdat$cthetarad, 2)
# attempting to pull from circlm within render plot
# comment out for summarytable to work
summarytable$Psi_dir <- round(keep$cpsirad, 2)
summarytable$Theta_dir <- round(keep$cthetarad, 2)
summarytable$Fitted_values <- round(k_circ.lm$fitted)
summarytable$Residuals <- round(k_circ.lm$residuals)
# outputing table with minimal formatting
summarytable <-na.omit(summarytable)
t <- tableGrob(summarytable)
Q <- grid.arrange(t, nrow = 1)
Q
}
)
}
shinyApp(ui = ui, server = server)
这里有一些想法 - 但有多种方法可以处理此问题，您可能希望在进一步处理此问题后进一步重构 server 函数。
首先，您可能需要一个 reactive 表达式来根据 vals$keeprows 更新您的模型，因为它会随着您的点击而变化。然后，您可以从绘图和数据 table.
中访问此表达式的模型结果
这是一个例子：
fit_model <- reactive({
## Keep and exclude based on reactive value keeprows
keep = cdat[ vals$keeprows, , drop = FALSE]
exclude = cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
## Returns list of items including what to keep, exclude, and model
list(k_circlm = k_circlm, keep = keep, exclude = exclude)
})
它将return一个list，你可以从绘图中访问：
output$k <- renderPlot({
exclude <- fit_model()[["exclude"]]
keep <- fit_model()[["keep"]]
k_circlm <- fit_model()[["k_circlm"]]
ggplot(keep, aes(cthetarad, cpsirad)) +
...
并且可以从您的 table 访问相同的内容（尽管您有 renderPlot？）：
output$s <- renderPlot({
keep = fit_model()[["keep"]]
k_circ.lm <- fit_model()[["k_circlm"]]
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
...
请注意，因为 table 长度随着保留的行而变化，您可能想像我上面那样使用 nrow(keep)，而不是 nrow(cdat)，除非我弄错了。
我还加载了 gridExtra 库来测试它。
我怀疑您还可以考虑其他一些改进，但我认为这可能会帮助您首先进入功能状态。
对于这个特别闪亮的例子，我试图应用一个圆形模型并在 ggplot 和摘要中显示和总结它 table。在尝试添加响应式 'brushplot' 功能之前，这很简单。每个数据点代表一个日期，选择图的点是能够丢弃不需要的日期。据我所知，这需要过滤和模型拟合在 renderPlot 内，这会导致尝试调用过滤后的数据和循环的并发症（无法找到 data/model）模型在另一个反应函数内的函数 and/or 之外的统计输出。这会产生 Error: object 'k_circ.lm' not found 所以我的问题是：
- 如何从
renderPlot函数中读取过滤后的数据 到summarytable矩阵？ - 我怎样才能类似地添加来自
k_circ.lm的拟合模型值和残差？ - 是否有更好或更简单的方法来安排应用程序来避免这种情况？
备选代码行已被注释掉以用于工作摘要（如果格式不正确）table。
library(dplyr) # For data manipulation
library(ggplot2) # For drawing plots
library(shiny) # For running the app
library(plotly) # For data manipulation
library(circular) # For Circular regressions
library(gridExtra)
# Define UI ----
ui <- fluidPage(
# App title ----
titlePanel("Circular Brushplot Demo"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
actionButton("exclude_toggle", "Toggle points"),
actionButton("exclude_reset", "Reset")
),
# Main panel for displaying outputs ----
mainPanel(
#reactive plot output with point and 'brush' selection
fluidRow(plotOutput("k", height = 400,
click = "k_click",
brush = brushOpts(
id = "k_brush" ))),
plotOutput("s", height = 400)
)
)
)
# Define server logic
server <- function(input, output) {
psideg <- c(356,97,211,232,343,292,157,302,335,302,324,85,324,340,157,238,254,146,232,122,329)
thetadeg <- c(119,162,221,259,270,29,97,292,40,313,94,45,47,108,221,270,119,248,270,45,23)
## Data in radians then to "circular format"
psirad <- psideg*2*pi/360
thetarad <- thetadeg*2*pi/360
cpsirad <- circular(psirad)
cthetarad <- circular(thetarad)
cdat <- data.frame(cpsirad, cthetarad)
###### reactive brush plot ########
# For storing which rows have been excluded
vals <- reactiveValues(
keeprows = rep(TRUE, nrow(cdat)))
output$k <- renderPlot({
# Plot the kept and excluded points as two separate data sets
keep <- cdat[ vals$keeprows, , drop = FALSE]
exclude <- cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
k_circlm
ggplot(keep, aes(cthetarad, cpsirad)) +
geom_point(aes(cthetarad, cpsirad, colour = keep$Vmag, size = 5))+
scale_colour_gradient(low ="blue", high = "red")+
geom_smooth(method = lm, fullrange = TRUE, color = "black") +
geom_point(data = exclude, shape = 13, size = 5, fill = NA, color = "black", alpha = 0.25) +
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 1,
label = paste0("p value 1 = ", round(k_circlm$p.values[1], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 2.5,
label = paste0("p value 2 = ", round(k_circlm$p.values[2], 2)), size = 7)+
annotate("text", x = min(keep$cthetarad), y = Inf, hjust = .1, vjust = 4,
label = paste0("rho = ", round(k_circlm$rho, 2)), size = 7)+
xlab("Lighthouse Direction (radians)")+ ylab("ADCP site direction (radians)")+
theme(axis.title.x = element_text(size = 20), axis.title.y = element_text(size = 20))
})
# Toggle points that are clicked
observeEvent(input$k_click, {
res <- nearPoints(cdat, input$k_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Toggle points that are brushed, when button is clicked
observeEvent(input$exclude_toggle, {
res <- brushedPoints(cdat, input$k_brush, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)})
# Reset all points
observeEvent(input$exclude_reset, {
vals$keeprows <- rep(TRUE, nrow(cdat))})
output$s <- renderPlot({
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
colnames(summarytable) <- c( "Psi_dir", "Theta_dir", "Fitted_values", "Residuals")
# Un-comment lines below to read from non-reactive data for working summary table
#summarytable$Psi_dir <- round(cdat$cpsirad, 2)
#summarytable$Theta_dir <- round(cdat$cthetarad, 2)
# attempting to pull from circlm within render plot
# comment out for summarytable to work
summarytable$Psi_dir <- round(keep$cpsirad, 2)
summarytable$Theta_dir <- round(keep$cthetarad, 2)
summarytable$Fitted_values <- round(k_circ.lm$fitted)
summarytable$Residuals <- round(k_circ.lm$residuals)
# outputing table with minimal formatting
summarytable <-na.omit(summarytable)
t <- tableGrob(summarytable)
Q <- grid.arrange(t, nrow = 1)
Q
}
)
}
shinyApp(ui = ui, server = server)
这里有一些想法 - 但有多种方法可以处理此问题，您可能希望在进一步处理此问题后进一步重构 server 函数。
首先，您可能需要一个 reactive 表达式来根据 vals$keeprows 更新您的模型，因为它会随着您的点击而变化。然后，您可以从绘图和数据 table.
这是一个例子：
fit_model <- reactive({
## Keep and exclude based on reactive value keeprows
keep = cdat[ vals$keeprows, , drop = FALSE]
exclude = cdat[!vals$keeprows, , drop = FALSE]
## Fits circular model specifically for 'keeprows' of selected data
k_circlm <- lm.circular(type = "c-c", y = keep$cthetarad, x = keep$cpsirad, order = 1)
## Returns list of items including what to keep, exclude, and model
list(k_circlm = k_circlm, keep = keep, exclude = exclude)
})
它将return一个list，你可以从绘图中访问：
output$k <- renderPlot({
exclude <- fit_model()[["exclude"]]
keep <- fit_model()[["keep"]]
k_circlm <- fit_model()[["k_circlm"]]
ggplot(keep, aes(cthetarad, cpsirad)) +
...
并且可以从您的 table 访问相同的内容（尽管您有 renderPlot？）：
output$s <- renderPlot({
keep = fit_model()[["keep"]]
k_circ.lm <- fit_model()[["k_circlm"]]
# Create Summary table
summarytable <- data.frame(matrix(ncol = 4, nrow = nrow(keep)))
...
请注意，因为 table 长度随着保留的行而变化，您可能想像我上面那样使用 nrow(keep)，而不是 nrow(cdat)，除非我弄错了。
我还加载了 gridExtra 库来测试它。
我怀疑您还可以考虑其他一些改进，但我认为这可能会帮助您首先进入功能状态。