Reactive Data Frame / Plot in Shiny

Question

I'm new in Shiny and I'm trying to replicate the pick_pointsfunction from the Shiny webinars in a different context.

I've the following data from Twitter which basically contains an ID, date, type of tweet and username.

tweets <- structure(list(id_str = c(841706677183344640, 841706613656416256, 
841706515484573696, 841706506961715200, 841706475504386048, 841683777638301696, 
841683745971277824, 841683738840948736, 841683727851880448, 841683686290530304, 
841683658146693120, 841664976628662272, 841664957527744512, 841664934442352640, 
841664815798067200, 841664811754745856, 841664757287538688), 
    time = structure(c(1489510800, 1489510800, 1489510800, 1489510800, 
    1489510800, 1489507200, 1489507200, 1489507200, 1489507200, 
    1489507200, 1489507200, 1489500000, 1489500000, 1489500000, 
    1489500000, 1489500000, 1489500000), class = c("POSIXct", 
    "POSIXt"), tzone = "UTC"), type = structure(c(1L, 2L, 2L, 
    1L, 3L, 3L, 2L, 3L, 1L, 1L, 1L, 3L, 1L, 1L, 1L, 2L, 2L), .Label = c("retweet", 
    "original", "@mention"), class = "factor"), from_user = c("fixit_fitz", 
    "BeingFarhad", "TrumptheClown1", "Book_Blackparad", "Hofmockel", 
    "EnergyInnovLLC", "Sarah_Lorya", "momentinthepark", "MommaBjornen68", 
    "arevalor514", "ize0", "EPWDems", "SoniaKris13", "SaleemulHuq", 
    "manojkumar127in", "maritvp", "channingdutton")), .Names = c("id_str", 
"time", "type", "from_user"), row.names = c(NA, -17L), class = c("tbl_df", 
"tbl", "data.frame"))

I'm using the following code to create a Shiny gadget:

library(shiny)
library(miniUI)
library(tidyverse)

temporal <- function(tweets) {
    ui <- miniPage(
        gadgetTitleBar("Temporal Analysis"),
        miniTabstripPanel(
            miniTabPanel("Visualize", icon = icon("area-chart"),
                         miniContentPanel(
                             checkboxInput("checkbox", label = "Type", value = FALSE),
                             plotOutput("plot1", height = "80%", brush = 'brush')
                         ),
                         miniButtonBlock(
                            actionButton("add", "", icon = icon("thumbs-up")),
                            actionButton("sub", "", icon = icon("thumbs-down")),
                            actionButton("none", "" , icon = icon("ban")),
                            actionButton("all", "", icon = icon("refresh"))
                         )
            ),
            miniTabPanel("Data", icon = icon("table"),
                         miniContentPanel(
                             DT::dataTableOutput("table")
                         )
            )
        )
    )

    server <- function(input, output) {
        # Cleaning
        data <- tweets %>% select(id_str, time) %>%
            group_by(time) %>%
            summarise(n = n())

        # For storing selected points
        vals <- reactiveValues(keep = rep(TRUE, nrow(data)))

        output$plot1 <- renderPlot({
            # Plot the kept and excluded points as two separate data sets
            keep    <- data[ vals$keep, , drop = FALSE]
            exclude <- data[!vals$keep, , drop = FALSE]

            ggplot(keep, aes(time, n)) +
                geom_point(data = exclude, color = "grey80") +
                geom_point(size = 2) + 
                geom_line(data = data)
        })

        # Update selected points
        selected <- reactive({
            brushedPoints(data, input$brush, allRows = TRUE)$selected_
        })
        observeEvent(input$add,  vals$keep <- vals$keep | selected())
        observeEvent(input$sub,  vals$keep <- vals$keep & !selected())
        observeEvent(input$all,  vals$keep <- rep(TRUE, nrow(data)))
        observeEvent(input$none, vals$keep <- rep(FALSE, nrow(data)))

        # Show table
        output$table <- DT::renderDataTable({
            dates <- data$time[vals$keep]
            tweets %>% filter(time %in% dates)
        })

        observeEvent(input$done, {
            dates <- data$time[vals$keep]
            stopApp(tweets %>% filter(time %in% dates))
        })
        observeEvent(input$cancel, {
            stopApp(NULL)
        })



    }

    runGadget(ui, server)
}

To run it simply write temporal(tweets) and it should display this:

However, I want to use a checkbox (it appears in the image top-left corner), i.e. checkboxInput("checkbox", label = "Type", value = FALSE), such that the type of tweet can be included in the plot. This involves a conditional statement:

if (input$checkbox) {
    data <- tweets %>% select(id_str, time) %>%
        group_by(time) %>%
        summarise(n = n())
} else {
    data <- tweets %>% select(id_str, time, type) %>%
        group_by(time, type) %>%
        summarise(n = n())
}


# For storing selected points
vals <- reactiveValues(keep = rep(TRUE, nrow(data)))

output$plot1 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- data[ vals$keep, , drop = FALSE]
    exclude <- data[!vals$keep, , drop = FALSE]
    if (input$checkbox) {
        ggplot(keep, aes(time, n)) +
            geom_point(data = exclude, color = "grey80") +
            geom_point(size = 2) + 
            geom_line(data = data)
    } else {
        ggplot(keep, aes(time, n)) +
            geom_point(data = exclude, color = "grey80") +
            geom_point(size = 2) + 
            geom_line(data = data, col = type)
    }

})

Basically, the data variable becomes reactive and this influences the reactiveValues and the renderPlot. I know this is not the correct wat to do it, but I'm not completely sure how to proceed.

Any help is greatly appreciated.

HubertL HubertL · Accepted Answer · 2017-03-16T01:18:42

You have to write your reactive like this:

data <- reactive({
    if (input$checkbox) {
        data <- tweets %>% select(id_str, time) %>%
            group_by(time) %>%
            summarise(n = n())
    } else {
       data <- tweets %>% select(id_str, time, type) %>%
            group_by(time, type) %>%
            summarise(n = n())
    }
    vals$keep <- rep(TRUE, nrow(data))
    return(data)
})

and use it like this:

keep    <- data()[ vals$keep, , drop = FALSE]
exclude <- data()[!vals$keep, , drop = FALSE]
...
brushedPoints(data(), input$brush, allRows = TRUE)$selected_
...
dates <- data()$time[vals$keep]

Reactive Data Frame / Plot in Shiny

1 Answers