The mass power outages on the U.S. west coast provided an opportunity to test out my R 3.4.0 installation and share a quick idiom for turning portions of an XML document into a data frame — generically — using xml2.

Packages we’ll need:

library(xml2)
library(httr)
library(leaflet)
library(htmltools)
library(widgetframe)
library(tidyverse)

This is where the power outage data is. You can grab this on your own and make your own map whenver you want!

res <- GET("https://m.sce.com/nrc/AOC/AOC_Location_Report.xml")
doc <- content(res, as="parsed", encoding="UTF-8")

Here’s what that document looks like. Scroll around a bit to see that there are definitely groups of nodes we can capture separately but it’d be a royal pain to write extraction code for every set of nodes.

 
 

To setup the generic extraction idiom, we first setup two helper functions.

The first is just a shorthand way to extract all targeted nodes into a vector.

xtrct <- function(doc, target) { xml_find_all(doc, target) %>% xml_text() %>% trimws() }

The next one will take a document or node list and a target node then extract the first one and find the children. Then it will use those child node names to extract them each into a separate vector (which becomes a named list) and then turns those into a data frame and makes sane types.

There is a big assumption that all child nodes exist and there aren’t multiple descendents. This can be made more generic, but this idiom handles many, many use-caes.

xtrct_df <- function(doc, top) {
  xml_find_first(doc, sprintf(".//%s", top)) %>%
    xml_children() %>%
    xml_name() %>%
    map(~{
      xtrct(doc, sprintf(".//%s/%s", top, .x)) %>%
        list() %>%
        set_names(tolower(.x))
    }) %>%
    flatten_df() %>%
    readr::type_convert()
}

Now, we can use that to extract data frames from that XML document:

county_df <- xtrct_df(doc, "COUNTY")
city_df <- xtrct_df(doc, "CITY")
zipcode_df <- xtrct_df(doc, "ZIPCODE")
district_df <- xtrct_df(doc, "DISTRICT")
sector_df <- xtrct_df(doc, "SECTOR")
incident_df <- xtrct_df(doc, "INCIDENT")

We can peek at a couple of them:

glimpse(county_df)
## Observations: 9
## Variables: 5
## $ county_name       <chr> "Kern", "Los Angeles", "Not Available", "Ora...
## $ nbr_incidents     <int> 1, 19, 1, 5, 5, 8, 1, 5, 2
## $ nbr_cust_affected <int> 54, 843, 0, 314, 126, 137, 19, 88, 26
## $ centroid_x        <dbl> -118.7291, -118.3511, NA, -117.7793, -115.99...
## $ centroid_y        <dbl> 35.34358, 33.81972, NA, 33.21832, 33.74648, ...

glimpse(incident_df)
## Observations: 47
## Variables: 23
## $ incident_id           <int> 116586404, 116552979, 116558720, 1165618...
## $ incident_type         <chr> "QI", "PO", "PO", "PO", "PO", "PO", "PO"...
## $ fac_job_status_cd     <chr> "W", "D", "D", "D", "D", "D", "D", "W", ...
## $ oan_no                <int> 820783, 818185, 818762, 818958, 819061, ...
## $ outage_start_datetime <chr> "4/21/2017 12:13:56 PM", "4/21/2017 8:06...
## $ version_dt            <chr> "4/21/2017 1:34:09 PM", "4/21/2017 1:34:...
## $ last_chng_datetime    <chr> "4/21/2017 12:48:55 PM", "4/21/2017 9:00...
## $ est_clu_datetime      <chr> "4/21/2017 3:00:00 PM", "4/21/2017 5:00:...
## $ memo_cause_cd         <chr> "16", "07", "07", "07", "07", "07", "07"...
## $ memo_cause_cd_desc    <chr> "Equipment Problems", "Upgrading Equipme...
## $ crew_status_cd        <chr> "04", "04", "04", "04", "04", "04", "04"...
## $ crew_status_cd_desc   <chr> "Work is in progress.", "Work is in prog...
## $ result_cd             <chr> "0", "01", "01", "01", "01", "01", "01",...
## $ result_cd_desc        <chr> "Not Available", "Enhancing Reliability"...
## $ nbr_cust_affected     <int> 12, 124, 23, 1, 106, 66, 50, 17, 5, 21, ...
## $ zip_code              <chr> "92553", "92630", "90043", "93563", "928...
## $ county_name           <chr> "Riverside", "Orange", "Los Angeles", "L...
## $ city_name             <chr> "Moreno Valley", "Lake Forest", "View Pa...
## $ district_no           <int> 77, 43, 44, 73, 48, 42, 27, 32, 39, 39, ...
## $ sector_no             <chr> "VALLEY", "ELLIS", "EL NIDO", "LUGO", "V...
## $ ert_cd                <chr> "06", "06", "07", "06", "06", "07", "06"...
## $ centroid_x            <dbl> -117.2741, -117.6956, -118.3328, -117.68...
## $ centroid_y            <dbl> 33.92560, 33.62584, 33.99711, 34.37945, ...

And, now we’ll use Leaflet to make our own outage map:

incident_df %>%
  mutate(popup_text =
           sprintf("%s<br/><br/>%s / %s County<br/><br/><b>Customers impacted:</b> %s<br/><b>Cause:</b> %s<br/><b>Status:</b> %s",
                   htmlEscape(outage_start_datetime),
                   htmlEscape(city_name),
                   htmlEscape(county_name),
                   htmlEscape(nbr_cust_affected),
                   htmlEscape(memo_cause_cd_desc),
                   htmlEscape(crew_status_cd_desc))) %>%
  rename(lat=centroid_y, lng=centroid_x) %>%
  leaflet(height="600px") %>%
  addProviderTiles(providers$Esri.WorldStreetMap) %>%
  addCircleMarkers(weight=1, radius=~sqrt(nbr_cust_affected)*2, color = "#bd0026",
                   fillColor="#fc4e2a", opacity=1, fillOpacity=0.5, popup = ~popup_text)%>%
  setView(mean(range(incident_df$centroid_x)),
          mean(range(incident_df$centroid_y)), zoom=7) %>%
  frameWidget()
IycgLS0tCiMnIHRpdGxlOiAiRWFzeSBYTUwgdG8gRGF0YSBGcmFtZXMgd2l0aCB4bWwyIHdoaWxlIG1hcHBpbmcgcG93ZXIgb3V0YWdlcyIKIycgZGF0ZTogIiIKIycgYXV0aG9yOiAiQGhyYnJtc3RyIgojJyBvdXRwdXQ6CiMnICAgaHRtbF9kb2N1bWVudDoKIycgICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKIycgLS0tCiMrIGluY2x1ZGU9RkFMU0UKa25pdHI6Om9wdHNfY2h1bmskc2V0KG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0UsIGNvbGxhcHNlPVRSVUUpCgojJyBUaGUgbWFzcyBwb3dlciBvdXRhZ2VzIG9uIHRoZSBVLlMuIHdlc3QgY29hc3QgcHJvdmlkZWQgYW4gb3Bwb3J0dW5pdHkgdG8gdGVzdCBvdXQKIycgbXkgUiAzLjQuMCBpbnN0YWxsYXRpb24gYW5kIHNoYXJlIGEgcXVpY2sgaWRpb20gZm9yIHR1cm5pbmcgcG9ydGlvbnMgb2YgYW4gWE1MCiMnIGRvY3VtZW50IGludG8gYSBkYXRhIGZyYW1lIOKAlCBnZW5lcmljYWxseSDigJQgdXNpbmcgYHhtbDJgLgojJwojJyBQYWNrYWdlcyB3ZSdsbCBuZWVkOgpsaWJyYXJ5KHhtbDIpCmxpYnJhcnkoaHR0cikKbGlicmFyeShsZWFmbGV0KQpsaWJyYXJ5KGh0bWx0b29scykKbGlicmFyeSh3aWRnZXRmcmFtZSkKbGlicmFyeSh0aWR5dmVyc2UpCgojJyBUaGlzIGlzIHdoZXJlIHRoZSBwb3dlciBvdXRhZ2UgZGF0YSBpcy4gWW91IGNhbiBncmFiIHRoaXMgb24geW91ciBvd24gYW5kCiMnIG1ha2UgeW91ciBvd24gbWFwIHdoZW52ZXIgeW91IHdhbnQhCgpyZXMgPC0gR0VUKCJodHRwczovL20uc2NlLmNvbS9ucmMvQU9DL0FPQ19Mb2NhdGlvbl9SZXBvcnQueG1sIikKZG9jIDwtIGNvbnRlbnQocmVzLCBhcz0icGFyc2VkIiwgZW5jb2Rpbmc9IlVURi04IikKCiMnIEhlcmUncyB3aGF0IHRoYXQgZG9jdW1lbnQgbG9va3MgbGlrZS4gU2Nyb2xsIGFyb3VuZCBhIGJpdCB0byBzZWUgdGhhdCB0aGVyZQojJyBhcmUgZGVmaW5pdGVseSBncm91cHMgb2Ygbm9kZXMgd2UgY2FuIGNhcHR1cmUgc2VwYXJhdGVseSBidXQgaXQnZCBiZSBhCiMnIHJveWFsIHBhaW4gdG8gd3JpdGUgZXh0cmFjdGlvbiBjb2RlIGZvciBldmVyeSBzZXQgb2Ygbm9kZXMuCiMnCiMnIDxkaXYgc3R5bGU9ImhlaWdodDo2cHg7Zm9udC1zaXplOjZweDsiPiAmbmJzcDsgPC9kaXY+CgojJyA8ZGl2IHN0eWxlPSJvdmVyZmxvdzogc2Nyb2xsOyBoZWlnaHQ6NDEwcHg7IHBhZGRpbmctYm90dG9tOjMwcHg7IGJvcmRlcjogMC41cHggc29saWQgIzJiMmIyYiI+CgojKyBlY2hvPUZBTFNFCnhtbHZpZXc6OnhtbF90cmVlX3ZpZXcoZG9jLCBoZWlnaHQ9IjQwMHB4IikKCiMnIDwvZGl2PgoKIycgPGRpdiBzdHlsZT0icGFkZGluZy10b3A6MTBweCI+ICZuYnNwOyA8L2Rpdj4KIycKIycgVG8gc2V0dXAgdGhlIGdlbmVyaWMgZXh0cmFjdGlvbiBpZGlvbSwgd2UgZmlyc3Qgc2V0dXAgdHdvIGhlbHBlciBmdW5jdGlvbnMuCiMnCiMnIFRoZSBmaXJzdCBpcyBqdXN0IGEgc2hvcnRoYW5kIHdheSB0byBleHRyYWN0IGFsbCB0YXJnZXRlZCBub2RlcyBpbnRvIGEgdmVjdG9yLgoKIysgZWNobz1UUlVFCnh0cmN0IDwtIGZ1bmN0aW9uKGRvYywgdGFyZ2V0KSB7IHhtbF9maW5kX2FsbChkb2MsIHRhcmdldCkgJT4lIHhtbF90ZXh0KCkgJT4lIHRyaW13cygpIH0KCiMnIFRoZSBuZXh0IG9uZSB3aWxsIHRha2UgYSBkb2N1bWVudCBvciBub2RlIGxpc3QgYW5kIGEgdGFyZ2V0IG5vZGUgdGhlbgojJyBleHRyYWN0IHRoZSBmaXJzdCBvbmUgYW5kIGZpbmQgdGhlIGNoaWxkcmVuLiBUaGVuIGl0IHdpbGwgdXNlIHRob3NlCiMnIGNoaWxkIG5vZGUgbmFtZXMgdG8gZXh0cmFjdCB0aGVtIGVhY2ggaW50byBhIHNlcGFyYXRlIHZlY3RvciAod2hpY2ggYmVjb21lcwojJyBhIG5hbWVkIGxpc3QpIGFuZCB0aGVuIHR1cm5zIHRob3NlIGludG8gYSBkYXRhIGZyYW1lIGFuZCBtYWtlcyBzYW5lCiMnIHR5cGVzLgojJwojJyBUaGVyZSBpcyBhICpiaWcqIGFzc3VtcHRpb24gdGhhdCBhbGwgY2hpbGQgbm9kZXMgZXhpc3QgYW5kIHRoZXJlIGFyZW4ndAojJyBtdWx0aXBsZSBkZXNjZW5kZW50cy4gVGhpcyBjYW4gYmUgbWFkZSBtb3JlIGdlbmVyaWMsIGJ1dCB0aGlzIGlkaW9tIGhhbmRsZXMKIycgbWFueSwgbWFueSB1c2UtY2Flcy4KCnh0cmN0X2RmIDwtIGZ1bmN0aW9uKGRvYywgdG9wKSB7CiAgeG1sX2ZpbmRfZmlyc3QoZG9jLCBzcHJpbnRmKCIuLy8lcyIsIHRvcCkpICU+JQogICAgeG1sX2NoaWxkcmVuKCkgJT4lCiAgICB4bWxfbmFtZSgpICU+JQogICAgbWFwKH57CiAgICAgIHh0cmN0KGRvYywgc3ByaW50ZigiLi8vJXMvJXMiLCB0b3AsIC54KSkgJT4lCiAgICAgICAgbGlzdCgpICU+JQogICAgICAgIHNldF9uYW1lcyh0b2xvd2VyKC54KSkKICAgIH0pICU+JQogICAgZmxhdHRlbl9kZigpICU+JQogICAgcmVhZHI6OnR5cGVfY29udmVydCgpCn0KCiMnIE5vdywgd2UgY2FuIHVzZSB0aGF0IHRvIGV4dHJhY3QgZGF0YSBmcmFtZXMgZnJvbSB0aGF0IFhNTCBkb2N1bWVudDoKCmNvdW50eV9kZiA8LSB4dHJjdF9kZihkb2MsICJDT1VOVFkiKQpjaXR5X2RmIDwtIHh0cmN0X2RmKGRvYywgIkNJVFkiKQp6aXBjb2RlX2RmIDwtIHh0cmN0X2RmKGRvYywgIlpJUENPREUiKQpkaXN0cmljdF9kZiA8LSB4dHJjdF9kZihkb2MsICJESVNUUklDVCIpCnNlY3Rvcl9kZiA8LSB4dHJjdF9kZihkb2MsICJTRUNUT1IiKQppbmNpZGVudF9kZiA8LSB4dHJjdF9kZihkb2MsICJJTkNJREVOVCIpCgojJyBXZSBjYW4gcGVlayBhdCBhIGNvdXBsZSBvZiB0aGVtOgoKZ2xpbXBzZShjb3VudHlfZGYpCgpnbGltcHNlKGluY2lkZW50X2RmKQoKIycgQW5kLCBub3cgd2UnbGwgdXNlIExlYWZsZXQgdG8gbWFrZSBvdXIgb3duIG91dGFnZSBtYXA6CgojKyB4bWwycG93ZXJfbGVhZmxldAppbmNpZGVudF9kZiAlPiUKICBtdXRhdGUocG9wdXBfdGV4dCA9CiAgICAgICAgICAgc3ByaW50ZigiJXM8YnIvPjxici8+JXMgLyAlcyBDb3VudHk8YnIvPjxici8+PGI+Q3VzdG9tZXJzIGltcGFjdGVkOjwvYj4gJXM8YnIvPjxiPkNhdXNlOjwvYj4gJXM8YnIvPjxiPlN0YXR1czo8L2I+ICVzIiwKICAgICAgICAgICAgICAgICAgIGh0bWxFc2NhcGUob3V0YWdlX3N0YXJ0X2RhdGV0aW1lKSwKICAgICAgICAgICAgICAgICAgIGh0bWxFc2NhcGUoY2l0eV9uYW1lKSwKICAgICAgICAgICAgICAgICAgIGh0bWxFc2NhcGUoY291bnR5X25hbWUpLAogICAgICAgICAgICAgICAgICAgaHRtbEVzY2FwZShuYnJfY3VzdF9hZmZlY3RlZCksCiAgICAgICAgICAgICAgICAgICBodG1sRXNjYXBlKG1lbW9fY2F1c2VfY2RfZGVzYyksCiAgICAgICAgICAgICAgICAgICBodG1sRXNjYXBlKGNyZXdfc3RhdHVzX2NkX2Rlc2MpKSkgJT4lCiAgcmVuYW1lKGxhdD1jZW50cm9pZF95LCBsbmc9Y2VudHJvaWRfeCkgJT4lCiAgbGVhZmxldChoZWlnaHQ9IjYwMHB4IikgJT4lCiAgYWRkUHJvdmlkZXJUaWxlcyhwcm92aWRlcnMkRXNyaS5Xb3JsZFN0cmVldE1hcCkgJT4lCiAgYWRkQ2lyY2xlTWFya2Vycyh3ZWlnaHQ9MSwgcmFkaXVzPX5zcXJ0KG5icl9jdXN0X2FmZmVjdGVkKSoyLCBjb2xvciA9ICIjYmQwMDI2IiwKICAgICAgICAgICAgICAgICAgIGZpbGxDb2xvcj0iI2ZjNGUyYSIsIG9wYWNpdHk9MSwgZmlsbE9wYWNpdHk9MC41LCBwb3B1cCA9IH5wb3B1cF90ZXh0KSU+JQogIHNldFZpZXcobWVhbihyYW5nZShpbmNpZGVudF9kZiRjZW50cm9pZF94KSksCiAgICAgICAgICBtZWFuKHJhbmdlKGluY2lkZW50X2RmJGNlbnRyb2lkX3kpKSwgem9vbT03KSAlPiUKICBmcmFtZVdpZGdldCgpCg==