我是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。我知道这不是正确的观察员,但我不完全确定如何继续。
非常感谢任何帮助。
答案 0 :(得分: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]