case-studies.Rmd

# Case studies

This is a collection of spreadsheets found in the wild.  Some are as easy to
mung as the examples; others are harder because their structure is less
consistent.

Seeing and reading the code will help you guage how much work is still involved
in munging a spreadsheet.  Attempting them for yourself and checking the model
answer will help you to hone your instincts.

The spreadsheet files are provided in the `smungs` package on GitHub.  Install
as follows.

```{r eval = FALSE}
# install.packages("devtools") # If you don't already have it
devtools::install_github("nacnudus/smungs")
```

#### Other case studies elsewhere

* [YouTube videos](https://www.youtube.com/channel/UCrw0ScBCFSbk_lgkjyg4ucw)
* [Worked example code](https://github.com/nacnudus/ukfarm)
* [Blog post on `readr::melt_csv()`](https://nacnudus.github.io/duncangarmonsway/posts/2018-12-29-meltcsv/)


## Australian Marriage Survey

[![Tweet by Miles McBain about tidying the Australian Marriage Survey results
with
R](images/ozmarriage_tweet.png)](https://twitter.com/MilesMcBain/status/932257990253645829)

These are the results of a survey in 2017 by the Australian Bureau of Statistics
that asked, "Should the law be changed to allow same-sex couples to marry?"

There are two tables with structures that are similar but different.  [Download
the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/ozmarriage.xlsx?raw=true).
[Original source](http://www.abs.gov.au/ausstats/abs@.nsf/mf/1800.0).

![](images/ozmarriage1.png)

![](images/ozmarriage2.png)

### The full code listing

```{r}
cells <- xlsx_cells(smungs::ozmarriage)
formats <- xlsx_formats(smungs::ozmarriage)

table_1  <-
  cells %>%
  dplyr::filter(sheet == "Table 1", row >= 5L, !is_blank) %>%
  mutate(character = str_trim(character)) %>%
  behead("up-left", "population") %>%
  behead("up-left", "response") %>%
  behead("up", "unit") %>%
  behead("left", "state") %>%
  arrange(row, col) %>%
  select(row, data_type, numeric, state, population, response, unit) %>%
  spatter(unit) %>%
  select(-row)

state <-
  cells %>%
  dplyr::filter(sheet == "Table 2",
                row >= 5L,
                col == 1L,
                !is_blank,
                formats$local$font$bold[local_format_id]) %>%
  select(row, col, state = character)

table_2 <-
  cells %>%
  dplyr::filter(sheet == "Table 2",
                row >= 5L,
                !is_blank) %>%
  mutate(character = str_trim(character)) %>%
  behead("up-left", "population") %>%
  behead("up-left", "response") %>%
  behead("up", "unit") %>%
  behead("left", "territory") %>%
  enhead(state, "up-left") %>%
  arrange(row, col) %>%
  select(row, data_type, numeric, state, territory, population, response,
         unit) %>%
  spatter(unit) %>%
  select(-row)

all_tables <- bind_rows("Table 1" = table_1, "Table 2" = table_2, .id = "sheet")
all_tables
```

### Step by step

#### Table 1

The first rows, up to the column-headers, must be filtered out.  The trailing
rows below the table will be treated us row-headers, but because there is no
data to join them to, they will be dropped automatically.  That is handy,
because otherwise we would have to know where the bottom of the table is, which
is likely to change with later editions of the same data.

Apart from filtering the first rows, the rest of this example is 'textbook'.

```{r}
cells <- xlsx_cells(smungs::ozmarriage)

table_1  <-
  cells %>%
  dplyr::filter(sheet == "Table 1", row >= 5L, !is_blank) %>%
  mutate(character = str_trim(character)) %>%
  behead("up-left", "population") %>%
  behead("up-left", "response") %>%
  behead("up", "unit") %>%
  behead("left", "state") %>%
  arrange(row, col) %>%
  select(row, data_type, numeric, state, population, response, unit) %>%
  spatter(unit) %>%
  select(-row)

table_1
```

#### Table 2

This is like Table 1, broken down by division rather than by state.  The snag is
that the states are named in the same column as their divisions.  Because the
state names are formatted in bold, we can isolate them from the division names.
With them out of the way, unpivot the rest of the table as normal, and then use
`enhead()` at the end to join the state names back on.

Since tables 1 and 2 are so similar structurally, they might as well be joined
into one.

```{r}
cells <- xlsx_cells(smungs::ozmarriage)
formats <- xlsx_formats(smungs::ozmarriage)

state <-
  cells %>%
  dplyr::filter(sheet == "Table 2",
                row >= 5L,
                col == 1L,
                !is_blank,
                formats$local$font$bold[local_format_id]) %>%
  select(row, col, state = character)

table_2 <-
  cells %>%
  dplyr::filter(sheet == "Table 2",
                row >= 5L,
                !is_blank) %>%
  mutate(character = str_trim(character)) %>%
  behead("up-left", "population") %>%
  behead("up-left", "response") %>%
  behead("up", "unit") %>%
  behead("left", "territory") %>%
  enhead(state, "up-left") %>%
  arrange(row, col) %>%
  select(row, data_type, numeric, state, territory, population, response,
         unit) %>%
  spatter(unit) %>%
  select(-row)

all_tables <-
  bind_rows("Table 1" = table_1, "Table 2" = table_2, .id = "sheet") %>%
  select(sheet, state, territory, population, response, `%`, no.)
all_tables
```

## Vaccinations {#vaccinations}

[![Tweet by Bob Rudis challenging R users to tidy a particular spreadsheet](images/vaccinations_tweet.png)](https://twitter.com/hrbrmstr/status/890200287356620806)

This is a real-life example of [implied multiples](#implied-multiples).  Implied
multiples look like a single table, but many of the headers appear more than
once.  There is a dominant set of headers that are on the same 'level' (e.g. in
the same row) as the other headers.

In this case, there is a small multiple for each year of data.  The year headers
are highlighted in yellow in the screenshot.

![](images/vaccinations.png)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/vaccinations.xlsx?raw=true).
[Original
source](https://www.cdc.gov/vaccines/imz-managers/coverage/schoolvaxview/data-reports/vacc-coverage.html).

The way to unpivot this is to realise that the year cells represent two
different things: the year (obviously) and a statistic (percentage vaccinated).
It would have been easier to unpivot if the years had been put into a separate
row of headers, so we will pretend that that was in fact the case.

1. Filter for the year cells and store in a variable to `enhead()` later.
1. `behead()` everything else as usual, and then overwite the year headers with
   `percentage_vaccinated`.
1. `enhead()` the year cells.

```{r}
cells <- xlsx_cells(smungs::vaccinations, "SVV Coverage Trend Data")

years <-
  cells %>%
  dplyr::filter(row == 3,
                col >= 1,
                str_detect(character, "20[0-9]{2}-[0-9]{2}")) %>%
  select(row, col, year = character)
years

cells %>%
  select(row, col, data_type, character) %>%
  behead("up-left", "series") %>%
  behead("up-left", "population") %>%
  behead("left", "state") %>%
  behead("up", "header") %>%
  mutate(header = if_else(str_detect(header, "20[0-9]{2}-[0-9]{2}"),
                          "percent_vaccinated",
                          header),
         header = str_replace_all(str_to_lower(header), " ", "_")) %>%
  enhead(years, "up-left") %>%
  select(row, series, population, state, year, header, character) %>%
  spatter(header, character) %>%
  select(series, population, state, year, percent_vaccinated, percent_surveyed,
         everything())
```

## US Crime {#us-crime}

[![Tweet by Alberto Cairo about a spreadsheet that violates Hadley Wickham's principles of tidy data](images/us-crime-tweet.jpg)](https://twitter.com/albertocairo/status/963133927530483712)

These are two tables of numbers of crimes in the USA, by state and category of
crime.  Confusingly, they're numbered Table 2 and Table 3.  Table 1 exists but
isn't included in this case study because it is so straightforward.

### Table 2 {#us-crime-2}

![](images/us-crime-2.jpg)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/us-crime-2.xlsx?raw=true).
[Original
source](https://ucr.fbi.gov/crime-in-the-u.s/2016/crime-in-the-u.s.-2016/tables/table-2).

#### Simple version {#us-crime-2-simple}

This is straightforward to import as long as you don't care to organise the
hierarchies of crimes and areas.  For example, Conneticut is within the division
New England, which itself is within the region Northeast, but if you don't need
to express those relationships in the data then you can ignore the bold
formatting.

The only slight snag is that the header cells in row 5 are blank.  There is a
header for the units "Rate per 100,000", but no header for the units "Count" --
the cells in those positions are empty.  It would be a problem if the cells
didn't exist at all, because `behead("up", "unit")` wouldn't be able to associate
data cells with missing header cells.  Fortunately they do exist (because they
have formatting), they are just empty or `NA`.  To make sure they aren't
ignored, use `drop_na = FALSE` in `behead()`, and then later fill the blanks in
the `units` column with `"Count"`.

```{r}
cells <-
  xlsx_cells(smungs::us_crime_2) %>%
  mutate(character = map_chr(character_formatted,
                             ~ ifelse(is.null(.x), character, .x$character[1])),
         character = str_replace_all(character, "\n", " "))

cells %>%
  dplyr::filter(row >= 4L) %>%
  select(row, col, data_type, character, numeric) %>%
  behead("up-left", "crime") %>%
  behead("up", "unit", drop_na = FALSE) %>%
  behead("left-up", "area") %>%
  behead("left", "year") %>%
  behead("left", "population") %>%
  dplyr::filter(year != "Percent change") %>%
  mutate(unit = if_else(unit == "", "Count", unit)) %>%
  select(row, data_type, numeric, unit, area, year, population, crime) %>%
  spatter(unit) %>%
  select(-row)
```

#### Complex version {#us-crime-2-complex}

If you do mind about grouping states within divisions within regions, and
crimes within categories, then you have more work to do using `enhead()` rather
than `behead()`.

1. Select the header cells at each level of the hierarchy and store them in
   their own variables.  For example, filter for the bold cells in row 4, which
   are the categories of crimes, and store them in the `categories` variable.
1. Select the data cells, and use `enhead()` to join them to the headers.

In fact the headers `unit`, `year`, `population` can be handled by `behead()`,
because they aren't hierarchichal, so only the variables `category`, `crime`,
`region`, `division` and `state` are handled by `enhead()`.

```{r}
cells <-
  xlsx_cells(smungs::us_crime_2) %>%
  mutate(character = map_chr(character_formatted,
                             ~ ifelse(is.null(.x), character, .x$character[1])),
         character = str_replace_all(character, "\n", " "))

formats <- xlsx_formats(smungs::us_crime_2)

categories <-
  cells %>%
  dplyr::filter(row == 4L,
                data_type == "character",
                formats$local$font$bold[local_format_id]) %>%
  select(row, col, category = character)
categories

crimes <-
  cells %>%
  dplyr::filter(row == 4L, data_type == "character") %>%
  mutate(character = if_else(character %in% categories$category,
                             "Total",
                             character)) %>%
  select(row, col, crime = character)
crimes

regions <-
  cells %>%
  dplyr::filter(row >= 6L,
                col == 1L,
                data_type == "character",
                formats$local$font$bold[local_format_id]) %>%
  select(row, col, region = character)
regions

divisions <-
  cells %>%
  dplyr::filter(row >= 6L,
                col == 1L,
                data_type == "character",
                !formats$local$font$bold[local_format_id],
                !str_detect(character, "^ {5}")) %>%
  select(row, col, division = character)
divisions

states <-
  cells %>%
  dplyr::filter(row >= 6L,
                col == 1L,
                data_type == "character") %>%
  mutate(character = if_else(str_detect(character, "^ {5}"),
                             str_trim(character),
                             "Total")) %>%
  select(row, col, state = character)
states

cells %>%
  dplyr::filter(row >= 5L, col >= 2L) %>%
  select(row, col, data_type, character, numeric) %>%
  behead("up", "unit") %>%
  behead("left", "year") %>%
  behead("left", "population") %>%
  enhead(categories, "up-left") %>%
  enhead(crimes, "up-left") %>%
  enhead(regions, "left-up") %>%
  enhead(divisions, "left-up", drop = FALSE) %>%
  enhead(states, "left-up", drop = FALSE) %>%
  dplyr::filter(year != "Percent change") %>%
  select(value = numeric, category, crime, region, division, state, year, population)
```

### Table 3 {#us-crime-3}

![](images/us-crime-3.jpg)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/us-crime-3.xlsx?raw=true).
[Original
source](https://ucr.fbi.gov/crime-in-the-u.s/2016/crime-in-the-u.s.-2016/tables/table-3).

This table is confusing to humans, let alone computers.  The `Population` column
seems to belong to a different table altogether, so that's how we'll treat it.

1. Import the `Population` column and the state/area headers to the left.
1. Import the crime-related column headers, and the state/area headers to the left.
1. Join the two datasets.

The `statistic` header ends up having blank values due to the cells being blank,
so these are manually filled in.

The hierarchy of crime (e.g. 'robbery' is within 'violent crime') is ignored.
That would be handled in the same way as for [Table 2](#us-crime-2).

```{r}
cells <-
  xlsx_cells(smungs::us_crime_3) %>%
  mutate(character = map_chr(character_formatted,
                             ~ ifelse(is.null(.x), character, .x$character[1])),
         character = str_replace_all(character, "\n", " "))

population <-
  cells %>%
  dplyr::filter(row >= 5L, col <= 4L) %>%
  behead("left-up", "state") %>%
  behead("left-up", "area") %>%
  behead("left", "statistic", drop_na = FALSE) %>%
  mutate(statistic = case_when(is.na(statistic) ~ "Population",
                               statistic == "" ~ "Population",
                               TRUE ~ str_trim(statistic))) %>%
  dplyr::filter(data_type == "numeric",
                !str_detect(area, regex("total", ignore_case = TRUE)),
                statistic != "Estimated total") %>%
  select(data_type, numeric, state, area, statistic) %>%
  spatter(statistic)

crime <-
  cells %>%
  dplyr::filter(row >= 4, col != 5L) %>%
  behead("left-up", "state") %>%
  behead("left-up", "area") %>%
  behead("left", "statistic", formatters = list(character = str_trim)) %>%
  behead("up", "crime") %>%
  dplyr::filter(data_type == "numeric",
                !str_detect(area, regex("total", ignore_case = TRUE)),
                !is.na(statistic),
                statistic != "") %>%
  mutate(statistic = case_when(statistic == "Area actually reporting" ~ "Actual",
                               statistic == "Estimated total" ~ "Estimated")) %>%
  select(data_type, numeric, state, area, statistic, crime) %>%
  spatter(statistic)

left_join(population, crime)
```

## Toronto Transit Commission

[![Tweet by Sharla Gelfand about tidying Toronto Transit Commission data with
R](images/toronto-tweet.png)](https://twitter.com/sharlagelfand/status/996739127562391552)

This table shows the number of trips recorded on the Toronto Transit Commission
per year, by type of ticket, person, vehicle, and weeday/weekend/holiday.

Sharla Gelfand's annotated screenshot explains the structure, and see her
excellent [blog post](https://sharlagelfand.netlify.com/posts/tidy-ttc/) for how
she wrangled it with standard tidyverse tools.  I show here an alternative
method with tidyxl and unpivotr.

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/toronto_transit.xlsx?raw=true).
[Original
source](https://portal0.cf.opendata.inter.sandbox-toronto.ca/dataset/ttc-ridership-analysis).

### The full code listing

```{r}
cells <-
  xlsx_cells(smungs::toronto_transit) %>%
  dplyr::filter(!is_blank, row >= 6)

fare <-
  cells %>%
  dplyr::filter(col == 2,
                !str_detect(character, "^ "),
                !str_detect(character, "TOTAL")) %>%
  select(row, col, fare = character)

cells %>%
  behead("up", "year", formatters = list(character = str_trim)) %>%
  behead("left-up", "context") %>%
  behead("left", "media", formatters = list(character = str_trim)) %>%
  enhead(fare, "left-up") %>%
  dplyr::filter(!str_detect(media, "TOTAL")) %>%
  separate(year, c("year", "note"), sep = " ", fill = "right") %>%
  select(year, context, fare, media, count = numeric)
```

### Step by step

Although the annotations point out that there are really three separate tables
(`WHO`, `WHERE` and `WHEN`), they can be imported as one.

Column 2 has two levels of headers in it: the fare in bold ("ADULT", "BUS",
etc.), and the media used to pay for it indented by a few spaces ("TOKENS",
"WEEKLY PASS", etc.).

Because `behead()` can't distinguish between different levels of headers in the
same column, we need to put the bold fare headers into a separate variable on
their own, and `enhead()` them back onto the rest of the table later.

Unfortunately the fare headers in the "WHEN" context aren't bold, so rather than
filter for bold headers, instead we filter for headers that aren't indented by
spaces.  We also filter out any "TOTAL" headers.

```{r}
cells <-
  xlsx_cells(smungs::toronto_transit) %>%
  dplyr::filter(!is_blank, row >= 6)

fare <-
  cells %>%
  dplyr::filter(col == 2,
                !str_detect(character, "^ "), # Filter out indented headers
                !str_detect(character, "TOTAL")) %>% # Filteroout totals
  select(row, col, fare = character)
fare

ttc <-
  cells %>%
  behead("up", "year") %>%
  behead("left-up", "context") %>%
  behead("left", "media") %>%
  enhead(fare, "left-up") %>%
  dplyr::filter(!str_detect(media, "TOTAL")) %>%
  select(year, context, fare, media, count = numeric)
ttc
```

There's a bit more cosmetic cleaning to do.  The indentation can be trimmed from
the `media` and the `year` headers, and the asterisk removed from the year `2015
*`.

```{r}
ttc %>%
  mutate(year = str_trim(year), media = str_trim(media)) %>%
  separate(year, c("year", "note"), sep = " ", fill = "right") %>%
  select(-note)
```

## Ground water

[![Tweet by Beck Frydenborg about tidying data with
R](images/groundwater-tweet.png)](https://twitter.com/beckfrydenborg/status/974787652573646849)

If the cells containing `U` didn't exist, then this spreadsheet would be a
textbook example of unpivoting a pivot table.  There are two rows of column
headers, as well as two columns of row headers, so you would use `behead()` for
each header.

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/groundwater.xlsx?raw=true).
Synthesised from the [original
tweet](https://twitter.com/beckfrydenborg/status/974787652573646849).

```{r}
x <-
  xlsx_cells(smungs::groundwater) %>%
  dplyr::filter(!is_blank) %>%
  select(row, col, data_type, character, numeric) %>%
  behead("up-left", "sample-type") %>%
  behead("up-left", "site") %>%
  behead("left", "parameter") %>%
  behead("left", "unit")
x
```

So what to do about the `U` cells?  We don't know what they mean, but perhaps
they are some kind of flag, to inform the interpretation of the numbers.  If
that's the case, then they should appear in the same row of the final data frame
as the numbers.

Something like `tidyr::spread()` would work, except that
instead of spreading the values in just one column, we need to spread the values
in both the `character` and `numeric` columns, depending on the value in the
`data_type` column.  This is what `spatter()` is for.

```{r}
x %>%
  select(-col) %>%
  spatter(data_type) %>%
  select(-row)
```

Compare that with the results of `spread()`, which can only spread one value
column at a time.

```{r}
x %>%
  select(-col) %>%
  spread(data_type, character)
```

```{r}
x %>%
  select(-col) %>%
  spread(data_type, numeric)
```

## Cashflows

[![Blog post by Davis Vaughan about tidying cashflow data with
unpivotr](images/cashflows-blog.png)](https://blog.davisvaughan.com/post/tidying-excel-cash-flow-spreadsheets-in-r/)

Davis Vaughan kindly
[blogged](https://blog.davisvaughan.com/post/tidying-excel-cash-flow-spreadsheets-in-r/)
about using unpivotr to tidy spreadsheets of cashflows.  Here is an example
using unpivotr's new, more powerful syntax.

![](images/cashflows.png)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/cashflows.xlsx?raw=true).
[Original
source](https://github.com/DavisVaughan/tidying-excel-cashflows-blog-companion).

The techniques are

1. Filter out `TOTAL` rows
2. Create an ordered factor of the months, which follow the fiscal year April to
   March.  This is done using the fact that the months appear in column-order as
   well as year-order, so we can sort on `col`.

```{r}
cashflows <-
  xlsx_cells(smungs::cashflows) %>%
  dplyr::filter(!is_blank, row >= 4L) %>%
  select(row, col, data_type, character, numeric) %>%
  behead("up", "month") %>%
  behead("left-up", "main_header") %>%
  behead("left", "sub_header") %>%
  dplyr::filter(month != "TOTALS",
                !str_detect(sub_header, "otal")) %>%
  arrange(col) %>%
  mutate(month = factor(month, levels = unique(month), ordered = TRUE),
         sub_header = str_trim(sub_header)) %>%
  select(main_header, sub_header, month, value = numeric)
cashflows
```

To prove that the data is correct, we can reproduce the total row at the bottom
('Ending Cash Balance').

```{r}
cashflows %>%
  group_by(main_header, month) %>%
  summarise(value = sum(value)) %>%
  arrange(month, main_header) %>%
  dplyr::filter(str_detect(main_header, "ows")) %>%
  mutate(value = if_else(str_detect(main_header, "Income"), value, -value)) %>%
  group_by(month) %>%
  summarise(value = sum(value)) %>%
  mutate(value = cumsum(value))
```

## School performance

A certain United States state education department provides its schools with
spreadsheets of statistics.  I bet the children in that state get a great
education, because there's at least one R enthusiast on the staff whose
curiosity has never left them.

### Sheet 1

The first sheet is an example of [mixed headers in column 1 being distinguished
by bold
formatting](#mixed-levels-of-headers-in-the-same-rowcolumn-distinguished-by-formatting).
Filter for the bold cells in column 1 and assign them to a variable.  Then
`behead()` the other headers, and finally `enhead()` the bold headers back on.

![](images/school1.png)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/school.xlsx?raw=true),
modified from an original source provided to the author.

```{r}
cells <-
  xlsx_cells(smungs::school, "Sheet1") %>%
  dplyr::filter(!is_blank)

formats <- xlsx_formats(smungs::school)

bold_headers <-
  cells %>%
  dplyr::filter(col == 1L, formats$local$font$bold[local_format_id]) %>%
  select(row, col, bold_header = character)

cells %>%
  behead("up-left", "metric") %>%
  behead("left", "plain-header") %>%
  enhead(bold_headers, "left-up") %>%
  select(row, data_type, numeric, metric, `plain-header`) %>%
  spatter(metric) %>%
  select(-row)
```

### Sheet 2

The second sheet is variation on [two clear rows of text column headers, left
aligned](#two-clear-rows-of-text-column-headers-left-aligned-1).  Here, there
are three rows of colum headers.  The first row is left-aligned, and the second
and third rows are directly above the data cells. But the second row is blank
above columns D and E.  That doesn't actually matter; in the output, `header_2`
will be `NA` for data from those columns.

![](images/school2.png)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/school.xlsx?raw=true),
modified from an original source provided to the author.

```{r}
xlsx_cells(smungs::school, "Sheet2") %>%
  select(row, col, address, data_type, character, numeric, is_blank) %>%
  mutate(character = str_trim(character)) %>%
  behead("up-left", "header_1") %>%
  behead("up", "header_2") %>%
  behead("up", "header_3") %>%
  behead("left", "classroom") %>%
  dplyr::filter(!is_blank, !is.na(header_3)) %>%
  arrange(col, row)
```

### Sheet 3

The third sheet is variation on [two clear rows of text column headers, left
aligned](#two-clear-rows-of-text-column-headers-left-aligned-1), with a nasty
catch.  The creator of the spreadsheet didn't merge cells to make space for more
words.  They didn't even 'centre across selection' (which is sometimes safer
than merging cells).  Instead, they wrote each word on a separate line, meaning
it is ambiguous whether a cell part of another header, or a header in its own
right.

![](images/school3.png)

[Download the
file](https://github.com/nacnudus/smungs/blob/master/inst/extdata/school.xlsx?raw=true),
modified from an original source provided to the author.

Compare columns C and D.  Column C has a single header, "Avg Years w/ Class
Data", written across four cells.  Column D has two levels of headers, "Years in
MA" first, then "% 3+" nested within it (and written across two cells).  There's
no way for a machine to tell which cells are whole headers, and which are parts
of headers.

We can deal with this by first treating every cell as a header in its own right,
and then concatenating the headers of rows 2 to 5.  Using the `"up-left"` direction,
headers like "Years in MA" in cell D4 will be carried to the right, which is
good.  Unfortunately so will headers like "# Students" in cell B2, which we'll
just have to put up with.

```{r}
cells <-
  xlsx_cells(smungs::school, "Sheet3") %>%
  dplyr::filter(!is_blank) %>%
  select(row, col, data_type, character, numeric)

x <-
  cells %>%
  behead("left", "place") %>%
  behead("up-left", "category") %>%
  behead("up-left", "metric-cell-1") %>% # Treat every cell in every row as a header
  behead("up-left", "metric-cell-2") %>%
  behead("up-left", "metric-cell-3") %>%
  behead("up-left", "metric-cell-4") %>%
  behead("up-left", "metric-cell-5")
glimpse(x)
```

Above you can see that every cell in every header row has been treated as a
header in its own right, e.g. `"Avg"` is a level-2 header, and `"Years w/"` is a
level-3 header.  The next step is to paste them together into a single header.

```{r}
x <-
  x %>%
  # Replace NA with "" otherwise unite() will spell it as "NA".
  # This is a common irritation.
  # https://stackoverflow.com/questions/13673894/suppress-nas-in-paste
  mutate_at(vars(starts_with("metric-cell-")), replace_na, "") %>%
  unite("metric", starts_with("metric-cell-"), sep = " ") %>%
  mutate(metric = str_trim(metric))
glimpse(x)
```

Now the headers are manageable.  They aren't perfect -- the `"# Students"`
header has leaked into `"# Students Avg Years w/ Class Data"`, but that can be
cleaned up manually later.  At least `"# Students Avg Years w/ Class Data"` is
within the `"STUDENTS"` category, which is the hard part.

Spreading this data is the final step to make it easy to work with.

```{r}
x %>%
  select(place, category, metric, numeric) %>%
  spread(place, numeric) %>%
  print(n = Inf)
```