R/text.R

Defines functions collapse_whitespace html_text_inline tag_margin is_inline html_text_block html_text2.xml_missing html_text2.xml_node html_text2.xml_nodeset html_text2.xml_document html_text2 html_text

Documented in html_text html_text2

#' Get element text
#'
#' @description
#' There are two ways to retrieve text from a element: `html_text()` and
#' `html_text2()`. `html_text()` is a thin wrapper around [xml2::xml_text()]
#' which returns just the raw underlying text. `html_text2()` simulates how
#' text looks in a browser, using an approach inspired by JavaScript's
#' [innerText()](https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/innerText).
#' Roughly speaking, it converts `<br />` to `"\n"`, adds blank lines
#' around `<p>` tags, and lightly formats tabular data.
#'
#' `html_text2()` is usually what you want, but it is much slower than
#' `html_text()` so for simple applications where performance is important
#' you may want to use `html_text()` instead.
#'
#' @inheritParams xml2::xml_text
#' @importFrom xml2 xml_text
#' @return A character vector the same length as `x`
#' @examples
#' # To understand the difference between html_text() and html_text2()
#' # take the following html:
#'
#' html <- minimal_html(
#'   "<p>This is a paragraph.
#'     This another sentence.<br>This should start on a new line"
#' )
#'
#' # html_text() returns the raw underlying text, which includes whitespace
#' # that would be ignored by a browser, and ignores the <br>
#' html %>% html_element("p") %>% html_text() %>% writeLines()
#'
#' # html_text2() simulates what a browser would display. Non-significant
#' # whitespace is collapsed, and <br> is turned into a line break
#' html %>% html_element("p") %>% html_text2() %>% writeLines()
#'
#' # By default, html_text2() also converts non-breaking spaces to regular
#' # spaces:
#' html <- minimal_html("<p>x&nbsp;y</p>")
#' x1 <- html %>% html_element("p") %>% html_text()
#' x2 <- html %>% html_element("p") %>% html_text2()
#'
#' # When printed, non-breaking spaces look exactly like regular spaces
#' x1
#' x2
#' # But aren't actually the same:
#' x1 == x2
#' # Which you can confirm by looking at their underlying binary
#' # representaion:
#' charToRaw(x1)
#' charToRaw(x2)
#' @export
html_text <- function(x, trim = FALSE) {
  xml_text(x, trim = trim)
}

#' @export
#' @rdname html_text
#' @param preserve_nbsp Should non-breaking spaces be preserved? By default,
#'   `html_text2()` converts to ordinary spaces to ease further computation.
#'   When `preserve_nbsp` is `TRUE`, `&nbsp;` will appear in strings as
#'   `"\ua0"`. This often causes confusion because it prints the same way as
#'   `" "`.
html_text2 <- function(x, preserve_nbsp = FALSE) {
  UseMethod("html_text2")
}

#' @export
html_text2.xml_document <- function(x, preserve_nbsp = FALSE) {
  body <- xml2::xml_find_first(x, ".//body")
  html_text2(body, preserve_nbsp = preserve_nbsp)
}

#' @export
html_text2.xml_nodeset <- function(x, preserve_nbsp = FALSE) {
  vapply(
    x,
    html_text2,
    preserve_nbsp = preserve_nbsp,
    FUN.VALUE = character(1)
  )
}

#' @export
html_text2.xml_node <- function(x, preserve_nbsp = FALSE) {
  text <- PaddedText$new()
  html_text_block(x, text, preserve_nbsp = preserve_nbsp)
  text$output()
}

#' @export
html_text2.xml_missing <- function(x, preserve_nbsp = FALSE) {
  NA_character_
}

# Algorithm roughly inspired by
# https://html.spec.whatwg.org/multipage/dom.html#the-innertext-idl-attribute
# but following deatils in
# https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model/Whitespace#How_does_CSS_process_whitespace
html_text_block <- function(x, text, preserve_nbsp = FALSE) {
  if (xml2::xml_type(x) == "text") {
    text$add_text(collapse_whitespace(xml2::xml_text(x), preserve_nbsp))
  } else if (is_inline(x)) {
    text$add_text(html_text_inline(x, preserve_nbsp))
  } else {
    children <- xml2::xml_contents(x)
    n <- length(children)

    for (i in seq_along(children)) {
      child <- children[[i]]
      name <- xml2::xml_name(child)
      margin <- tag_margin(name)

      text$add_margin(margin)
      html_text_block(child, text, preserve_nbsp = preserve_nbsp)
      switch(name,
        tr = if (i != n) text$add_text("\n"),
        th = ,
        td = if (i != n) text$add_text("\t"),
        br = text$add_text("\n")
      )
      text$add_margin(margin)
    }
  }
}

is_inline <- function(x) {
  children <- xml2::xml_children(x)
  !any(xml2::xml_name(children) %in% c(block_tag, table_tag))
}

block_tag <- c(
  # https://developer.mozilla.org/en-US/docs/Web/HTML/Block-level_elements
  "address", "article", "aside", "blockquote", "details", "dialog", "dd", "div",
  "dl", "dt", "fieldset", "figcaption", "figure", "footer", "form", "h1", "h2",
  "h3", "h4", "h5", "h6", "header", "hgroup", "hr", "li", "main", "nav", "ol",
  "p", "pre", "section", "table", "ul",
  "caption"
)

table_tag <- c("tr", "td", "th")

tag_margin <- function(name) {
  # + caption
  if (name == "p") {
    2L
  } else if (name %in% block_tag) {
    1L
  } else {
    0L
  }
}

html_text_inline <- function(x, preserve_nbsp = FALSE) {
  children <- xml2::xml_contents(x)
  n <- length(children)
  if (n == 0) {
    return("")
  }

  text <- xml2::xml_text(children)
  is_br <- xml2::xml_name(children) == "br"

  line_num <- cumsum(c(TRUE, is_br[-n]))
  lines <- split(text, line_num)
  lines <- vapply(lines, paste0, collapse = "", FUN.VALUE = character(1))

  if (xml2::xml_name(x) != "pre") {
    lines <- collapse_whitespace(lines, preserve_nbsp)
  }

  has_br <- unname(tapply(is_br, line_num, any))
  paste0(lines, ifelse(has_br, "\n", ""), collapse = "")
}

# https://drafts.csswg.org/css-text/#white-space-phase-1
collapse_whitespace <- function(x, preserve_nbsp = FALSE) {
  # Remove leading and trailing whitespace
  x <- gsub("(^[ \t\n]+)|([ \t\n]+$)", "", x, perl = TRUE)

  # Convert any whitespace sequence to a space
  match <- if (preserve_nbsp) "[\t\n ]+" else "[\t\n \u00a0]+"
  x <- gsub(match, " ", x, perl = TRUE)

  x
}

# Text with line break padding in between blocks, collapsing breaks
# similarly to css margin collapsing rules
PaddedText <- R6::R6Class("PaddedText", list(
  text = character(),
  lines = 0,
  i = 1L,

  add_margin = function(n) {
    # Don't add breaks before encountering text
    if (self$i == 1) {
      return()
    }

    self$lines <- max(self$lines, n)
  },

  convert_breaks = function() {
    if (self$lines == 0) {
      return()
    }

    self$text[[self$i]] <- strrep("\n", self$lines)
    self$i <- self$i + 1
    self$lines <- 0
  },

  add_text = function(x) {
    # Ignore empty strings
    if (identical(x, "")) {
      return()
    }

    self$convert_breaks()
    self$text[[self$i]] <- x
    self$i <- self$i + 1L
  },

  output = function() {
    paste(self$text, collapse = "")
  }
))

Try the rvest package in your browser

Any scripts or data that you put into this service are public.

rvest documentation built on Aug. 20, 2022, 1:08 a.m.