Очистка с помощью rvest - в комплекте с NA при отсутствии тега

Я хочу проанализировать этот HTML: и получить из него следующие элементы:

а) тег p с class: "normal_encontrado".
б) div с class: "price".

Иногда тег p отсутствует в некоторых продуктах. В этом случае к вектору, собирающему текст из этих узлов, следует добавить NA.

Идея состоит в том, чтобы иметь 2 вектора одинаковой длины и после их соединения образовать data.frame. Любые идеи?

Часть HTML:

<html>
<head></head>
<body>

<div class="product_price" id="product_price_186251">
  <p class="normal_encontrado">
    S/. 2,799.00
  </p>

  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 2,299.00
  </div>    
</div>

<div class="product_price" id="product_price_232046">
  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 4,999.00
  </div>
</div>
</body>
</html>

Код R:

library(rvest)

page_source <- read_html("r.html")

r.precio.antes <- page_source %>%
html_nodes(".normal_encontrado") %>%
html_text()

r.precio.actual <- page_source %>%
html_nodes(".price") %>%
html_text()

r web-scraping tags rvest
person Omar Gonzales    schedule 21.10.2015    source источник
comment
Что-то вроде этого может быть полезно - R dataframe из xml, когда значения несколько или отсутствуют   -  person thelatemail    schedule 21.10.2015

Ответы (4)


arrow_upward
3
arrow_downward

Если тег не найден, rvest возвращает символ (0). Итак, предполагая, что вы найдете не более одной текущей и одной регулярной цены в каждом div.product_price, вы можете использовать это:

pacman::p_load("rvest", "dplyr")

get_prices <- function(node){
  r.precio.antes <- html_nodes(node, 'p.normal_encontrado') %>% html_text
  r.precio.actual <- html_nodes(node, 'div.price') %>% html_text

  data.frame(
    precio.antes = ifelse(length(r.precio.antes)==0, NA, r.precio.antes),
    precio.actual = ifelse(length(r.precio.actual)==0, NA, r.precio.actual), 
    stringsAsFactors=F
  )

}

doc <- read_html('test.html') %>% html_nodes("div.product_price")
lapply(doc, get_prices) %>%
  rbind_all

Отредактировано: я неправильно понял входные данные, поэтому изменил скрипт, чтобы он работал только с одной HTML-страницей.

person BjaRule    schedule 29.10.2015
comment
Более понятный способ, спасибо. Мне также нравится метод Гротендика, но я никогда не использовал пакет XML. - person Omar Gonzales; 01.11.2015

arrow_upward
4
arrow_downward

Используя пакет XML, проанализируйте ввод с помощью xmlTreeParse, а затем используйте xpathSApply для взаимодействия с узлами product_price класса div. Для каждого такого узла анонимная функция получает значение подузлов div и p. Результирующая матрица символов m переделывается в фрейм данных DF, и столбцы очищаются, удаляя любой символ, не являющийся точкой или цифрой, а также удаляя любую точку, за которой следует не цифра. Преобразуйте результат в числовой. Обратите внимание, что для пропущенного случая p не требуется специальной обработки.

# input

Lines <- '<html>
<head></head>
<body>

<div class="product_price" id="product_price_186251">
  <p class="normal_encontrado">
    S/. 2,799.00
  </p>

  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 2,299.00
  </div>    
</div>

<div class="product_price" id="product_price_232046">
  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 4,999.00
  </div>
</div>
</body>
</html>'

# code to read input and produce a data.frame

library(XML)
doc <- xmlTreeParse(Lines, asText = TRUE, useInternalNodes = TRUE)

m <- xpathSApply(doc, "//div[@class = 'product_price']", function(node) {
  list(p = xmlValue(node[["p"]]), div = xmlValue(node[["div"]])) })

DF <- as.data.frame(t(m), stringsAsFactors = FALSE) # rework into data frame
DF[] <- lapply(DF, function(x) as.numeric(gsub("[^.0-9]|[.]\\D", "", x))) # clean

Результат:

> DF
     p  div
1 2799 2299
2   NA 4999
person G. Grothendieck    schedule 26.10.2015

arrow_upward
3
arrow_downward

Поднимитесь на один уровень выше своей цели и lapply над каждым родительским элементом:

library(xml2)
library(rvest)

pg <- read_html('<html>
<head></head>
<body>

<div class="product_price" id="product_price_186251">
  <p class="normal_encontrado">
    S/. 2,799.00
  </p>

  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 2,299.00
  </div>    
</div>

<div class="product_price" id="product_price_232046">
  <div id="WC_CatalogEntryDBThumbnailDisplayJSPF_10461_div_10" class="price">
    S/. 4,999.00
  </div>
</div>
</body>
</html>')

prod <- html_nodes(pg, "div.product_price")
do.call(rbind, lapply(prod, function(x) {
  norm <- tryCatch(xml_text(xml_node(x, "p.normal_encontrado")),
                   error=function(err) {NA})
  price <- tryCatch(xml_text(xml_node(x, "div.price")),
                    error=function(err) {NA})
  data.frame(norm, price, stringsAsFactors=FALSE)
}))

##                     norm                  price
## 1 \n    S/. 2,799.00\n   \n    S/. 2,299.00\n  
## 2                   <NA> \n    S/. 4,999.00\n

Понятия не имею, хотели ли вы обрезать струны или сделать что-нибудь еще, но эти махинации довольно просты.

person hrbrmstr    schedule 25.10.2015

arrow_upward
1
arrow_downward

Возможно, это не самый идиоматический способ сделать это, но вы можете использовать lapply для узлов .product_price следующим образом:

r.precio.antes <- page_source %>% html_nodes(".product_price") %>%
  lapply(. %>% html_nodes(".normal_encontrado") %>% html_text() %>% 
     ifelse(identical(., character(0)), NA, .)) %>% unlist

Это вернет NA всякий раз, когда элемент .normal_encontrado не найден.

r.precio.antes
# [1] "\n                    S/. 2,799.00\n                "
# [2] NA  

length(r.precio.antes) # 2

Если бы я хотел разработать код, чтобы сделать его более понятным, сначала я изолирую .product_price узлы:

product_nodes <- page_source %>% html_nodes(".product_price")

Тогда я мог бы использовать lapply более традиционным способом:

r.precio.antes <- lapply(product_nodes, function(pn) {
  pn %>% html_nodes(".normal_encontrado") %>% html_text()
})
r.precio.antes <- unlist(r.precio.antes)

Вместо этого я использую синтаксис magrittr для lapply, см., Например, конец параграфа «Функциональные последовательности» здесь .

Последнее препятствие заключается в том, что если элемент не найден, он вернет character(0), а не NA, как вы хотели. Итак, я добавляю ifelse(identical(., character(0)), NA, .)) к трубе внутри лабиринта, чтобы это исправить.

person cocquemas    schedule 23.10.2015
comment
Не могли бы вы объяснить код? Особенно эта часть: lapply(. %>% html_nodes(".normal_encontrado") почему. там (после lapply)? А также: (function(x) ifelse(identical(x, character(0)), NA, x)) ). Спасибо. - person Omar Gonzales; 24.10.2015
comment
На самом деле, я понял, что можно просто использовать ifelse(identical(., character(0)), NA, .)) вместо синтаксиса (function(x) ...). Я разработал код и пояснения. Это понятнее? - person cocquemas; 24.10.2015