Shiny中的反应性数据框/绘图

Question

我是 Shiny 的新手，我正在尝试在不同的上下文中从 Shiny webinars 复制 pick_pointsfunction。

我有以下来自 Twitter 的数据，其中基本上包含 ID、日期、推文类型和用户名。

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"))

我正在使用以下代码来创建一个闪亮的小工具：

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)
}

要运行它，只需编写temporal(tweets)，它应该会显示：

但是，我想使用一个复选框（它出现在图像的左上角），即checkboxInput("checkbox", label = "Type", value = FALSE)，这样推文的类型就可以包含在图中。这涉及到一个条件语句：

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)
    }

})

基本上，数据变量变为反应性的，这会影响反应性值和渲染图。我知道这不是正确的做法，但我不完全确定如何进行。

非常感谢任何帮助。

Answer 1

你必须像这样写你的反应：

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)
})

并像这样使用它：

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