我正在设计一个用于查看Twitter数据的模块化闪亮应用程序。我将下面的示例指向一些在线王牌推文(trump_tweets_df.rda),其中添加了另外一列(在下文中称为“预处理”。
我想用在反应性数据集twt_twit_rtwt中找到的主题标签填充selectizeInput“ updt_hshtgs”,该主题标签在开始日期和结束日期以及是否包含转推中进行过滤。我希望在updt_hshtgs中填充“ newvals”,这是一个反应性的数据框:具有hastag单词的列。我可以通过使用'output $ peak_at_table'对其进行预览来显示该列具有值,但是当我取消注释'updateSelectizeInput updt_hshtgs'时,将引发错误“警告:长度为0的::错误”,应用程序崩溃。
我在做什么错?任何帮助,请感激。我希望下面的示例不太冗长,我只是想让它对我的实际应用程序尽可能地真实。
取消注释服务器中的最后观察值以重新创建错误。我假定该模块在任何重新创建中均保存为“ slct_data.R”。 thnx
##Preprocess
library(dply);library(tokenizers);library(readr);library(tidytext)
load(url("http://varianceexplained.org/files/trump_tweets_df.rda"))
trump_tweets_df <- trump_tweets_df %>%
mutate(twit = "donald")
write_csv(trump_tweets_df, "trump_tweets_df.csv")
## Module
slct_dataUI <- function(id){
ns <- NS(id)
tagList(sidebarLayout(sidebarPanel(width = 2,
selectInput(inputId = ns("twit"),
label = "",
choices = ""),
dateInput(ns("start_date"),
label = "Choose a Start Date"),
dateInput(ns("end_date"),
label = "Choose an End Date"),
checkboxInput(ns("shw_rtwt"),
label = h5("Also Show Retweets?"),
value = FALSE),
selectizeInput(ns("updt_hshtgs"),
label = "",
choices = "",
multiple = TRUE)
),
mainPanel(dataTableOutput(ns("peak_at_table")))))
}
slct_data <- function(input, output, session){
srt_dt <- reactive({input$start_date})
end_dt <- reactive({input$end_date})
twit <- reactive({input$twit})
#### Init the list of available twits & setup the selectInputs ####
twits <- read_csv("trump_tweets_df.csv") %>%
select(twit) %>%
distinct(twit) %>%
arrange(twit)
updateSelectInput(session = session, inputId = "twit",
label = "Select a Twit", choices = as.character(twits),
selected = "donald")
#### twt_twit() - twit filter ####
twt_twit <- reactive({read_csv("trump_tweets_df.csv") %>%
filter(twit == input$twit) %>%
mutate(created_at = created)})
#### Update start date ####
min_start_out <- reactive({as.Date(twt_twit() %>%
select(created_at) %>%
arrange(created_at) %>%
head(1) %>%
mutate(created_at = str_sub(created_at, 1, 10)) %>%
pull())})
observe({
updateDateInput(session,
"start_date",
value = min_start_out(),
min = min_start_out(),
max = twt_twit() %>%
select(created_at) %>%
arrange(desc(created_at)) %>%
head(1) %>%
mutate(created_at = str_sub(created_at, 1, 10)) %>%
pull())})
#### Update end date ####
max_start_out <- reactive({as.Date(twt_twit() %>%
select(created_at) %>%
arrange(desc(created_at)) %>%
head(1) %>%
mutate(created_at = str_sub(created_at, 1, 10)) %>%
pull())})
observe({
updateDateInput(session, "end_date",
value = max_start_out(),
max = max_start_out(),
min = twt_twit() %>%
select(created_at) %>%
arrange(created_at) %>%
head(1) %>%
mutate(created_at = str_sub(created_at, 1, 10)) %>%
pull())})
#### Init the working dataset ####
twt_twit_rtwt <- reactive({
infile <- twit()
if (is.null(infile)){
return(NULL)
}
if(input$shw_rtwt){
twt_twit() %>%
filter(created_at >= srt_dt()) %>%
filter(created_at <= end_dt())
} else {
twt_twit() %>%
filter(created_at >= srt_dt()) %>%
filter(created_at <= end_dt()) %>%
filter(!isRetweet == TRUE)
}
})
#### A helper variable for filtering #hashtags in newvals ####
max_wrds <- reactive({twt_twit_rtwt() %>%
select(created_at, text) %>%
filter(str_detect(text, "#.+")) %>%
mutate(new_col = str_extract_all(text, "#[:alnum:]+")) %>%
mutate(wrd_cnt = sapply(strsplit(text, " "), length)) %>%
arrange(desc(wrd_cnt)) %>%
head(1) %>%
pull(wrd_cnt)})
newvals <- reactive({twt_twit_rtwt() %>%
select(created_at, text) %>%
filter(str_detect(text, "#[:alnum:]+")) %>%
separate(text, sep = " |\n", into = paste("V", 1:max_wrds(), sep = "_")) %>%
reshape2::melt(id.vars = "created_at") %>%
filter(str_detect(value, "#[:alnum:]+")) %>%
select(value) %>%
group_by(value) %>%
summarise(count = n()) %>%
arrange(desc(count)) %>%
select(value)
})
#### update #hashtags select ####
observe({
# updateSelectizeInput(session,
# "updt_hshtgs",
# label = "Hashtag Select",
# choices = as.character(newvals()),
# selected = NULL,
# options = list(maxOptions = length(newvals())),
# server = FALSE
# )
})
output$peak_at_table <- renderDataTable({
newvals()
})
}
## app
libs <- c("tidyverse", "shiny", "lubridate", "tidytext", "tokenizers")
lapply(libs, require, character.only = T)
source("slct_data.R")
ui <- fluidPage(slct_dataUI("sidebar_slctdata"))
server <- function(input, output, session){callModule(slct_data, "sidebar_slctdata")}
shinyApp(ui, server)