CODEWITHSUNDEEP
rshinyprogress-bar
Arlaf
Arlaf

Reputation: 339

R from a text loading bar to a shiny loading bar

I use a function with a text loading bar (get_reddit()) in a Shiny app and I would like to display the progression not in the R console but in the app. Does anyone know how I could do that?

For now I have an empty progress bar in the app (not surprising since I don't have any incProgress() to go with the withProgress()) and an active text bar in my RStudio console.

library(shiny)
library(RedditExtractoR)

ui <- fluidPage(actionButton("go", "GO !"),
                tableOutput("reddit"))

server <- function(input, output) {
  get_data <- eventReactive(input$go, {
    withProgress(message = 'Work in progress', value = 0, {
      df <-
        get_reddit(
          search_terms = "Lyon",
          regex_filter = "",
          subreddit = "france",
          cn_threshold = 1,
          page_threshold = 1,
          sort_by = "comments",
          wait_time = 2
        )
      df
    })
  })

  output$reddit <- renderTable({
    df <- get_data()
    df[1:5, 1:5]
  })

}

shinyApp(ui = ui, server = server)

Thank you for your help!

Upvotes: 2

Views: 476

Answers (1)

Samuel
Samuel

Reputation: 3051

A simple solution is to edit the function in the RedditExtractoR package responsible for the progress bar, which is reddit_content. This function is called from within the get_reddit function, so this function has to be updated too. 

library(shiny)
library(RedditExtractoR)
source("get_reddit2.R")  # source the new get_reddit2 function (see below)
source("reddit_content2.R")  # source the new reddit_content2 function (see below)

ui <- fluidPage(actionButton("go", "GO !"),
                tableOutput("reddit"))

server <- function(input, output) {
  get_data <- eventReactive(input$go, {
      df <- get_reddit2(
        search_terms = "science", 
        subreddit = "science")
  })
  output$reddit <- renderTable({
    df <- get_data()
    df[1:5, 1:5]
  })
}

shinyApp(ui = ui, server = server)

Put the following function in a separate file called get_reddit2.R which you source from the app (see above): 

get_reddit2 <- function (
  search_terms = NA,
  regex_filter = "",
  subreddit = NA,
  cn_threshold = 1,
  page_threshold = 1,
  sort_by = "comments",
  wait_time = 2)
{
  URL = unique(as.character(
    reddit_urls(
      search_terms,
      regex_filter,
      subreddit,
      cn_threshold,
      page_threshold,
      sort_by,
      wait_time
    )$URL
  ))
  retrieved_data = reddit_content2(URL, wait_time)
  return(retrieved_data)
}

Put also the following function in a separate file called reddit_content2.R (see above): 

reddit_content2 <- function (URL, wait_time = 2)
{
  if (is.null(URL) | length(URL) == 0 | !is.character(URL)) {
    stop("invalid URL parameter")
  }
  GetAttribute = function(node, feature) {
    Attribute = node$data[[feature]]
    replies = node$data$replies
    reply.nodes = if (is.list(replies))
      replies$data$children
    else
      NULL
    return(list(Attribute, lapply(reply.nodes, function(x) {
      GetAttribute(x, feature)
    })))
  }
  get.structure = function(node, depth = 0) {
    if (is.null(node)) {
      return(list())
    }
    filter = is.null(node$data$author)
    replies = node$data$replies
    reply.nodes = if (is.list(replies))
      replies$data$children
    else
      NULL
    return(list(
      paste0(filter, " ", depth),
      lapply(1:length(reply.nodes),
             function(x)
               get.structure(reply.nodes[[x]], paste0(depth,
                                                      "_", x)))
    ))
  }
  data_extract = data.frame(
    id = numeric(),
    structure = character(),
    post_date = as.Date(character()),
    comm_date = as.Date(character()),
    num_comments = numeric(),
    subreddit = character(),
    upvote_prop = numeric(),
    post_score = numeric(),
    author = character(),
    user = character(),
    comment_score = numeric(),
    controversiality = numeric(),
    comment = character(),
    title = character(),
    post_text = character(),
    link = character(),
    domain = character(),
    URL = character()
  )

  # pb = utils::txtProgressBar(min = 0,
  #                            max = length(URL),
  #                            style = 3)
  withProgress(message = 'Work in progress', value = 0, {

  for (i in seq(URL)) {
    if (!grepl("^https?://(.*)", URL[i]))
      URL[i] = paste0("https://www.", gsub("^.*(reddit\\..*$)",
                                           "\\1", URL[i]))
    if (!grepl("\\?ref=search_posts$", URL[i]))
      URL[i] = paste0(gsub("/$", "", URL[i]), "/?ref=search_posts")
    X = paste0(gsub("\\?ref=search_posts$", "", URL[i]),
               ".json?limit=500")
    raw_data = tryCatch(
      RJSONIO::fromJSON(readLines(X, warn = FALSE)),
      error = function(e)
        NULL
    )
    if (is.null(raw_data)) {
      Sys.sleep(min(1, wait_time))
      raw_data = tryCatch(
        RJSONIO::fromJSON(readLines(X,
                                    warn = FALSE)),
        error = function(e)
          NULL
      )
    }
    if (is.null(raw_data) == FALSE) {
      meta.node = raw_data[[1]]$data$children[[1]]$data
      main.node = raw_data[[2]]$data$children
      if (min(length(meta.node), length(main.node)) > 0) {
        structure = unlist(lapply(1:length(main.node),
                                  function(x)
                                    get.structure(main.node[[x]], x)))
        TEMP = data.frame(
          id = NA,
          structure = gsub("FALSE ",
                           "", structure[!grepl("TRUE", structure)]),
          post_date = format(as.Date(
            as.POSIXct(meta.node$created_utc,
                       origin = "1970-01-01")
          ), "%d-%m-%y"),
          comm_date = format(as.Date(
            as.POSIXct(unlist(lapply(main.node,
                                     function(x) {
                                       GetAttribute(x, "created_utc")
                                     })), origin = "1970-01-01")
          ), "%d-%m-%y"),
          num_comments = meta.node$num_comments,
          subreddit = ifelse(
            is.null(meta.node$subreddit),
            "UNKNOWN",
            meta.node$subreddit
          ),
          upvote_prop = meta.node$upvote_ratio,
          post_score = meta.node$score,
          author = meta.node$author,
          user = unlist(lapply(main.node, function(x) {
            GetAttribute(x, "author")
          })),
          comment_score = unlist(lapply(main.node,
                                        function(x) {
                                          GetAttribute(x, "score")
                                        })),
          controversiality = unlist(lapply(main.node,
                                           function(x) {
                                             GetAttribute(x, "controversiality")
                                           })),
          comment = unlist(lapply(main.node, function(x) {
            GetAttribute(x, "body")
          })),
          title = meta.node$title,
          post_text = meta.node$selftext,
          link = meta.node$url,
          domain = meta.node$domain,
          URL = URL[i],
          stringsAsFactors = FALSE
        )
        TEMP$id = 1:nrow(TEMP)
        if (dim(TEMP)[1] > 0 & dim(TEMP)[2] > 0)
          data_extract = rbind(TEMP, data_extract)
        else
          print(paste("missed", i, ":", URL[i]))
      }
    }

    # utils::setTxtProgressBar(pb, i)
    incProgress()
    Sys.sleep(min(2, wait_time))
  }

  # close(pb)
  })
  return(data_extract)
}

Now the loading bar is shown in Shiny instead of the console.

Upvotes: 1

Related Questions