Запускать код, только когда вкладка активна в R Shiny (чтобы сократить время загрузки) - PullRequest
1 голос
/ 22 апреля 2020

Я создаю блестящее приложение, и из-за того, что загружается много данных и вычислений, мне это слишком медленно. У меня есть 2 основные вкладки, а вторая вкладка содержит карту листовки. Я хотел бы сделать так, чтобы содержимое и скрипт для этой вкладки запускались / загружались только после того, как зритель щелкнет вкладку.

Я пытался сделать это с помощью наблюдающего события, но, похоже, это не исправить.

В настоящее время у меня есть этот скрипт для второй вкладки на моем сервере (не будет публиковать весь серверный скрипт, поскольку он довольно длинный и только для первой вкладки)


  observeEvent(input$coronahulp_tab, {

   coronahulp <- search_tweets("coronahulp", n=1000, include_rts=FALSE, lang = 'nl', token = t)
   coronahulp2 <- coronahulp %>%  mutate(text, tolower(text)) %>%
      mutate(hashtags, tolower(hashtags)) %>%
      select(created_at, text, hashtags, location)

  woonplaatsen <- read_delim("Woonplaatsen_locatie.csv", delim = ";")
  woonplaatsen$woonplaatsnaam <- tolower(woonplaatsen$woonplaatsnaam)

  woonplaats_vector <- woonplaatsen$woonplaatsnaam

  coronahulp_locatie1 <- coronahulp2 %>% select(created_at, location) %>%
    mutate(location = tolower(location)) %>%
    mutate(nieuw = str_extract(location, paste("\\b",woonplaats_vector,"\\b", collapse = "|", sep = ""))) %>%
    filter(!(nieuw %in% c("nederland"))) %>%
    filter(!(is.na(nieuw))) %>%
    select(created_at, nieuw)


  coronahulp_locatie2 <- coronahulp2 %>% select(created_at, text) %>%
    mutate(text = tolower(text)) %>%
    mutate(nieuw = str_extract(text, paste("\\b",woonplaats_vector,"\\b", collapse = "|", sep = ""))) %>%
    filter(!(nieuw %in% c("de wijk", "buren", "hoeven", "anderen", "hem", "heel","een", "zetten", "nederland", "handel", "best", "echt"))) %>%
    filter(!(is.na(nieuw))) %>%
    select(created_at, nieuw)

  coronahulp_locatie3 <- coronahulp2 %>% select(created_at, hashtags) %>%
    mutate(hashtags = tolower(hashtags)) %>%
    unnest(hashtags)%>%
    mutate(nieuw = str_extract(hashtags, paste("\\b",woonplaats_vector,"\\b", collapse = "|", sep = ""))) %>%
    filter(!(nieuw %in% c("de wijk", "buren", "hoeven", "anderen", "hem", "heel","een", "zetten", "nederland", "handel", "best", "echt"))) %>%
    filter(!(is.na(nieuw))) %>%
    select(created_at, nieuw)

  coronahulp_locatie <- rbind(coronahulp_locatie1,coronahulp_locatie2, coronahulp_locatie3)
  coronahulp_locatie <- coronahulp_locatie %>%
    unique() %>%
    merge(coronahulp2) %>%
    rename(woonplaatsnaam = nieuw)
  options(digits = 7)

  locatie_coronahulp <- left_join(coronahulp_locatie, woonplaatsen) %>% 
    select(text, woonplaatsnaam, long, lat) %>%
    unique() %>%
    mutate(long = as.numeric(long), lat = as.numeric(lat)) %>%
    group_by(long,lat, woonplaatsnaam) %>%
    summarise(aantal = n(),text=paste(text,collapse=' <br><br> '))

  popup <- paste("<div class='leaflet-popup-scrolled' style='max-width:600px;max-height:300px'>","<b>", capitalize(locatie_coronahulp$woonplaatsnaam),"</b>", "<br><br>",locatie_coronahulp$text, "</div>")

  output$kaartje <- renderLeaflet({
    leaflet(locatie_coronahulp) %>%
      addProviderTiles("CartoDB") %>%
      addCircleMarkers(lng = ~long, lat = ~lat, label= ~capitalize(woonplaatsnaam), popup = ~popup, radius = ~aantal, stroke = FALSE, color = "#a72f6e") %>%
      addResetMapButton() 
  })})

В Пользовательский интерфейс у меня это для второй вкладки:

tabPanel("Coronahulp",
                          value = "coronahulp_tab",
                          sidebarLayout(
                            sidebarPanel(
                              h2("Coronahulp", align = "center"), 
                              br(),
                              HTML("<p style='font-size:16px'>Dagelijks beginnen mensen nieuwe #coronahulp initiatieven. Wil je weten welke initiatieven er bij jou in de buurt zijn gestart?
                                  Dit kaartje laat per woonplaats de coronahulp initiatieven zien die in de afgelopen zeven dagen op Twitter zijn genoemd.</p>"),
                              tags$a(
                                href="https://www.digitalewereld.nl/", 
                                tags$img(src="digitale_wereld.png", 
                                         title="Digitale wereld", 
                                         width="190",
                                         height="90"),
                                id="digitale_wereld"
                              ),
                              actionButton("info_button2", "Meer informatie")
                            ),
                            mainPanel(
                              leafletOutput("kaartje", height = '1000px') %>% withSpinner(color="#dca108")
                            )
                          )
                 )

Является ли ObserveEvent путь к go? Или я должен сделать это по-другому? Я уже пытался обернуть все части сценария в отдельные реактивные утверждения, но, похоже, это не помогло.

Заранее спасибо

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...