R从文本加载栏到闪亮的加载栏

我在一个闪亮的应用程序中使用了一个带有文本加载条（

get_reddit（）

）的函数，我希望在应用程序中显示进度，而不是在R控制台中显示进度。有人知道我是怎么做到的吗

目前，我在应用程序中有一个空的进度条（这并不奇怪，因为我没有任何

incProgress（）

来配合

withProgress（）

），在我的RStudio控制台中有一个活动的文本条

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)

库（闪亮）
库（RedditExtractoR）
ui一个简单的解决方案是编辑负责进度条的
RedditExtractoR
包中的函数，即
reddit\u content
。此函数是从
get_reddit
函数中调用的，因此此函数也必须更新

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)

将以下函数放在名为
reddit\u content2.R
的单独文件中（见上文）：

reddit\u内容2（0）{
结构=未列出（lappy（1：长度（主节点）），
功能（x）
get.structure（main.node[[x]]，x）））
TEMP=data.frame(
id=NA，
结构=gsub（“假”，
“”，结构[！grepl（“TRUE”，结构）]，
发布日期=格式（as.date）(
as.POSIXct（meta.node$created_utc，
原点=“1970-01-01”）
)，%d-%m-%y”），
comm_date=格式（as.date(
as.POSIXct（未列出）lappy（main.node，
功能（x）{
GetAttribute（x，“创建的utc”）
}))，origin=“1970-01-01”）
)，%d-%m-%y”），
num\u comments=meta.node$num\u comments，
subreddit=ifelse(
is.null（meta.node$subreddit），
“未知”，
meta.node$subreddit
),
upvote_prop=meta.node$upvote_比率，
post_得分=元节点$score，
author=meta.node$author，
user=unlist（lappy）（main.node，函数（x）{
GetAttribute（x，“作者”）
})),
注释得分=未列出（lappy（main.node，
功能（x）{
GetAttribute（x，“分数”）
})),
争议性=未列出（lappy（main.node，
功能（x）{
GetAttribute（x，“争议性”）
})),
comment=unlist（lappy）（main.node，函数（x）{
GetAttribute（x，“主体”）
})),
title=meta.node$title，
post_text=meta.node$selftext，
link=meta.node$url，
domain=meta.node$domain，
URL=URL[i]，
stringsAsFactors=FALSE
)
临时$id=1:nrow（临时）
如果（调光（温度）[1]>0和调光（温度）[2]>0）
数据提取=rbind（温度、数据提取）
其他的
打印（粘贴（“缺失”，i“：”，URL[i]））
}
}
#utils:：setTxtProgressBar（pb，i）
incProgress（）
系统睡眠（分钟（2，等待时间））
}
#关闭（pb）
})
返回（数据提取）
}

现在，加载栏显示为闪亮，而不是控制台

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)
}

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)
}