-
Notifications
You must be signed in to change notification settings - Fork 4
/
2019-10-14-color-gradient-background.Rmd
307 lines (227 loc) · 13.9 KB
/
2019-10-14-color-gradient-background.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
---
title: Making a background color gradient in ggplot2
author: Ariel Muldoon
date: '2019-10-14'
slug: background-color_gradient
categories:
- r
tags:
- ggplot2
description: This post demonstrates one way to add a background color gradient in ggplot2 based on a continuous variable and geom_segment().
draft: FALSE
---
```{r setup, include = FALSE, message = FALSE, purl = FALSE}
knitr::opts_chunk$set(comment = "#")
devtools::source_gist("2500a85297b742c6f2fb3a14549f5851",
filename = 'render_toc.R')
temp = readr::read_csv( here::here("static", "data", "2017-08-21_sapsucker_morning_temp.csv") )
# Set time zone to PDT
lubridate::tz(temp$datetime) = "US/Pacific"
```
I was recently making some arrangements for the 2020 eclipse in South America, which of course got me thinking of the day we were lucky enough to have a path of totality come to us.
We have a weather station that records local temperature every 5 minutes, so after the eclipse I was able to plot the temperature change over the eclipse as we experienced it at our house. Here is an example of a basic plot I made at the time.
```{r orig, echo = FALSE, purl = FALSE, out.width = "400px"}
knitr::include_graphics("/img/eclipse_temp.png")
```
Looking at this now with new eyes, I see it might be nice replace the gray rectangle with one that goes from light to dark to light as the eclipse progresses to totality and then back. I'll show how I tackled making a gradient color background in this post.
## Table of Contents
```{r toc, echo = FALSE, purl = FALSE}
input = knitr::current_input()
render_toc(input)
```
# Load R packages
I'll load **ggplot2** for plotting and **dplyr** for data manipulation.
```{r, message = FALSE, warning = FALSE}
library(ggplot2) # 3.2.1
library(dplyr) # 0.8.3
```
# The dataset
My weather station records the temperature in °Fahrenheit every 5 minutes. I downloaded the data from 6 AM to 12 PM local time and cleaned it up a bit. The date-times and temperature are in a dataset I named `temp`. You can download this below if you'd like to play around with these data.
---
`r fontawesome::fa("download", fill = "#ee5863")`
```{r embed, echo = FALSE}
xfun::embed_file(path = here::here("static", "data", "2017-08-21_sapsucker_morning_temp.csv"),
name = "eclipse_temp.csv")
```
---
Here are the first six lines of this temperature dataset.
```{r}
head(temp)
```
I also stored the start and end times of the eclipse and totality in data.frames, which I pulled for my location from [this website](http://xjubier.free.fr/en/site_pages/solar_eclipses/TSE_2017_GoogleMapFull.html).
If following along at home, make sure your time zones match for all the date-time variables or, from personal experience `r emo::ji("rofl")`, you'll run into problems.
```{r}
eclipse = data.frame(start = as.POSIXct("2017-08-21 09:05:10"),
end = as.POSIXct("2017-08-21 11:37:19") )
totality = data.frame(start = as.POSIXct("2017-08-21 10:16:55"),
end = as.POSIXct("2017-08-21 10:18:52") )
```
# Initial plot
I decided to make a plot of the temperature change during the eclipse only.
To keep the temperature line looking continuous, even though it's taken every 5 minutes, I subset the data to times close but outside the start and end of the eclipse.
```{r}
plottemp = filter(temp, between(datetime,
as.POSIXct("2017-08-21 09:00:00"),
as.POSIXct("2017-08-21 12:00:00") ) )
```
I then zoomed the plot to only include times encompassed by the eclipse with `coord_cartesian()`. I removed the x axis expansion in `scale_x_datetime()`.
Since the plot covers only about 2 and half hours, I make breaks on the x axis every 15 minutes.
```{r}
ggplot(plottemp) +
geom_line( aes(datetime, tempf), size = 1 ) +
scale_x_datetime( date_breaks = "15 min",
date_labels = "%H:%M",
expand = c(0, 0) ) +
coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +
labs(y = expression( Temperature~(degree*F) ),
x = NULL,
title = "Temperature during 2017-08-21 solar eclipse",
subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),
caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"
) +
scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,
name = expression( Temperature~(degree*C)),
breaks = seq(16, 24, by = 1)) ) +
theme_bw(base_size = 14) +
theme(panel.grid = element_blank() )
```
# Adding color gradient using geom_segment()
I wanted the background of the plot to go from light to dark back to light through time. This means a color gradient should go from left to right across the plot.
Since the gradient will be based on time, I figured I could add a vertical line with `geom_segment()` for every second of the eclipse and color each segment based on how far that time was from totality.
## Make a variable for the color mapping
The first step I took was to make variable with a row for every second of the eclipse, since I wanted a segment drawn for each second. I used `seq.POSIXt` for this.
```{r}
color_dat = data.frame(time = seq(eclipse$start, eclipse$end, by = "1 sec") )
```
Then came some hard thinking. How would I make a continuous variable to map to color? `r emo::ji("thinking")`
While I don't have an actual measurement of light throughout the eclipse, I can show the general idea of a light change with color by using a linear change in color from the start of the eclipse to totality and then another linear change in color from totality to the end of the eclipse.
My first idea for creating a variable was to use information on the current time vs totality start/end. After subtracting the times before totality from totality start and subtracting totality end from times after totality, I realized that the amount of time before totality wasn't actually the same as the amount of time after totality. Back to the drawing board.
Since I was making a linear change in color, I realized I could make a sequence of values before totality and after totality that covered the same range but had a different total number of values. This would account for the difference in the length of time before and after totality. I ended up making a sequence going from 100 to 0 for times before totality and a sequence from 0 to 100 after totality. Times during totality were assigned a 0.
Here's one way to get these sequences, using `base::replace()`. My dataset is in order by time, which is key to this working correctly.
```{r}
color_dat = mutate(color_dat,
color = 0,
color = replace(color,
time < totality$start,
seq(100, 0, length.out = sum(time < totality$start) ) ),
color = replace(color,
time > totality$end,
seq(0, 100, length.out = sum(time > totality$end) ) ) )
```
## Adding one geom_segment() per second
Once I had my color variable I was ready plot the segments along the x axis. Since the segments neeeded to go across the full height of the plot, I set `y` and `yend` to `-Inf` and `Inf`, respectively.
I put this layer first to use it as a background that the temperature line was plotted on top of.
```{r}
g1 = ggplot(plottemp) +
geom_segment(data = color_dat,
aes(x = time, xend = time,
y = -Inf, yend = Inf, color = color),
show.legend = FALSE) +
geom_line( aes(datetime, tempf), size = 1 ) +
scale_x_datetime( date_breaks = "15 min",
date_labels = "%H:%M",
expand = c(0, 0) ) +
coord_cartesian(xlim = c(eclipse$start, eclipse$end) ) +
labs(y = expression( Temperature~(degree*F) ),
x = NULL,
title = "Temperature during 2017-08-21 solar eclipse",
subtitle = expression(italic("Sapsucker Farm, 09:05:10 - 11:37:19 PDT") ),
caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"
) +
scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,
name = expression( Temperature~(degree*C)),
breaks = seq(16, 24, by = 1)) ) +
theme_bw(base_size = 14) +
theme(panel.grid = element_blank() )
g1
```
## Switching to a gray scale
The default blue color scheme for the segments actually works OK, but I was picturing going from white to dark. I picked gray colors with `grDevices::gray.colors()` in `scale_color_gradient()`. In `gray.colors()`, `0` is black and `1` is white. I didn't want the colors to go all the way to black, since that would make the temperature line impossible to see during totality. And, of course, it's not actually pitch black during totality. `r emo::ji("grin")`
```{r}
g1 + scale_color_gradient(low = gray.colors(1, 0.25),
high = gray.colors(1, 1) )
```
# Using segments to make a gradient rectangle
I can use this same approach on only a portion of the x axis to give the appearance of a rectangle with gradient fill. Here's an example using times outside the eclipse.
```{r}
g2 = ggplot(temp) +
geom_segment(data = color_dat,
aes(x = time, xend = time,
y = -Inf, yend = Inf, color = color),
show.legend = FALSE) +
geom_line( aes(datetime, tempf), size = 1 ) +
scale_x_datetime( date_breaks = "1 hour",
date_labels = "%H:%M",
expand = c(0, 0) ) +
labs(y = expression( Temperature~(degree*F) ),
x = NULL,
title = "Temperature during 2017-08-21 solar eclipse",
subtitle = expression(italic("Sapsucker Farm, Dallas, OR, USA") ),
caption = "Eclipse: 2 hours 32 minutes 9 seconds\nTotality: 1 minute 57 seconds"
) +
scale_y_continuous(sec.axis = sec_axis(~ (. - 32) * 5 / 9 ,
name = expression( Temperature~(degree*C)),
breaks = seq(12, 24, by = 2)) ) +
scale_color_gradient(low = gray.colors(1, .25),
high = gray.colors(1, 1) ) +
theme_bw(base_size = 14) +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank() )
g2
```
## Bonus: annotations with curved arrows
This second plot gives me a chance to try out Cédric Scherer's [very cool curved annotation arrow idea](https://cedricscherer.netlify.com/2019/05/17/the-evolution-of-a-ggplot-ep.-1/#text) for the first time `r emo::ji("tada")`.
```{r}
g2 = g2 +
annotate("text", x = as.POSIXct("2017-08-21 08:00"),
y = 74,
label = "Partial eclipse begins\n09:05:10 PDT",
color = "grey24") +
annotate("text", x = as.POSIXct("2017-08-21 09:00"),
y = 57,
label = "Totality begins\n10:16:55 PDT",
color = "grey24")
g2
```
I'll make a data.frame for the arrow start/end positions. I'm skipping all the work it took to get the positions where I wanted them, which is always iterative for me.
```{r}
arrows = data.frame(x1 = as.POSIXct( c("2017-08-21 08:35",
"2017-08-21 09:34") ),
x2 = c(eclipse$start, totality$start),
y1 = c(74, 57.5),
y2 = c(72.5, 60) )
```
I add arrows with `geom_curve()`. I changed the size of the arrowhead and made it closed in `arrow()`. I also thought the arrows looked better with a little less curvature.
```{r}
g2 +
geom_curve(data = arrows,
aes(x = x1, xend = x2,
y = y1, yend = y2),
arrow = arrow(length = unit(0.075, "inches"),
type = "closed"),
curvature = 0.25)
```
# Other ways to make a gradient color background
Based on a bunch of internet searches, it looks like a gradient background in **ggplot2** generally takes some work. There are some nice examples out there on how to use `rasterGrob()` and `annotate_custom()` to add background gradients, such as [in this Stack Overflow question](https://stackoverflow.com/questions/48596582/change-orientation-of-grob-background-gradient). I haven't researched how to make this go from light to dark and back to light for the uneven time scale like in my example.
I've also seen approaches involving dataset expansion and drawing many filled rectangles or using rasters, which is like what I did with `geom_segment()`.
# Eclipses!
Before actually experiencing totality, it seemed to me like the difference between a 99% and a 100% eclipse wasn't a big deal. I mean, those numbers *are* pretty darn close.
I was very wrong. `r emo::ji("stuck_out_tongue_winking_eye")`
If you ever are lucky enough to be near a path of totality, definitely try to get there even if it's a little more trouble then the 99.9% partial eclipse. It's an amazing experience. `r emo::ji("heart_eyes_cat")`
# Just the code, please
```{r getlabels, echo = FALSE, purl = FALSE}
labs = knitr::all_labels()
labs = labs[!labs %in% c("setup", "toc", "getlabels", "allcode", "makescript", "orig", "embed")]
```
```{r makescript, include = FALSE, purl = FALSE}
options(knitr.duplicate.label = "allow") # Needed to purl like this
input = knitr::current_input() # filename of input document
scriptpath = paste(tools::file_path_sans_ext(input), "R", sep = ".")
output = here::here("static", "script", scriptpath)
knitr::purl(input, output, documentation = 0, quiet = TRUE)
```
Here's the code without all the discussion. Copy and paste the code below or you can download an R script of uncommented code [from here](`r paste0("/script/", scriptpath)`).
```{r allcode, ref.label = labs, eval = FALSE, purl = FALSE}
```