如何在Shiny

时间:2018-07-02 15:58:50

标签: r shiny

我正在设计一个用于查看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)

0 个答案:

没有答案