• R语言

  • 一个爬网页的练习：看看 R 邮件列表中最热门的讨论是什么

这是 r-devel 的前十名：

> everything2[1:10,]
                                                             link                                                          Link_url count
1                            [Rd] [RFC] A case for freezing CRAN      https://stat.ethz.ch/pipermail/r-devel/2014-March/068548.html    64
2                                             [Rd] CRAN policies      https://stat.ethz.ch/pipermail/r-devel/2012-March/063678.html    51
3                           [Rd] surprising behaviour of names<-      https://stat.ethz.ch/pipermail/r-devel/2009-March/052522.html    49
4                                     [Rd] legitimate use of :::     https://stat.ethz.ch/pipermail/r-devel/2013-August/067180.html    45
5           [Rd] Computer algebra in R - would that be an idea??       https://stat.ethz.ch/pipermail/r-devel/2005-July/033940.html    40
6                                            [Rd] if(--as-cran)?  https://stat.ethz.ch/pipermail/r-devel/2012-September/064760.html    39
7                            [Rd] declaring package dependencies  https://stat.ethz.ch/pipermail/r-devel/2013-September/067446.html    39
8                          [Rd] Suggestion: help(<package name>)       https://stat.ethz.ch/pipermail/r-devel/2005-June/033480.html    38
9                              [Rd] Bias in R's random integers?  https://stat.ethz.ch/pipermail/r-devel/2018-September/076817.html    38
10 [Rd] R 3.0, Rtools3.0,l Windows7 64-bit, and permission agony      https://stat.ethz.ch/pipermail/r-devel/2013-April/066388.html    37

源代码在上述贴子中。

    yihui

    研究了一下合并帖子，觉得并不简单，因为：
    - 同一个串下面标题有可能不一致
    - 不同串有可能名字一样

    尝试了合并标题一样的帖子，但不一定对。比如04,06,07年都有个名为“[Rd] Wish list”的串

    另外就是抓取的时候一不留神就连接错误，所以我先把thread.html下载到本地再提取信息，速度也快了不少（8分钟到19秒）

    结果：

    Rmarkdown
    效果

    合并串之后可以看出结果跟Jiena 的前十名还是有点细微差别：

    # A tibble: 10 x 4
   title                          link                            reps year_mon  
   <chr>                          <chr>                          <int> <chr>     
 1 "[Rd] [RFC] A case for freezi… https://stat.ethz.ch/pipermai…    69 2014-March
 2 "[Rd] Wish list\n"             https://stat.ethz.ch/pipermai…    62 2007-Janu…
 3 "[Rd] CRAN policies\n"         https://stat.ethz.ch/pipermai…    51 2012-March
 4 "[Rd] legitimate use of :::\n" https://stat.ethz.ch/pipermai…    48 2014-May  
 5 "[Rd] NEWS.md support on CRAN… https://stat.ethz.ch/pipermai…    48 2015-May  
 6 "[Rd] surprising behaviour of… https://stat.ethz.ch/pipermai…    48 2009-March
 7 "[Rd] declaring package depen… https://stat.ethz.ch/pipermai…    42 2013-Sept…
 8 "[Rd] if(--as-cran)?\n"        https://stat.ethz.ch/pipermai…    42 2012-Sept…
 9 "[Rd] Bias in R's random inte… https://stat.ethz.ch/pipermai…    37 2018-Sept…
10 "[Rd] R 3.0, Rtools3.0,l Wind… https://stat.ethz.ch/pipermai…    36 2013-April

          Jiena 第四名的楼是我盖的。我以前曾经盖过几栋高楼，不过我都忘记了这一栋有这么高。好在它最后没变成烂尾楼。也是少有的 R 核心团队最终采纳了我的意见的情形。

          可否写一份 CSV 数据到 Github 上？

          还有 R-help 列表也可以抓一下（我来做一回伸手党），估计热度会更高，毕竟 R-devel 是开发者列表，参与人数少很多。

          tctcab 没事，这个我考虑到了，不用太精确。谢谢！

          dapengde 你这个晒泥是实时晒的吗？拖一下滑动条就重新现抓网页？那好像有点浪费资源啊。

                  tctcab 赞赞赞！好厉害！对了，昨天忘了回复您，的确如您所说的：同一串可能标题不一样，我把新标题当成新问题，因为有可能问着问着楼歪了话题岔开了。不同串可能标题相同，这里我当时的确有些纠结，您的方法是先把原始数据下下来，然后汇总，而我的是先把每个月的数据汇总，再粘在一起。我当时考虑的是不同月份的相同标题是不是具体问的一个问题。比如四月底问的问题，别人五月回的贴，五月的回帖是归于四月还是五月？又或许是不同的人问了同一领域的问题，于是取了相同的标题？

                      yihui 目前是的。最好别拖。等哪位壮士拿 travis 定期爬一爬，就可以在晒泥载入的时候一次性灌进去了。

                        dapengde
                        区区三十六个月，还不到总体七分之一，总数据这可是有266个月两万多串，粗略地计算duplicate(title)都能找到大概两千多个标题重复的主题。

                            yihui
                            爬好了，如下：

                                Jiena 您好，我是新手，我想问一下最后一行代码跑的时候出现了错误，是为什么呢？谢谢。output=map(trans_month, ~ scraplinks_JM(.x))

                                    Jiena 可能我还木有学会基础知识，如果是低级问题，层主就不用回了，谢谢您。

                                    output=map(trans_month, ~ scraplinks_JM(.x))
                                    Show Traceback

                                    Rerun with Debug
                                    Error in open.connection(x, "rb") : HTTP error 404.

                                        基于 Jiena 的代码，来个依赖最小的版本

                                        # 安装必要的依赖
packages <- c("rvest", "knitr")
lapply(packages, function(pkg) {
  if (system.file(package = pkg) == "") install.packages(pkg)
})

# 确保 Windows 下的中文环境也能获取正确的日期格式化结果
Sys.setlocale("LC_TIME", "C")
# 格式化日期序列
all_months <- format(
  seq(
    from = as.Date("1997-04-01"),
    to = Sys.Date(), by = "1 month"
  ),
  "%Y-%B"
)

# 清理帖子主题
clean_discuss_topic <- function(x) {
  # 去掉中括号及其内容
  x <- gsub("(\\[.*?\\])", "", x)
  # 去掉末尾换行符 \n
  x <- gsub("(\\\n)$", "", x)
  # 两个以上的空格替换为一个空格
  x <- gsub("( {2,})", " ", x)
  x
}
library(magrittr)
x <- "2019-February"
base_url <- "https://stat.ethz.ch/pipermail/r-devel"

# 下面的部分可以打包成一个函数
# 输入是日期 x 输出是一个 markdown 表格

# 抓取当月的数据
scrap_webpage <- xml2::read_html(paste(base_url, x, "subject.html", sep = "/"))
# Extract the URLs 提取链接尾部
tail_url <- scrap_webpage %>%
  rvest::html_nodes("a") %>%
  rvest::html_attr("href")
# Extract the theme 提取链接对应的讨论主题
discuss_topic <- scrap_webpage %>%
  rvest::html_nodes("a") %>%
  rvest::html_text()

# url 和 讨论主题合并为数据框
discuss_df <- data.frame(discuss_topic = discuss_topic, tail_url = tail_url)

# 清理无效的帖子记录
discuss_df <- discuss_df[grepl(pattern = "\\.html$", x = discuss_df$tail_url), ]
# 清理帖子主题内容
discuss_df$discuss_topic <- clean_discuss_topic(discuss_df$discuss_topic)

# 去重 # 只保留第一条发帖记录
discuss_uni_df <- discuss_df[!duplicated(discuss_df$discuss_topic), ]
# 分组计数
discuss_count_df <- as.data.frame(table(discuss_df$discuss_topic), stringsAsFactors = FALSE)
# 对 discuss_count_df 的列重命名
colnames(discuss_count_df) <- c("discuss_topic", "count")
# 按讨论主题合并数据框
discuss <- merge(discuss_uni_df, discuss_count_df, by = "discuss_topic")

# 添加完整的讨论帖的 url
discuss <- transform(discuss, full_url = paste(base_url, x, tail_url, sep = "/"))
# 选取讨论主题、主题链接和楼层高度
discuss <- discuss[, c("discuss_topic", "full_url", "count")]

# 按楼层高度排序，转化为 Markdown 表格形式输出
discuss[order(discuss$count, decreasing = TRUE), ] %>%
  knitr::kable(format = "markdown", row.names = FALSE) %>%
  cat(file = paste0(x, "-disuss.md"), sep = "\n")

                                        总依赖如下，现在差不多可以往 Travis 上搞定时任务了，只要把输出的 markdown 文件推回 Github 即可

                                        tools::package_dependencies(packages,recursive=T) %>% unlist %>% unique
 [1] "xml2"     "httr"     "magrittr" "selectr"  "curl"     "jsonlite"
 [7] "mime"     "openssl"  "R6"       "methods"  "stringr"  "Rcpp"    
[13] "tools"    "askpass"  "utils"    "glue"     "stringi"  "sys"     
[19] "stats"    "evaluate" "highr"    "markdown" "yaml"     "xfun"

                                        我还不知道论坛里怎么贴 Markdwon 表格，即文件 2019-February-disuss.md 的内容，所以请移步 <https://github.com/XiangyunHuang/RGraphics/issues/5>

                                        如果将所有的帖子都扒拉下来，根据帖子主题之间的关系，有没有可能将它们分类，用 shiny 做一个可视化前端，根据时间和楼层数显示每类帖子下面热门的讨论

                                        如果把每个帖子的发帖人和回帖人也提取，那么还可以看特定的人的情况

                                        根据帖子的 ID 长度来看是六位数，不足百万，SO 上面已经是八位数了

                                            dapengde 右侧的条形图不妨只是精确到季度，或者不要用条形图表示，用点图就可以了，或者用动态的时间序列包 dygraphs 来表示，另外有一点疑惑，动不动就掉线是什么原因

                                                Cloud2016 好建议，我把 dygraphics 加上了，而 ggplot 改成了精确到年。

                                                掉线可能是为了节省机时。因为 shinyapps.io 的免费机时有限，停一会儿看用户没操作，就给断了。

                                                    容我插一句，
                                                    统计之都是不是也能趴一趴

                                                    就像这个月外面那个讨论极乐净土的长帖子就值得挖出来读一读啊。

                                                    想挖掘一些这种讨论的热火朝天的尘封的帖子，扩充@dapeng1978 那个sinx语录包

                                                      tctcab 我甚至觉得可以整理一下作为一篇主站文章，而且保留讨论的形式，所有参与讨论的人都是作者

                                                        yanglei
                                                        没事，问的好。建议先试 r-devel.R，数量小一些。 以下是侦察过程：

                                                        • 建立好年月数列，看看trans_month是不是这个格式，比如“1997-April”： 
                                                          #Loading the rvest package
library('rvest')
library(purrr)
library(tidyverse)
## Create year month list
current_month=as.Date(cut(Sys.Date(), "month"))
date_seq=seq(from=as.Date("1997-04-01"),to=current_month , by="1 month")
trans_month=format(as.Date(date_seq), "%Y-%B")

### Make a function to fetch the summarized data frame for every month
unnecessary=c("thread.html#start",
              "author.html#start",
              "date.html#start",
              "http://www.stat.math.ethz.ch/mailman/listinfo/r-devel")
                                                          • 先以 1997 年 4 月为例子在本地跑：
                                                            #Specifying the url for desired website to be scraped
  url_base <- 'https://stat.ethz.ch/pipermail/r-devel/%s/subject.html'
  
  test_web=read_html(sprintf(url_base, '1997-April' ) )
  # Extract the URLs
  url_ <- test_web %>%
    rvest::html_nodes("a") %>%
    rvest::html_attr("href")
  # Extract the link text
  link_ <- test_web %>%
    rvest::html_nodes("a") %>%
    rvest::html_text()
  test_df=data.frame(link = link_, url = url_)
  test_df2=test_df[which(!is.na(test_df$url)),]
  test_df3=test_df2[which(! test_df2$url %in% unnecessary),]
  test_df3$link=gsub("[\r\n]", " ", test_df3$link)
  test_df3$url=paste0("https://stat.ethz.ch/pipermail/r-devel/", "1997-April","/",test_df3$url)
  test_df4=test_df3 %>% 
    group_by(link) %>%
    dplyr::mutate(
      Link_url = dplyr::first(url)
    ) %>% group_by(link,Link_url ) %>% 
    summarize(
      count=n()
    ) 
  test_df4=data.frame(test_df4)
                                                          这样一步一步跑哪里出错一清二楚。最后看看您的 test_df4是不是如下： 
                                                          > head(test_df4)
                                                                link                                                      Link_url count
1 R-alpha:  contributed packages -- Yes, use library/<package>/.. !  https://stat.ethz.ch/pipermail/r-devel/1997-April/017072.html     2
2                                                   R-alpha: ==NULL  https://stat.ethz.ch/pipermail/r-devel/1997-April/017131.html     1
3                                               R-alpha: as.numeric  https://stat.ethz.ch/pipermail/r-devel/1997-April/017023.html     3
4                                   R-alpha: Be nice to the English  https://stat.ethz.ch/pipermail/r-devel/1997-April/017051.html     1
5                                               R-alpha: binom.test  https://stat.ethz.ch/pipermail/r-devel/1997-April/017075.html     1
6                R-alpha: Bug & Patch  in  dbeta.c  (0.50 - PreR 7)  https://stat.ethz.ch/pipermail/r-devel/1997-April/017048.html     3