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

我现在已经不太参与邮件列表里的讨论了,不过我还是想看看里面最热门的讨论大概都是关于什么话题的。要是有人有兴趣,邮件列表的数据可以从网页上爬,比如 https://stat.ethz.ch/pipermail/r-devel/ 按 Thread 或 Subject 排列的页面爬一下就知道每个主题下面的回帖数量。最终我想要的数据就三列:主题、链接、回帖数量。如:

subject, link, count
"[R] Open a file which name contains a tilde", "https://stat.ethz.ch/pipermail/r-devel/2019-June/077961.html", 18

上面是开发者列表,还有普通用户列表:https://stat.ethz.ch/pipermail/r-help/

我之所以想看这个数据是因为我有个猜测想验证一下:凭我的肉眼观察,我感觉多数“热门”讨论都是极其琐碎无聊的事情,根本不值得费那么多口舌(比如上面那个例子)。为了防止我看歪了,我想看一眼全局数据。希望有壮士能写个脚本。其实第一次本地爬完之后,以后可以在 Travis 上定期爬新的数据,把数据自动更新到 Github 或什么地方。

    yihui

    用xml2做了一个:
    Rmarkdown
    效果

    这种结构比较标准的html还是挺好处理的

    不过我只爬了一个月,仔细一看同一个thread在多个月里都会出现,要合并也可以,不过数据清理已经超出了这个爬虫的功能范围哈哈哈,暂时在此收手了。

      tctcab 不错不错!好了,那就请别的壮士继续背这口锅吧,一是把历史数据爬完,二是在数据里加一列,就是帖子的时间(年月即可)。数据弄好后,如果有相邻月份的帖子标题相同,那就把前一个月的计数加到后一个月的计数上。

        yihui
        年月并没有在xml里出现,不过那个thread的地址里有年月信息,要整合也不難,

        既然都做到这步了那就顺便走完吧,屁股没擦干净留给别人总不大好哈哈哈

        yihui
        爬好了(从97年4月到目前的数据),戳这:https://github.com/jienagu/tidyverse_examples/blob/master/web_scraping_r_devel.R
        结果(已经排序好了)如下:

        > head(everything2)
                                                           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

        这是 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 来表示,另外有一点疑惑,动不动就掉线是什么原因