R 如何在一个闪亮的应用程序中汇总来自渲染函数外部的反应数据?

R 如何在一个闪亮的应用程序中汇总来自渲染函数外部的反应数据?,r,ggplot2,shiny,non-linear-regression,shinyapps,R,Ggplot2,Shiny,Non Linear Regression,Shinyapps,对于这个特别的闪亮的例子,我尝试应用一个循环模型,并在ggplot和汇总表中显示和汇总它。在尝试添加反应式“刷图”功能之前,这是很简单的。每个数据点代表一个日期,选择图的点是能够丢弃不需要的日期。据我所知,这要求过滤和模型拟合在渲染图中,这会导致复杂(无法找到数据/模型)尝试调用过滤后的数据和循环模型的统计输出(在函数外部和/或在另一个反应函数内)。这会产生错误:找不到对象“k_circ.lm”,因此我的问题是: 如何从renderPlot函数中读取过滤后的数据 到汇总表矩阵 我如何同样地添加k

对于这个特别的闪亮的例子,我尝试应用一个循环模型,并在ggplot和汇总表中显示和汇总它。在尝试添加反应式“刷图”功能之前,这是很简单的。每个数据点代表一个日期,选择图的点是能够丢弃不需要的日期。据我所知,这要求过滤和模型拟合在
渲染图
中,这会导致复杂(无法找到数据/模型)尝试调用过滤后的数据和循环模型的统计输出(在函数外部和/或在另一个反应函数内)。这会产生
错误:找不到对象“k_circ.lm”
,因此我的问题是:

  • 如何从
    renderPlot
    函数中读取过滤后的数据 到
    汇总表
    矩阵
  • 我如何同样地添加
    k_circ.lm
    中的拟合模型值和残差
  • 有没有更好或更简单的方法来安排应用程序来避免这种情况
  • 工作(如果格式不好)汇总表的可选代码行被注释掉

    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)
    
    
    library(dplyr)#用于数据操作
    图库(ggplot2)#用于绘制绘图
    库(闪亮)#用于运行应用程序
    库(plotly)#用于数据操作
    图书馆(循环)#用于循环回归
    图书馆(gridExtra)
    #定义用户界面----
    
    ui这里有一些想法-但是有多种方法来处理这个问题,在进一步处理这个问题之后,您可能希望重新构造
    服务器的功能

    首先,您可能需要一个
    reactive
    表达式,该表达式将根据
    vals$keeprows
    更新您的模型,因为它会随着您的单击而更改。然后,您可以从绘图和数据表访问此表达式的模型结果

    以下是一个例子:

      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)
      })
    
    并且可以从表中访问相同的内容(尽管您有as
    renderPlot
    ?):


    output$s谢谢您的帮助,功能不错!您的回答也是正确的,因为我想使用
    nrow(keep)
    ,所以我会相应地更改它。
    output$s
    renderPlot
    可能不是最好的方法,但与我试图为其构建可复制演示的大型应用程序最为相似。。。您如何建议以不同的方式进行渲染?
      output$k <- renderPlot({
    
        exclude <- fit_model()[["exclude"]]
        keep <- fit_model()[["keep"]]
        k_circlm <- fit_model()[["k_circlm"]]
    
        ggplot(keep, aes(cthetarad, cpsirad)) + 
        ...
    
      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)))
        ...