Как я могу суммировать реактивные данные извне функции рендеринга в приложении Shiny?

Question

Для этого конкретного блестящего примера я пытаюсь применить круговую модель, отобразить и суммировать ее в ggplot и сводной таблице. Это просто до тех пор, пока вы не попытаетесь добавить реактивные возможности «мазка». Каждая из точек данных представляет дату, а точка выборочного графика должна быть в состоянии отбрасывать нежелательные даты. Насколько я понял, для этого требуется, чтобы фильтрация и подгонка модели находились в пределах renderPlot, что приводит к сложностям (неспособность найти данные / модель) при попытке вызвать отфильтрованные данные и статистические результаты циклической модели вне функция и / или внутри другой реактивной функции. Это приводит к Error: object 'k_circ.lm' not found Итак, мои вопросы:

1. Как я могу прочитать отфильтрованные данные из функции renderPlot в матрицу summarytable?
2. Как я мог бы аналогичным образом добавить подогнанные значения модели и остатки от k_circ.lm?
3. Есть ли лучший или более простой способ упорядочить приложение, чтобы избежать этого?

Альтернативные строки кода закомментированы для работы (если плохо отформатирован) Сводная таблица.

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)

Answer 1

Вот несколько идей - но есть несколько подходов к этому, и вы, вероятно, захотите немного реструктурировать свою функцию server после дальнейшей работы с ней.

Во-первых, вы, вероятно, хотите 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)
  })

Он вернет list, к которому вы можете получить доступ из графика:

  output$k <- renderPlot({

    exclude <- fit_model()[["exclude"]]
    keep <- fit_model()[["keep"]]
    k_circlm <- fit_model()[["k_circlm"]]

    ggplot(keep, aes(cthetarad, cpsirad)) + 
    ...

И можете получить к нему доступ из вашей таблицы (хотя у вас есть как 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)))
    ...

Обратите внимание, что, поскольку длина таблицы изменяется со строками сохранено, вы можете использовать nrow(keep), как у меня выше, а не nrow(cdat), если я не ошибаюсь.

Я также загрузил библиотеку gridExtra для проверки этого.

I подозреваю, что есть ряд других улучшений, которые вы могли бы рассмотреть, но подумал, что это может помочь вам сначала перейти в рабочее состояние.