R 网络爬虫：R rvest 教程

简介

Trustpilot 已成为用户评价企业与服务的热门网站。在这篇简短教程中，您将学习如何使用 R 从该网站抓取有用信息，并据此生成一些基础洞见。您会发现，TrustPilot 或许并没有宣传得那么“值得信赖”。

更具体地说，本教程将涵盖以下内容：

首先，您将学习如何抓取 Trustpilot 以收集评价；
随后，您将看到从单页提取信息的一些基本技巧：提取评价文本、评分、作者姓名以及所有评价的提交时间。
掌握这些工具后，您就可以更进一步，比较两家（您自选）公司的评价：您将看到如何结合使用 ggplot2 与 dplyr 等 tidyverse 包以及 xts 来进一步检查数据并提出假设，然后用 infer 包（一个遵循 tidyverse 哲学的统计推断包）来深入检验该假设。

在 Trustpilot 上，一条评价由对服务的简短描述、一个 5 星评分、用户名以及发布时间构成。

您的目标是用 R 编写一个函数，为您选择的任意公司提取这些信息。

创建一个抓取函数

首先，您需要加载本任务所需的所有库。

    # General-purpose data wrangling
    library(tidyverse)  

    # Parsing of HTML/XML files  
    library(rvest)    

    # String manipulation
    library(stringr)   

    # Verbose regular expressions
    library(rebus)     

    # Eases DateTime manipulation
    library(lubridate) 技术支持

查找所有页面

作为示例，您可以选择电商公司 Amazon。这纯粹用于演示，和您将在教程下半部分涉及的案例研究并无关联。

落地页 URL 将作为公司的标识符，因此您会将其存为变量。

    url <-'http://www.trustpilot.com/review/www.amazon.com'
技术支持

大多数大型公司都有多页评价。在 Amazon 的落地页上，您可以读到页数，这里是 155。

点击任意子页可以发现公司各个页面 URL 的规律：每个子页都是主 URL 加上 ?page=n，其中 n 是评价页码，这里介于 1 到 155 之间。

程序应按如下方式运作：

找出需要查询的最大页码
生成构成全部评价的所有子页
从每个子页抓取信息
将信息合并为一份完整的数据框

先从查找最大页码开始。通常，您可以使用浏览器自带的开发者工具检查网站的可视元素。其思路在于，网站的所有内容，即便是动态生成的，也会在源代码中以某种方式被标注。这些标注通常足以定位您想要提取的数据。

由于这是入门介绍，您也可以走“风景路线”，直接自己查看源代码。

HTML 数据的结构如下：

    < Tag  Attribute_1 = Value_1 Attribute_2 = Value_2 ...>
        The tagged data
        <\Tag>
技术支持

要获取数据，您需要用到 rvest 包的一些函数。用 read_html() 将网页转换为 XML 对象。您需要提供目标 URL，该函数会调用服务器、收集数据并进行解析。用 html_nodes() 从 XML 对象中提取相关节点，其参数是类选择器，前面加上 . 表示这是一个类。输出将是以这种方式找到的所有节点的列表。要提取标注数据，需对目标节点应用 html_text()。若要提取属性，则使用 html_attrs()。这会返回属性列表，您可以对其进行子集操作以得到所需属性。

来实际应用一下。右击 Amazon 落地页选择检查源代码。您可以搜索数字“155”快速定位相关部分。

您会看到所有页码按钮信息都被标注为 'pagination-page' 类。一个接收落地页原始 HTML 并提取 pagination-page 类中倒数第二项的函数如下：

    get_last_page <- function(html){

      pages_data <- html %>% 
                      # The '.' indicates the class
                      html_nodes('.pagination-page') %>% 
                      # Extract the raw text as a list
                      html_text()                   

      # The second to last of the buttons is the one
      pages_data[(length(pages_data)-1)] %>%            
        # Take the raw string
        unname() %>%                                     
        # Convert to number
        as.numeric()                                     
    }
技术支持

该函数的关键步骤是应用 html_nodes() 提取 pagination 类的所有节点。函数的最后部分只是取出列表中正确的元素（倒数第二个），并将其转换为数值。

要测试该函数，您可以用 read_html() 载入起始页，然后调用刚写好的函数：

    first_page <- read_html(url)
    (latest_page_number <- get_last_page(first_page))
技术支持

    [1] 155
技术支持

拿到这个数字后，您就可以生成所有相关 URL 的列表

    list_of_pages <- str_c(url, '?page=', 1:latest_page_number)
技术支持

您可以手动检查 list_of_pages 中的条目是否有效，并可在浏览器中打开。

提取单页信息

您希望提取评价文本、评分、作者姓名以及所有评价的提交时间。可以针对每个需要的字段重复之前的步骤。

为每个数据字段编写一个抽取函数，使用您观察到的标签。此时需要一些试错来精准获取所需数据。有时您会发现额外的项目也被同样标注，因此需要手动缩减输出。

    get_reviews <- function(html){
      html %>% 
        # The relevant tag
        html_nodes('.review-body') %>%      
        html_text() %>% 
        # Trim additional white space
        str_trim() %>%                       
        # Convert the list into a vector
        unlist()                             
    }

    get_reviewer_names <- function(html){
      html %>% 
        html_nodes('.user-review-name-link') %>% 
        html_text() %>% 
        str_trim() %>% 
        unlist()
    }
技术支持

日期时间信息稍微棘手一些，因为它存储在属性中。

一般来说，您先寻找尽可能宽泛的选择器，再剔除冗余信息。由于时间信息不仅出现在评价中，您还需要提取相关的 status 信息并按正确条目过滤。

    get_review_dates <- function(html){

      status <- html %>% 
                  html_nodes('time') %>% 
                  # The status information is this time a tag attribute
                  html_attrs() %>%             
                  # Extract the second element
                  map(2) %>%                    
                  unlist() 

      dates <- html %>% 
                  html_nodes('time') %>% 
                  html_attrs() %>% 
                  map(1) %>% 
                  # Parse the string into a datetime object with lubridate
                  ymd_hms() %>%                 
                  unlist()

      # Combine the status and the date information to filter one via the other
      return_dates <- tibble(status = status, dates = dates) %>%   
                        # Only these are actual reviews
                        filter(status == 'ndate') %>%              
                        # Select and convert to vector
                        pull(dates) %>%                            
                        # Convert DateTimes to POSIX objects
                        as.POSIXct(origin = '1970-01-01 00:00:00') 

      # The lengths still occasionally do not lign up. You then arbitrarily crop the dates to fit
      # This can cause data imperfections, however reviews on one page are generally close in time)

      length_reviews <- length(get_reviews(html))

      return_reviews <- if (length(return_dates)> length_reviews){
          return_dates[1:length_reviews]
        } else{
          return_dates
        }
      return_reviews
    }
技术支持

最后一个需要的函数是评分抽取器。您将使用正则表达式进行模式匹配。评分作为标签的一个属性存在。它不是单纯的数字，而是字符串 count-X 的一部分，其中 X 是您想要的数字。正则表达式可能有些晦涩，但 rebus 包提供了更友好的可读写法。此外，rebus 通过 %R% 运算符提供的管道功能，可以将复杂模式分解为更简单的子模式，从而构建更复杂的正则表达式。

    get_star_rating <- function(html){

      # The pattern you look for: the first digit after `count-`
      pattern = 'count-'%R% capture(DIGIT)    

      ratings <-  html %>% 
        html_nodes('.star-rating') %>% 
        html_attrs() %>% 
        # Apply the pattern match to all attributes
        map(str_match, pattern = pattern) %>%
        # str_match[1] is the fully matched string, the second entry
        # is the part you extract with the capture in your pattern  
        map(2) %>%                             

        unlist()

      # Leave out the first instance, as it is not part of a review
      ratings[2:length(ratings)]               
    }
技术支持

在测试过各个抽取函数能在单个 URL 上工作后，您将它们组合起来，为整页创建一个 tibble（本质上是数据框）。由于您可能会将此函数应用于不止一家公司，因此会添加一个公司名称字段。这样在后续比较不同公司时会更方便。

    get_data_table <- function(html, company_name){

      # Extract the Basic information from the HTML
      reviews <- get_reviews(html)
      reviewer_names <- get_reviewer_names(html)
      dates <- get_review_dates(html)
      ratings <- get_star_rating(html)

      # Combine into a tibble
      combined_data <- tibble(reviewer = reviewer_names,
                              date = dates,
                              rating = ratings,
                              review = reviews) 

      # Tag the individual data with the company name
      combined_data %>% 
        mutate(company = company_name) %>% 
        select(company, reviewer, date, rating, review)
    }
技术支持

您将此函数再包一层，从 URL 抽取 HTML，以便更方便地调用。

    get_data_from_url <- function(url, company_name){
      html <- read_html(url)
      get_data_table(html, company_name)
    }
技术支持

最后一步，将该函数应用到之前生成的 URL 列表。为此，使用 tidyverse 中 purrr 包的 map() 函数，它会对列表中的各项应用同一个函数。您之前已用过该函数，不过当时传的是数字 n，这是提取列表第 n 个子项的简写。

最后，编写一个便捷函数，输入公司的落地页 URL 和您想给该公司打的标签。它会提取所有评价，并将其绑定为一个 tibble。这也是优化代码的良好起点。map 目前按顺序应用 get_data_from_url()，但并非必须。此处可以并行化：让多个 CPU 各自抓取一部分页面的评价，最后再合并。

    scrape_write_table <- function(url, company_name){

      # Read first page
      first_page <- read_html(url)

      # Extract the number of pages that have to be queried
      latest_page_number <- get_last_page(first_page)

      # Generate the target URLs
      list_of_pages <- str_c(url, '?page=', 1:latest_page_number)

      # Apply the extraction and bind the individual results back into one table, 
      # which is then written as a tsv file into the working directory
      list_of_pages %>% 
        # Apply to all URLs
        map(get_data_from_url, company_name) %>%  
        # Combine the tibbles into one tibble
        bind_rows() %>%                           
        # Write a tab-separated file
        write_tsv(str_c(company_name,'.tsv'))     
    }
技术支持

您将结果保存为制表符分隔文件，而非常见的逗号分隔文件（CSV），因为评价中常含逗号，可能会干扰解析器。

例如，您可以将该函数应用于 Amazon：

    scrape_write_table(url, 'amazon')

    amz_tbl <- read_tsv('amazon.tsv')
    tail(amz_tbl, 5)
技术支持

    # A tibble: 5 x 5
      company            reviewer                date rating
        <chr>               <chr>              <dttm>  <int>
    1  amazon            Anders T 2009-03-22 13:14:12      5
    2  amazon             David E 2008-12-31 18:57:31      5
    3  amazon      Joseph Harding 2008-09-16 13:05:05      3
    4  amazon   "Mads D\u00f8rup" 2008-04-28 11:09:05      5
    5  amazon Kim Fuglsang Kramer 2007-08-27 17:25:01      4
    # ... with 1 more variables: review <chr>
技术支持

案例研究：两家公司的故事

借助上一节的网页抓取函数，您可以快速获得大量数据。借此数据，可以进行多种分析。

在本案例中，您只会使用评价的元数据，即评分与评价时间。

首先，加载一些额外的库。

    # For working with time series
    library(xts)      

    # For hypothesis testing
    library(infer)
技术支持

您感兴趣的两家公司都是同一行业中颇具影响力的参与者。它们也都在官网上将 TrustPilot 分数作为卖点。

您已经抓取了它们的数据，只需加载：

    data_company_a <- read_tsv('company_A.tsv')
    data_company_b <- read_tsv('company_B.tsv')
技术支持

您可以借助 dplyr 包的 group_by() 与 summarise() 对总体数据进行汇总：

    full_data <- rbind(data_company_a, data_company_b)

    full_data%>%
      group_by(company) %>% 
      summarise(count = n(), mean_rating = mean(rating))
技术支持

company	count	mean_rating
company_A	3628	4.908214
company_B	2615	4.852773

两家公司的平均评分看起来相近。公司 B 的经营时间略长，评分似乎也略低。

比较时间序列

进一步分析的良好起点是查看各公司按月的评分表现。首先，从数据中提取时间序列，然后将其截取到两家公司都在运营且评价活动足够活跃的区间。可通过可视化来确定这一点。如果连续数月数据出现很大缺口，那么基于数据得出的结论就不太可靠。

    company_a_ts <- xts(data_company_a$rating, data_company_a$date)
    colnames(company_a_ts) <- 'rating'
    company_b_ts <- xts(data_company_b$rating, data_company_b$date)
    colnames(company_b_ts) <- 'rating'

    open_ended_interval <- '2016-01-01/'

    # Subsetting the time series
    company_a_sts <- company_a_ts[open_ended_interval] 
    company_b_sts <- company_b_ts[open_ended_interval]
技术支持

现在可以用 xts 包的 apply.monthly() 进行月度平均。先为每家公司计算月均评分。时间序列的同一索引下可能有多条观测。要指定按某个字段（此处为 rating）取平均，需要传入 colMeans。

接着，别忘了将 length 传给 FUN 参数以获取月度条数。这是因为时间序列可被视为向量。每条评价都会让该向量长度加一，而 length 函数本质上就是统计评价数。

    company_a_month_avg <-  apply.monthly(company_a_sts, colMeans, na.rm = T)
    company_a_month_count  <-  apply.monthly(company_a_sts, FUN = length)

    company_b_month_avg <-  apply.monthly(company_b_sts, colMeans, na.rm = T)
    company_b_month_count  <-  apply.monthly(company_b_sts, FUN = length)
技术支持

随后，比较月度评分与条数。最简单的做法是分别绘制两家公司的月均评分与对应的月度数量，再将它们排成网格：

看起来公司 A 的高评分更为稳定。而公司 B 的月度评价数量在平庸评价之后尤其会出现明显的峰值。

是否存在不当操作的可能？

进一步聚合数据

既然您已经看到数据（尤其是公司 B）随时间变化相当剧烈，一个顺理成章的问题是：评价活动在一周内或一天内是如何分布的？

    full_data <- full_data %>%  
      filter(date >= start_date) %>% 
      mutate(weekday = weekdays(date, abbreviate = T),
             hour = hour(date))

    # Treat the weekdays as factor. 
    # The order is for the plotting only
    full_data$weekday <-  factor(full_data$weekday, 
                                 levels = c('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun'))
技术支持

如果按周几与一天中的小时来绘制评价数，您也会看到显著差异：

按一天中的小时拆分，两家竞争对手的差异也非常明显：

看起来白天的评价多于夜间。而公司 B 的下午时段评价出现了明显峰值。

原假设

这些模式似乎表明公司 B 存在异常。也许有些评价并非由用户撰写，而是出自“专业人士”。可以预期这些评价平均会比普通用户写的更高。由于公司 B 在工作日的评价活动更频繁，专业人士很可能会在这些日子写评价。您现在可以提出一个可据数据证伪的原假设。

工作日与周末撰写的评价之间不存在系统性差异。

为检验该假设，您将公司 B 的评价分为工作日与周末两类，并比较其平均评分

    hypothesis_data <- full_data %>% 
      mutate(is_weekend = ifelse(weekday %in% c('Sat', 'Sun'), 1, 0)) %>% 
      select(company, is_weekend, rating)

    hypothesis_data %>% 
      group_by(company, is_weekend) %>% 
      summarise(avg_rating = mean(rating)) %>% 
      spread(key = is_weekend, value = avg_rating) %>% 
      rename(weekday = '0', weekend = '1)
技术支持

company	weekday	weekend
company_A	4.898103	4.912176
company_B	4.864545	4.666667

这看起来差异很小，但会不会只是巧合？

您可以提取平均值之差：

    weekend_rating <- hypothesis_data %>% 
      filter(company == 'company_B') %>% 
      filter(is_weekend == 1) %>% 
      summarise(mean(rating)) %>% 
      pull()

    workday_rating <- hypothesis_data %>% 
      filter(company == 'company_B') %>% 
      filter(is_weekend == 0) %>% 
      summarise(mean(rating)) %>% 
      pull()

    (diff_work_we <- workday_rating - weekend_rating)
技术支持

    [1] 0.1978784
技术支持

如果工作日与周末确实没有差异，那么您只需打乱 is_weekend 标签，平均值之差应与现在同一量级。infer 包为这类“黑客统计”提供了便捷方法：

    permutation_tests <- hypothesis_data %>% 
      filter(company == 'company_B') %>% 
      specify(rating ~ is_weekend ) %>% 
      hypothesize(null = 'independence') %>% 
      generate(reps = 10000, type = 'permute') %>% 
      calculate(stat = 'diff in means', order = c(0,1))
技术支持

这里，您指定了要检验的关系与独立性的原假设，并让函数生成 10000 次置换，对每次计算评分均值差。现在，您可以计算通过偶然置换得到同等极端均值差的频率：

    permutation_tests %>% 
      summarise(p = mean(abs(stat)>= diff_work_we))
技术支持

    # A tibble: 1 x 1
          p
      <dbl>
    1 7e-04
技术支持

确实，观察到的效应由纯随机产生的可能性极小。这并不能证明存在不当行为，但十分可疑。比如，对公司 A 做同样的实验得到的 p 值为 0.561，这意味着非常有可能得到与观察值同样极端的结果，这显然并不足以否定原假设。

结论：别盲目信任评价

在本教程中，您编写了一个简单的程序，可以从 TrustPilot 网站抓取数据。数据被组织为整洁的数据表，为开展更多分析提供了可能。

作为示例，您抓取了同一行业两家公司的信息。您分析了它们的元数据，发现其中一家存在可疑模式。您通过假设检验显示：周几对其中一家的评分存在系统性影响。这提示评价可能被操纵，因为没有其他合理解释能说明为何会有这样的差异。对于另一家公司，您未能验证这一效应，但这并不意味着它们的评价就一定真实。

关于评价网站被虚假评价困扰的更多信息，可参见例如 Guardian 的报道。

想进一步学习在 R 中进行网络爬取？请查看我们的 R 中的网页抓取与数据解析教程。

主题

R 数据科学

主题

技术

R 中的网络爬虫：rvest 教程

使用 AI 探索

简介