無效數據幀/閃爍

Question

我是Shiny的新手，我試圖在不同的上下文中複製Shiny webinars中的pick_points函數。

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

}) 

基本上，數據變量變爲反應性的並且這種影響reactiveValues和renderPlot。我知道這不是正確的掃描儀，但我不完全確定如何進行。

任何幫助，非常感謝。

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]