使用 RSelenium 和 rvest 抓取动态 Javascript 页面

Web-scraping dynamic Javascript page with RSelenium and rvest

我正在尝试从 this site 创建颜色 ID、描述和日期的数据框,它需要通过下拉菜单输入日期和月份,我认为 returns 会生成一个动态 JS页。我是编码新手,认为这将是一个有趣的玩具项目。我想使用 RSelenium 自动进行下拉选择,并使用 rvest 抓取生成的内容。我希望的数据帧结构如下所示:

description, date, meta
"paragraph about birthday", Jun 01, "DAFFODIL PANTONE 17-1512 POWERFUL KNOWING EXPRESSIVE"

我尝试首先使用 for 循环在一天中遍历一年中的每个月,然后逐步获取每个月的每一天。

我坚持只是让循环每个月迭代一次,然后获取内容。我可以先在这部分任务上使用一些概念上的帮助,感谢任何见解!

library(RSelenium)
library(rvest)
library(tidyverse)
library(xml2)

## first run: docker run -d -p 4445:4444 selenium/standalone-chrome
## open a new connection to Chrome
remDr <- RSelenium::remoteDriver(remoteServerAddr = "localhost",
                                 port = 4445L,
                                 browserName = "chrome")

remDr$open()
remDr$navigate("https://www.pantone.com/pages/iphone/iphone_colorstrology.html#___1__") #Entering our URL gets the browser to navigate to the page
remDr$screenshot(display = TRUE) 

#### create list of month/days
 month_day<- read_html(remDr$getPageSource()[[1]])
 page_i <- month_day %>%
   html_nodes(".list") %>%
   html_children() %>% 
   html_text()

months <- page_i[1:12]
months <- (paste("'", months,"'", sep=''))
days <- page_i[13:43]
days <- as.numeric(days)


## create an object for month xpath elements
for (m in months){
  elements <- paste0("//option[contains(text(),",months,")]")
}

## attempt at loop

total <- data.frame()

for (e in elements){
remDr$navigate("https://www.pantone.com/pages/iphone/iphone_colorstrology.html#___1__") 
      print(e)
      month <- remDr$findElement(using = 'xpath', e)
      month$clickElement()
      day <- remDr$findElement(using = 'xpath', "//select[@id='lstDay']//option[5]") ## arbitrarily picking the 5th of each month
      day$clickElement()
      submit <- remDr$findElement(using = 'xpath', "/html[1]/body[1]/form[1]/div[1]/a[1]")
      submit$clickElement()
      html <- read_html(remDr$getPageSource()[[1]])
      description <- html %>%  html_nodes(xpath = "//tr//tr[2]//td[1]") %>% html_text() %>% gsub("^\s+|\s+$", "", .)
      meta <- html %>% html_nodes(xpath = "//td[@id='tdBg']") %>%  html_text() %>% gsub("^\s+|\s+$", "", .) 
      date <- html %>% html_nodes(xpath = "//td[@id='bgHeaderDate']//div") %>%  html_text() %>% gsub("^\s+|\s+$", "", .)
      df <- data.frame(cbind(description,meta,date))
      total <- rbind(total, df)
}

没有收到任何错误,但每次的结果都出乎意料。它会在单个 month/day 组合上重复,例如 Jan05 * 12 次或 jan05 * 3 次,Apr 05 *3 次,等等

我会回来更新这个以采纳我的建议。导航到该页面,然后在浏览器中打开开发工具,例如 Chrome,使用 F12 并转到网络选项卡。然后,select 一个月和日期,然后点击 立即查看。您会看到流量出现在网络选项卡中。该页面发出 POST xhr 请求以获取您在单击视图图标后看到的内容。

POST 请求本身非常简单,并且有一个正文(表格),其中包含您 select 编辑的月份和日期:

因此,您可以模仿 POST 请求,然后解析响应。您提到的日期的示例可以是:

library(rvest)

body <- list('month' = 6,'day' = 1)
url <- 'https://www.pantone.com/pages/iphone/iphone_colorstrology_results.aspx'
page <- html_session(url) %>%
  rvest:::request_POST(url, body = body, encode = "form") %>%
  read_html()

date <- page %>% html_node('table table td') %>% html_text() %>% 
  gsub('^\s+|\s+$|[\r\n\t]', '', .)
description <- page %>% html_node('tr:nth-of-type(2) div') %>% html_text() %>% 
  gsub('^\s+|\s+$|[\r\n\t]', '', .)
meta <- page %>% html_nodes('#tdBg span') %>% html_text()

df <- data.frame(date, description, meta)

现在,这就是我稍后会重温的内容,上面的内容可以转换成一个函数,其中 return 是一个列表或 df,可以组合成一个最终的数据帧。您可以提前生成每个主体并将其作为参数传递给函数。我会考虑使用 Session 对象 http Session 来提高 re-using 当前连接的效率。月份和日期可以在 loop/nestd 循环期间在表单正文中更新 - 取决于它们的生成方式。我是 R 的新手,知道它没有字典,但也许它有命名列表或类似的列表,您可以借此从原始页面中抓取月:可能的值关联以用于循环。我欢迎向更有经验的 R 人员学习如何实现上述目标——我的 R 知识存在一些差距,无法完成今天要解决的问题。有人可能 post 类似的答案会有所帮助。


正在生成 POST 请求主体:

查看标准年份的下拉列表,因此您可以在嵌套的 for 循环中生成所需的 POST 正文。我使用 1,12 几个月,并根据标准年份润滑到 return 个月的天数:

library(lubridate)

for(i in seq(1,12)){
  date <- as.Date(gsub('placeholder',i, "2019-placeholder-01"), "%Y-%m-%d")
  days <- days_in_month(date)[[1]]
  for(j in seq(1,days)){
    body = list('month' = i,'day' = j)
    # pass body to function or add to an iterable for later looping
  }
}

找到合理的解决方案!它并不完美,但它让我比以前更接近。我最终根据@QHarr 的建议编写了一个函数并使用了他们的 rvest 模式:

library(rvest)

colorstrology <- function(i,j){

  body <- list('month' = i,'day' = j)
  url <- 'https://www.pantone.com/pages/iphone/iphone_colorstrology_results.aspx'
  page <- html_session(url) %>%
    rvest:::request_POST(url, body = body, encode = "form") %>%
    read_html()

  date <- page %>% html_node('table table td') %>% html_text() %>% 
    gsub('^\s+|\s+$|[\r\n\t]', '', .)
  description <- page %>% html_node('tr:nth-of-type(2) div') %>% html_text() %>% 
    gsub('^\s+|\s+$|[\r\n\t]', '', .)
  meta <- page %>% html_nodes('#tdBg span') %>% html_text()

  df <- data.frame(date, description, meta)
}



months <- c(1:12)
days <- c(1:31)

df <- data.frame(date, description, meta)
for (m in months){
  for (d in days){
    temp <- colorstrology(m,d)
    df <- rbind(temp, df)
}
}