---
title: "Data Visualization"
author: "Alison Presmanes Hill"
date: "October 27, 2016"
output:
  html_document:
    highlight: pygments
    keep_md: yes
    number_sections: yes
    smart: no
    theme: journal
    toc: yes
    toc_depth: 2
    toc_float: yes
  pdf_document:
    toc: yes
subtitle: Lab 5
always_allow_html: yes
---
```{r setup, include = FALSE, cache = FALSE}
knitr::opts_chunk$set(error = TRUE, comment = NA, warnings = FALSE, errors = FALSE, messages = FALSE, tidy = FALSE, eval = TRUE)
```

```{r load_packages, include = FALSE}
suppressWarnings(suppressMessages(library(dplyr)))
suppressWarnings(suppressMessages(library(ggplot2)))
suppressWarnings(suppressMessages(library(tidyr)))
suppressWarnings(suppressMessages(library(knitr)))
suppressWarnings(suppressMessages(library(DT)))
suppressWarnings(suppressMessages(library(xtable)))
suppressWarnings(suppressMessages(library(broom)))
suppressWarnings(suppressMessages(library(pnwflights14)))
suppressWarnings(suppressMessages(library(pixiedust)))
```


# Making tables in Markdown

Sometimes you may just want to type in a table in Markdown and ignore R. Four kinds of tables may be used. The first three kinds presuppose the use of a fixed-width font, such as Courier. The fourth kind can be used with proportionally spaced fonts, as it does not require lining up columns. All of the below will render when typed *outside* of an R code chunk since these are based on `pandoc` being used to render your markdown document. Note that these should all work whether you are knitting to either html or PDF.


## Simple table

This code for a simple table:


```{r eval = FALSE}
  Right     Left     Center     Default
-------     ------ ----------   -------
     12     12        12            12
    123     123       123          123
      1     1          1             1

Table:  Demonstration of simple table syntax.
```

Produces this simple table:

  Right     Left     Center     Default
-------     ------ ----------   -------
     12     12        12            12
    123     123       123          123
      1     1          1             1

Table:  Demonstration of simple table syntax.

The headers and table rows must each fit on one line. Column alignments are determined by the position of the header text relative to the dashed line below it:3

* If the dashed line is flush with the header text on the right side but extends beyond it on the left, the column is right-aligned.
* If the dashed line is flush with the header text on the left side but extends beyond it on the right, the column is left-aligned.
* If the dashed line extends beyond the header text on both sides, the column is centered.
* If the dashed line is flush with the header text on both sides, the default alignment is used (in most cases, this will be left).
* The table must end with a blank line, or a line of dashes followed by a blank line.

The column headers may be omitted, provided a dashed line is used to end the table.

## Multi-line tables

This code for a multi-line table:

```{r eval = FALSE}
-------------------------------------------------------------
 Centered   Default           Right Left
  Header    Aligned         Aligned Aligned
----------- ------- --------------- -------------------------
   First    row                12.0 Example of a row that
                                    spans multiple lines.

  Second    row                 5.0 Here's another one. Note
                                    the blank line between
                                    rows.
-------------------------------------------------------------

Table: Here's the caption. It, too, may span
multiple lines.
```

Produces this multi-line table:

-------------------------------------------------------------
 Centered   Default           Right Left
  Header    Aligned         Aligned Aligned
----------- ------- --------------- -------------------------
   First    row                12.0 Example of a row that
                                    spans multiple lines.

  Second    row                 5.0 Here's another one. Note
                                    the blank line between
                                    rows.
-------------------------------------------------------------

Table: Here's the caption. It, too, may span
multiple lines.

## Grid tables

This code for a grid table:

```{r eval = FALSE}
: Sample grid table.

+---------------+---------------+--------------------+
| Fruit         | Price         | Advantages         |
+===============+===============+====================+
| Bananas       | $1.34         | - built-in wrapper |
|               |               | - bright color     |
+---------------+---------------+--------------------+
| Oranges       | $2.10         | - cures scurvy     |
|               |               | - tasty            |
+---------------+---------------+--------------------+
```

Produces this grid table:

: Sample grid table.

+---------------+---------------+--------------------+
| Fruit         | Price         | Advantages         |
+===============+===============+====================+
| Bananas       | $1.34         | - built-in wrapper |
|               |               | - bright color     |
+---------------+---------------+--------------------+
| Oranges       | $2.10         | - cures scurvy     |
|               |               | - tasty            |
+---------------+---------------+--------------------+

Alignments are not supported, nor are cells that span multiple columns or rows. 

## Pipe tables

This code for a pipe table:

```{r eval = FALSE}
| Right | Left | Default | Center |
|------:|:-----|---------|:------:|
|   12  |  12  |    12   |    12  |
|  123  |  123 |   123   |   123  |
|    1  |    1 |     1   |     1  |

  : Demonstration of pipe table syntax.
```

Produces this pipe table:

| Right | Left | Default | Center |
|------:|:-----|---------|:------:|
|   12  |  12  |    12   |    12  |
|  123  |  123 |   123   |   123  |
|    1  |    1 |     1   |     1  |

  : Demonstration of pipe table syntax.


# Making tables in R

If you want to make tables that include R output (like output from functions like means, variances, or output from models), there are two steps: 

1. Get the numbers you need in tabular format; then
2. Render that information in an aesthetically-pleasing way.

This section covers (1), which easy in R. But, although there are some nice options for (2) within R Markdown via various packages, I am not dogmatic about doing *everything* in R Markdown, especially things like (2).

## `dplyr`

We'll use the `pnwflights14` package to practice our `dplyr` skills. We need to download the package from github using `devtools`.

```{r eval = FALSE}
# once per machine
install.packages("devtools")
devtools::install_github("ismayc/pnwflights14")
```

Now, we need to load the `flights` dataset from the `pnwflights14` package.

```{r eval = FALSE}
# once per work session
data("flights", package = "pnwflights14")
```


Brief HLO of the `flights` data:
```{r}
dim(flights)
glimpse(flights)
names(flights)
```

### `dplyr::select`

Use select to specify which columns in a dataframe you'd like to keep **by name**. Heretofore, this was not possible in base R! In base R, this can only be achieved using numeric variable positions. But most of the time, you keep track of your variables by name (like `carrier`) rather than position (the 8th column).

```{r use-dplyr-select}
# keep these 2 cols
mini_flights <- flights %>% 
  select(carrier, flight)
glimpse(mini_flights)

# keep first five cols
first_five <- flights %>% 
  select(year, month, day, dep_time, dep_delay)
glimpse(first_five)

# alternatively, specify range
first_five <- flights %>% 
  select(year:dep_delay)
glimpse(first_five)
```

We can also choose the columns we want by negation, that is, you can specify which columns to drop instead of keep. This way, all variables **not** listed are kept.

```{r drop-select}
# we can also use negation
all_but_year <- flights %>% 
  select(-year)
glimpse(all_but_year)
```




`dplyr::select` comes with several other helper functions...

```{r dplyr-select-helpers}
depart <- flights %>% 
  select(starts_with("dep_"))
glimpse(depart)

times <- flights %>% 
  select(contains("time"))
glimpse(times)

# here I am not creating a new dataframe
flights %>%
  select(-contains("time"))

delays <- flights %>% 
  select(ends_with("delay"))
glimpse(delays)
```

One of my favorite select helper functions is `everything()`, which allows you to use select to keep **all** your variables, but easily rearrange the columns without having to list all the variables to keep/drop.

```{r dplyr-select-everything}
new_order <- flights %>% 
  select(origin, dest, everything())
head(new_order)

# with negation
new_order2 <- flights %>% 
  select(origin, dest, everything(), -year)
head(new_order2)
```


We can also rename variables within select.

```{r rename-select}
flights2 <- flights %>%
  select(tail_num = tailnum, everything())
head(flights2)
```

If you don't want to move the renamed variables within your dataframe, you can use the `rename` function.

```{r rename}
flights3 <- flights %>%
  rename(tail_num = tailnum)
glimpse(flights3)
```

### `dplyr::filter`



```{r dplyr-filter}
# flights taking off from PDX
pdx <- flights %>% 
  filter(origin == "PDX")
head(pdx)

# january flights from PDX
pdx_jan <- flights %>% 
  filter(origin == "PDX", month == 1) # the comma is an "and"
head(pdx_jan)

# flights to ATL (Atlanta) or BNA (Nashville)
to_south <- flights %>% 
  filter(dest == "ATL" | dest == "BNA") %>% # | is "or"
  select(origin, dest, everything())
head(to_south)

# flights from PDX to ATL (Atlanta) or BNA (Nashville)
pdx_to_south <- flights %>% 
  filter(origin == "PDX", dest == "ATL" | dest == "BNA") %>% # | is "or"
  select(origin, dest, everything())
head(pdx_to_south)

# alternatively, using group membership
south_dests <- c("ATL", "BNA")
pdx_to_south2 <- flights %>% 
  filter(origin == "PDX", dest %in% south_dests) %>% 
  select(origin, dest, everything())
head(pdx_to_south2)

# flights delayed by 1 hour or more
delay_1plus <- flights %>%
  filter(dep_delay >= 60)
head(delay_1plus)

# flights delayed by 1 hour, but not more than 2 hours
delay_1hr <- flights %>%
  filter(dep_delay >= 60, dep_delay < 120)
head(delay_1hr)
range(delay_1hr$dep_delay, na.rm = TRUE)

# even more efficient using between (always inclusive)
delay_bwn <- flights %>%
  filter(between(dep_delay, 60, 119))
head(delay_bwn)
range(delay_bwn$dep_delay, na.rm = TRUE)
```

### Logical tests in R

Very useful when combined with `dplyr::filter`

```{r}
?Comparison
```

+------------+---------------------------+
| Operator   | Description               |
+============+===========================+
| `<`	       | less than                 |
+------------+---------------------------+
| `<=`       | less than or equal to     |
+------------+---------------------------+
| `>`	       | greater than              |
+------------+---------------------------+
| `>=`       | greater than or equal to  |
+------------+---------------------------+
| `==`       | exactly equal to          |
+------------+---------------------------+
| `!=`       | not equal to              |
+------------+---------------------------+
| `%in%`     | group membership          |
+------------+---------------------------+
| `is.na()`  | is NA                     |
+------------+---------------------------+
| `!is.na()` | is not NA                 |
+------------+---------------------------+


```{r}
?base::Logic
```


+------------+---------------------------+
| Operator   | Description               |
+============+===========================+
| `x & y`	   | x AND y (logical and)     |
+------------+---------------------------+
| `x | y`	   | x OR y (logical or)       |
+------------+---------------------------+
| `xor(x, y)`| exactly x or y            |
+------------+---------------------------+
| `!x`	     | not x (logical negation)  |
+------------+---------------------------+
| `any()`	   | any true                  |
+------------+---------------------------+
| `all()`	   | all true                  |
+------------+---------------------------+
| `isTRUE(x)`| test if X is TRUE         |
+------------+---------------------------+

Logical or (`|`) is inclusive, so `x | y` really means: 

* x or 
* y or 
* both x & y

Exclusive or (`xor`) is exclusive, so `xor(x, y)` really means: 

* x or
* y...
* but not both x & y

```{r}
x <- c(0, 1, 0, 1)
y <- c(0, 0, 1, 1)
boolean_or <- x | y
exclusive_or <- xor(x, y)
cbind(x, y, boolean_or, exclusive_or)
```


### `dplyr::arrange`

```{r}
# default is ascending order
flights %>% 
  arrange(year, month, day)

# descending order
flights %>% 
  arrange(desc(year), desc(month), desc(day))
```


### `dplyr::distinct`

Note: we are going to start chaining multiple pipe operators together now. You can chain all `tidyr` and `dplyr` functions together!

```{r}
# all unique origin-dest combinations
flights %>% 
  select(origin, dest) %>% 
  distinct

# all unique destinations from PDX (there are 49)
from_pdx <- flights %>% 
  filter(origin == "PDX") %>% 
  select(origin, dest) %>%
  distinct(dest)
head(from_pdx)
```



### `dplyr::mutate`

```{r}
# add total delay variable
flights %>%
  mutate(tot_delay = dep_delay + arr_delay) %>%
  select(origin, dest, ends_with("delay"), everything())

# flights that were delayed at departure had on time or early arrivals?
arrivals <- flights %>%
  mutate(arr_ok = ifelse(dep_delay > 0 & arr_delay <= 0, 1, 0)) %>% 
  select(origin, dest, ends_with("delay"), carrier, arr_ok)

# peek at it
arrivals %>%
  filter(arr_ok == 1) %>%
  head
```



### `dplyr::summarise` (or `dplyr::summarize`)

Collapses a dataframe into 1 row.

```{r}
flights %>%
  summarise(mean(dep_delay, na.rm = TRUE))

# we can also name that variable, and summarise multiple variables
flights %>%
  summarise(mean_delay = mean(dep_delay, na.rm = TRUE),
            sd_delay = sd(dep_delay, na.rm = TRUE),
            median_delay = median(dep_delay, na.rm = TRUE))
```

But this can get tedious with multiple summaries...

```{r}
flights %>%
  filter(!is.na(dep_delay)) %>%
  select(dep_delay) %>%
  summarise_each(funs(mean, sd, median))

# same thing
flights %>%
  filter(!is.na(dep_delay)) %>%
  summarise_each(funs(mean, sd, median), dep_delay)

# combine with gather, change names too
flights %>%
  filter(!is.na(dep_delay)) %>%
  summarise_each(funs(mean, stdev = sd, median), dep_delay) %>%
  gather(delay_stat, value)
```

### Aggregate functions in base R

Very useful combined with `dplyr::summarise`.

+------------+---------------------------+
| Function   | Description               |
+============+===========================+
| `min()`    | minimum value             |
+------------+---------------------------+
| `max()`    | maximum value             |
+------------+---------------------------+
| `mean()`   | mean value                |
+------------+---------------------------+
| `sum()`    | sum of values             |
+------------+---------------------------+
| `var()`    | variance                  |
+------------+---------------------------+
| `sd()`     | standard deviation        |
+------------+---------------------------+
| `median()` | median value              |
+------------+---------------------------+
| `IQR()`    | interquartile range       |
+------------+---------------------------+

One very important fact: in R, you can take the `sum` and `mean` of both numbers and logicals (remember `typeof`?). By default, a logical with a value of `TRUE` is a 1, and a `FALSE` is a zero. Quick aside to show you what this means:

```{r sum-numbers-logicals}
vals <- c(1, 5, 5, 5, NA, 7, NA)
sum(vals)
sum(vals, na.rm = TRUE)
is.na(vals) 
is.na(vals) %>% as.integer
sum(is.na(vals))
vals == 5
(vals == 5) %>% as.integer
sum(vals == 5, na.rm = TRUE)
```

Taking the `mean` of a boolean vector returns a proportion.

```{r mean-numbers-logicals}
mean(vals) # actual mean
mean(vals, na.rm = TRUE) # actual mean
mean(is.na(vals)) # proportion missing
mean(vals == 5, na.rm = TRUE) # proportion of 5s
```

### Aggregate functions in `dplyr`

+------------------+------------------------------------+
| Function         | Description                        |
+==================+====================================+
| `n()`            | number of values in vector         |
+------------------+------------------------------------+
| `n_distinct()`   | number of distinct values in vector|
+------------------+------------------------------------+
| `first()`        | first value in vector              |
+------------------+------------------------------------+
| `last()`         | last value in vector               |
+------------------+------------------------------------+
| `nth()`          | nth value in vector                |
+------------------+------------------------------------+

Let's see how this works with `summarise`
```{r}
# how many unique destinations?
summary_table <- flights %>% 
  summarise(tot_flights = n(),
            tot_planes = n_distinct(tailnum),
            tot_carriers = n_distinct(carrier),
            tot_dests = n_distinct(dest),
            tot_origins = n_distinct(origin))

summary_table

# chain with tidyr functions
summary_table %>% 
  gather(key, value) %>% 
  separate(key, into = c("tot", "entity")) %>% 
  select(-tot, total = value)
```




## `tidyr`

We'll work with a made up dataframe:

```{r}
df <- data.frame(
  id = 1:10,
  date = as.Date('2015-01-01') + 0:9,
  q1_m1_w1 = rnorm(10, 0, 1),
  q1_m1_w2 = rnorm(10, 0, 1),
  q1_m2_w3 = rnorm(10, 0, 1),
  q2_m1_w1 = rnorm(10, 0, 1),
  q2_m2_w1 = rnorm(10, 0, 1),
  q2_m2_w2 = rnorm(10, 0, 1)
)
```

```{r}
# HLO
head(df)
glimpse(df)
```

### `tidyr::gather`

First, let's gather...
```{r}
df_tidy <- df %>%
  gather(key, value, q1_m1_w1:q2_m2_w2)
head(df_tidy)
```


Now let's gather using subtraction...
```{r}
df_tidy <- df %>%
  gather(key, value, -id, -date)
head(df_tidy)
```

### `tidyr::separate`

```{r}
# separate 1 col into 3 cols
df_sep <- df_tidy %>%
  separate(key, into = c("quarter", "month", "week"))
head(df_sep)

# separate 1 col into 2 cols
df_sep2 <- df_tidy %>%
  separate(key, into = c("quarter", "period"), extra = "merge")
head(df_sep2)
```
stringr vs. tidyr separate by regular expression

### `tidyr::extract`

`Extract` is essentially the same as `separate`, let's see how...

```{r}
# extract
df_ext <- df_sep2 %>%
  extract(period, into = "month")
head(df_ext)

# this gives us same output as separate
df_ext <- df_sep2 %>%
  extract(period, into = c("month", "week"), 
          regex = "([[:alnum:]]+)_([[:alnum:]]+)")
head(df_ext)
````

### `tidyr::unite`

```{r}
# let's say we want to combine quarter and month with an underscore
df_uni <- df_sep %>%
  unite(period, quarter:month) # sep = "_" is the default arg
head(df_uni)

# let's say we want to combine quarter and month with nothing
df_uni <- df_sep %>%
  unite(period, quarter:month, sep = "")
head(df_uni)
```

### `tidyr::spread`

```{r}
# finally let's spread
df_spread <- df_uni %>%
  spread(week, value) # fill = NA is default arg
head(df_spread)
```

### Gather multiple sets of columns (`gather() %>% separate() %>% spread()`)

[Gather multiple sets of columns](http://stackoverflow.com/questions/25925556/gather-multiple-sets-of-columns-with-tidyr)

All in one, if we had wanted to essentially "gather" three sets of columns (here, one for each week)...

```{r}
df_tidiest <- df %>%
  gather(key, value, -id, -date) %>%
  separate(key, into = c("quarter", "month", "week")) %>%
  spread(week, value)
head(df_tidiest)
```


### tidying challenge

Anscombe's data is available in the `datasets` package. This package comes preinstalled for you when you download R, so it is already installed *and* loaded for you. You can see all the datasets available to you by typing `data()` into your console.

```{r}
data("anscombe") # load the dataframe
```

It is *not* tidy...
```{r}
head(anscombe)
```


```{r echo = FALSE}
anscombe_tidy <- anscombe %>%
    mutate(observation = seq_along(x1)) %>%
    gather(key, value, -observation) %>%
    separate(key, c("variable", "set"), 1, convert = TRUE) %>%
    mutate(set = as.character(as.roman(set))) %>%
    spread(variable, value) %>%
    arrange(set)
```

We would like to be able to make a table like this:
```{r echo = FALSE}
knitr::kable(head(anscombe_tidy), align = c("l", "l", "r", "r"))
```


Or make a plot like this using `ggplot2`:

```{r echo = FALSE}
seaborn_colorblind <- c("#0072B2", "#009E73", "#D55E00",
                        "#CC79A7", "#F0E442", "#56B4E9")
ans_plot <- ggplot(anscombe_tidy, aes(x, y, colour = set)) +
  geom_point(size = 3, alpha = .7) +
  facet_wrap(~ set) +
  theme_bw()+
  scale_colour_manual(values = seaborn_colorblind) +
  guides(colour = FALSE)
suppressWarnings(print(ans_plot))
```

In order to make these types of plots, we need to do some `tidyr` and `dplyr` legwork. Your challenge: tidy this dataset such that the column names are:

* observation as an integer (1-11)
* set as a roman numeral (I / II / III / IV)
* x values
* y values

#### Helpful Hints I

Break it down into manageable steps on paper first:

1. We need to add a column that holds the observation number
2. We will need to gather all columns BUT the one we just made in (1)
3. We will then need to separate values in one column because it will contain our previous column names (`r colnames(anscombe)`)
4. We will want to mutate the values in another column from integers to roman numerals
5. We will need to make sure that x values and y values are in separate columns

#### Helpful Hints II

Perhaps more helpful!

1. Add a column for `observation` (`dplyr::mutate`) (hint: `seq_along` is a cool function)
2. Gather columns into key-value pairs (`tidyr::gather`)
3. Your key column needs to be separated (`tidyr::separate`)
4. Mutate values in the `set` column from integers into roman numerals (`dplyr::mutate`) (hint!: `as.roman` is a cool function)
5. At this point, your x's and y's are stacked in the same column; you need to spread the key-value pair across multiple columns so that x's are in one column and y's are in another (`tidyr::spread`)

#### My solution

Just one possible way of many ways to solve this

```{r echo = TRUE}
anscombe_tidy <- anscombe %>%
    mutate(observation = seq_along(x1)) %>%
    gather(key, value, -observation) %>%
    separate(key, into = c("variable", "set"), 1) %>%
    mutate(set = as.roman(set)) %>%
    spread(variable, value) %>%
    arrange(set)
```

## `broom`

"The broom package takes the messy output of built-in functions in R, such as `lm`, `nls`, or `t.test`, and turns them into tidy data frames." So, broom tidies output from other R functions that are un-tidy.

See here for list of functions: https://github.com/dgrtwo/broom

Vignette: ftp://cran.r-project.org/pub/R/web/packages/broom/vignettes/broom.html

```{r}
fit <- lm(mpg ~ qsec + factor(am) + wt + factor(gear), 
          data = mtcars)
```

Un-tidy output from `lm`
```{r}
summary(fit)
```

Tidy output from `broom`
```{r}
tidy(fit)
```


# Best for html output

## The `DT` package

An excellent tutorial on DT is available at https://rstudio.github.io/DT/.

```{r}
datatable(iris)
```


# For pdf or html

## The `kable` function in the `knitr` package

https://www.rdocumentation.org/packages/knitr/versions/1.12.3/topics/kable

```{r}
kable(head(iris))
```

## The `xtable` package (best for html)

The xtable is a solution that delivers both HTML and LaTeX. The syntax is very similar to kable:

```{r}
output <- 
  matrix(sprintf("Content %s", LETTERS[1:4]),
         ncol=2, byrow=TRUE)
colnames(output) <- 
  c("1st header", "2nd header")
rownames(output) <- 
  c("1st row", "2nd row")

print(xtable(output, 
             caption="A test table", 
             align = c("l", "c", "r")), 
      type="html")
```

Note that to make it `knit`, you need to specify a chunk option: `results = 'asis'`
```{r results = 'asis'}
print(xtable(output, 
             caption="A test table", 
             align = c("l", "c", "r")), 
      type="html")
```



```{r results = 'asis'}
print(xtable(head(iris)), type = 'html', html.table.attributes = '')
```


## The `pixiedust` package (best for PDF)

Remember that `broom` package we used earlier? We can make this table better...

```{r}
tidy(fit)
```


https://cran.r-project.org/web/packages/pixiedust/vignettes/pixiedust.html



```{r}
dust(fit) %>% 
  sprinkle(cols = "term", 
           replace = c("Intercept", "Quarter Mile Time", "Automatic vs. Manual",
                       "Weight", "Gears: 4 vs. 3", "Gears: 5 vs 3")) %>%
  sprinkle(cols = c("estimate", "std.error", "statistic"),
           round = 3) %>% 
  sprinkle(cols = "p.value", fn = quote(pvalString(value))) %>% 
  sprinkle_colnames("Term", "Coefficient", "SE", "T-statistic", "P-value")
```

# Finally, fonts!

https://github.com/wch/extrafont

Follow all installation instructions from `github`

