extract-html-data.R

   1 library(stringr)
   2 library(XML)
   3
   4 ## This takes about 3:20 minutes on my X200 w/Debian Jessie 64-bit.
   5
   6
   7 ################################################################################
   8 ## Configuration
   9 ################################################################################
  10
  11 HTML.FILES.DIR <- "/opt/www.contemporaryartdaily.com"
  12
  13
  14 ################################################################################
  15 ## Regexes and text processing
  16 ################################################################################
  17
  18 # Some shows don't have artist, some have one, some have lists
  19 # Some weird whitespace in some Artists: </em> blocks,
  20 # and some artists don't end with </p>, so do it like this:
  21 ARTISTS <- "<em>Artists?:(.+?)</p>"
  22 ARTIST <- "([^,]+),?"
  23 VENUE <- "<em>Venue:(.+?)</p>"
  24 # C</em>entral nervous system... strip tags and remove label instead?
  25 EXHIBITION.TITLE <- "<em>Exhibition Title:(.+?)</p>"
  26 DATE <- "<em>Date:(.+?)</p>"
  27 TAG <- "<[^>]+>"
  28 PRESS.RELEASE <- "<em>Press Release:(.+)<!-- Start Sociable -->"
  29 IS.PRESS.RELEASE <- "<em>Press Release:"
  30 IMAGES <- "<div id='gallery-1'(.+?)<\\/div>"
  31 IMAGE <- "src=\"http://www.contemporaryartdaily.com/([^\"]+)\""
  32 PAGENUM <- "index.html\\?p=(.+)"
  33
  34 getImages <- function(text) {
  35     gallery <- str_extract(text, IMAGES)
  36     matches <- str_match_all(gallery, IMAGE)
  37     ## Failed match returns list of character(0)
  38     if(! identical(matches[[1]], character(0))) {
  39         matches[[1]][,2]
  40     } else {
  41         ## Return empty vector for no matches
  42         c()
  43     }
  44 }
  45
  46 cleanHTML <- function(html) {
  47     ## Remove html tags
  48     detagged <- str_trim(str_replace_all(html, TAG, ""))
  49     ## Trim so we end up with an empty string if it's just space
  50     cleaned <- str_trim(str_replace_all(detagged, "[\t\r\n ]", " "))
  51     ## xpathApply doesn't like being called on just space or on an empty string
  52     if(cleaned != "") {
  53         ## Convert all whitespace and linebreaks to spaces
  54         ## This is two operations in one, always convert the character that
  55         ##   looks like _ even if we decide not to convert others.
  56         ## Convert html entities to characters
  57         xpathApply(htmlParse(cleaned, asText=TRUE, encoding="UTF-8"),
  58                    "//body//text()",
  59                    xmlValue)[[1]]
  60     } else {
  61         ""
  62     }
  63 }
  64
  65 getSection <- function(text, exp) {
  66     section <- str_match(text, exp)[,2]
  67     if(! is.na(section)) {
  68         cleanHTML(section)
  69     } else {
  70         ""
  71     }
  72 }
  73
  74 getArtists <- function(text) {
  75     section <- getSection(text, ARTISTS)
  76     artist.list <- str_match_all(section, ARTIST)
  77     ## Failed match returns list of character(0)
  78     if(! identical(artist.list[[1]], character(0))) {
  79         artists <- str_trim(artist.list[[1]][,2])
  80         artists[artists != ""]
  81     } else {
  82         ## Return empty vector for no matches
  83         c()
  84     }
  85 }
  86
  87 getPageNum <- function(filepath) {
  88     as.integer(str_match(filepath, PAGENUM)[,2])
  89 }
  90
  91 getTitle <- function(text) {
  92     getSection(text, EXHIBITION.TITLE)
  93 }
  94
  95 getVenue <- function(text) {
  96     getSection(text, VENUE)
  97 }
  98
  99 getDate <- function(text) {
 100     getSection(text, DATE)
 101 }
 102
 103 getPressRelease <- function(text) {
 104     getSection(text, PRESS.RELEASE)
 105 }
 106
 107 isPressRelease <- function(text) {
 108     str_detect(text, IS.PRESS.RELEASE)
 109 }
 110
 111
 112 ################################################################################
 113 ## File processing
 114 ################################################################################
 115
 116 slurp <- function(filepath) {
 117     readChar(filepath, file.info(filepath)$size, useBytes=TRUE)
 118 }
 119
 120 files <- list.files(path=HTML.FILES.DIR,
 121                     pattern="index.html\\?p=[0-9]+$",
 122                     full.names=T,
 123                     recursive=FALSE)
 124
 125 shows <- NULL
 126 artists <- NULL
 127 images <- NULL
 128 press.releases <- NULL
 129
 130 ## Building with rbind is slow. Speed this up.
 131 ## If we use list() rather than data.frame(), strings aren't quoted by write.csv
 132 ## No idea.
 133
 134 for(filepath in files) {
 135     text <- slurp(filepath)
 136     if (isPressRelease(text)) {
 137         pagenum <- getPageNum(filepath)
 138
 139         press.release <- getPressRelease(text)
 140         press.releases <- rbind(press.releases,
 141                                 data.frame(page=pagenum,
 142                                            press.release=press.release))
 143
 144         shows <- rbind(shows, data.frame(page=pagenum,
 145                                          title=getTitle(text),
 146                                          venue=getVenue(text),
 147                                          date=getDate(text)))
 148         show.artists <- getArtists(text)
 149         if(length(show.artists) > 0) {
 150             artists.rows <- data.frame(page=rep(pagenum, length(show.artists)),
 151                                        artist=show.artists)
 152             artists <- rbind(artists, artists.rows)
 153         }
 154
 155         show.images <- getImages(text)
 156         if(length(show.images) > 0) {
 157             images.rows <- data.frame(page=rep(pagenum, length(show.images)),
 158                                       image=show.images)
 159             images <- rbind(images, images.rows)
 160         }
 161     }
 162 }
 163
 164
 165 ################################################################################
 166 ## Post-processing and cross-referencing
 167 ################################################################################
 168
 169 ## Get the start year for each show (or NA)
 170 shows <- data.frame(shows, year = strtoi(str_match(shows$date, "[0-9]{4}")))
 171 ## Fix errors in the data
 172 shows$year[shows$year == 1013] <- 2013
 173 shows$year[shows$year == 3013] <- 2013
 174
 175 ## Get the show start year for each artist's appearances
 176 artists <- data.frame(artists,
 177                       year = shows[match(artists$page, shows$page),]$year)
 178
 179 ## Venues. Some breakeage, removing Kunst* helps but we should really used
 180 ## named entity discovery for cities.
 181 venue.locations <- sapply(str_split(as.character(shows$venue), ","),
 182                           function(x) {str_trim(tail(x, n = 1))})
 183 venue.locations <- str_trim(str_replace(venue.locations, "Kunst[^ ]+", ""))
 184 shows <- data.frame(shows, location = venue.locations)
 185
 186 image.location <- sapply(images$page,
 187     function (x) {
 188         shows[shows$page == x, "location"]
 189     })
 190 location.images <- data.frame(location = image.location, image = images$image)
 191 location.images <- location.images[location.images$location != "",]
 192
 193 image.venue <- sapply(images$page,
 194     function (x) {
 195         shows[shows$page == x, "venue"]
 196     })
 197 venue.images <- data.frame(venue = image.venue, image = images$image)
 198 venue.images <- venue.images[venue.images$venue != "",]
 199
 200 image.year <- sapply(images$page,
 201     function (x) {
 202         shows[shows$page == x, "year"]
 203     })
 204 year.images <- data.frame(year = image.year, image = images$image)
 205
 206
 207 ################################################################################
 208 ## File writing
 209 ################################################################################
 210
 211 write.csv(shows, "csv/press-release-shows.csv", row.names=FALSE)
 212 write.csv(artists, "csv/press-release-artists.csv", row.names=FALSE)
 213 write.csv(images, "csv/press-release-images.csv", row.names=FALSE)
 214 write.csv(press.releases, "csv/press-release-texts.csv", row.names=FALSE)
 215 write.csv(location.images, "csv/location-images.csv", row.names=FALSE)
 216 write.csv(venue.images, "csv/venue-images.csv", row.names=FALSE)
 217 write.csv(year.images, "csv/year-images.csv", row.names=FALSE)