Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201839

How can I summarize reactive data from outside a render function in a Shiny app?

$
0
0

For this particular shiny example I am trying to apply a circular model and display and summarize it within the ggplot and a summary table. This is straightforward up until trying to add in reactive 'brushplot' capabilities. Each of the data points represent a date and the point of the selective graph is to be able to discard undesirable dates. As far as I've figured out, this requires the filtering and model fitting to be within a renderPlot which then leads to complications (unable to find the data/model) trying to call the filtered data and the circular model's statistical outputs outside the function and/or within another reactive function. This yields the Error: object 'k_circ.lm' not found So my questions are:

  1. How can I read the filtered data from the renderPlot function to the summarytable matrix?
  2. How could I similarly add the fitted model values and residuals from k_circ.lm?
  3. Is there a better or simpler way to arrange app to avoid this?

Alternatative code lines are commented out for a working (if poorly formatted) summary 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

# 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(cdat)))
    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)


Viewing all articles
Browse latest Browse all 201839

Trending Articles