Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
makes animated line plots of Tokyo monthly temperatures
# do a chart animated for 100+ years of Tokyo temperatures
# and check the GP C3 and GP C4
# tokyo monthly mean temperatures
tokyo <- 'http://www.data.jma.go.jp/obd/stats/etrn/view/monthly_s3.php?prec_no=44&block_no=47662&year=&month=&day=&view='
library(zoo)
library(cowplot)
library(ggplot2)
library(gganimate)
library(XML)
library(reshape2)
library(lubridate)
# function to calc gp C3
c3gp <- function(x) {
GP <- 2.71828 ^ (-0.5 * ((x - 20) / 5.5) ^ 2)
return(GP)
}
# function to calculate gp C4
c4gp <- function(x) {
GP <- ifelse(x >= 31, 1, 2.71828 ^ (-0.5 * ((x - 31) / 7) ^ 2))
return(GP)
}
allTables <- readHTMLTable(tokyo)
tokyoMonthly <- allTables[[4]]
# loop to na.approx each column
t2 <- tokyoMonthly
# select 1875 through 2018
t2 <- t2[1:144, ]
# fill in NA in first row
for (i in 2:6) {
t2[1, i] <- NA
}
# approximate all the NA data
for (i in 2:13) {
t2[, i] <- as.numeric(as.character(t2[, i]))
t2[, i] <- na.approx(t2[, i], na.rm = FALSE)
}
# select the monthly data, drop the annual average
t2 <- t2[, 1:13]
t3 <- melt(t2, id.vars = '')
t4 <- t3
t4$year <- as.numeric(as.character(t4$年))
# sort by year
t4 <- t4[with(t4, order(year)), ]
# add a date so I can make the axis labels the way I want
t4$fakedate <- rep(seq.Date(as.Date('2018-01-15'),
as.Date('2018-12-15'),
'1 month'))
t4$month <- month(t4$fakedate, label = TRUE, abbr = TRUE)
# test that this works
p <- ggplot(data = t4, aes(x = month, y = value, group = year))
p + background_grid(major = 'xy') +
geom_line()
# make the temperature plot
p <- ggplot(data = t4, aes(x = month, y = value, group = year))
yo <- p + theme_cowplot(font_family = "Ubuntu Condensed", font_size = 24) +
background_grid(major = 'xy') +
geom_line(colour = 'blue') +
scale_y_continuous(breaks = seq(0, 30, 5)) +
labs(title = 'Tokyo monthly temperature averages since 1875',
subtitle = 'Year: {round(frame_time, 0)}',
x = '',
y = 'mean air temperature, °C',
caption = 'data from jma.go.jp') +
theme(plot.title = element_text(hjust = 0)) +
transition_time(year) +
ease_aes('linear') +
shadow_mark(colour = 'grey', alpha = 0.3)
yo2 <- animate(yo, nframes = 200, end_pause = 35, start_pause = 1,
rewind = FALSE, width = 900, height = 506)
anim_save('~/Desktop/tokyo_time_series.gif', animation = yo2)
# do gp c3
t4$gpc3 <- c3gp(t4$value)
t4$gpc4 <- c4gp(t4$value)
p <- ggplot(data = t4, aes(x = month, y = gpc3, group = year))
yo <- p + theme_cowplot(font_family = "Ubuntu Condensed", font_size = 24) +
background_grid(major = 'xy') +
geom_line(colour = '#1b9e77') +
labs(title = expression(paste('Tokyo monthly ',
C[3],
' growth potential (GP) since 1875')),
subtitle = 'Year: {round(frame_time, 0)}',
x = '',
y = expression(paste(C[3], " GP")),
caption = 'data from jma.go.jp') +
theme(plot.title = element_text(hjust = 0)) +
transition_time(year) +
ease_aes('linear') +
shadow_mark(colour = 'grey', alpha = 0.3)
yo2 <- animate(yo, nframes = 200, end_pause = 35, start_pause = 1,
rewind = FALSE, width = 900, height = 506)
anim_save('~/Desktop/tokyo_c3_series.gif', animation = yo2)
# c4 growth potential
p <- ggplot(data = t4, aes(x = month, y = gpc4, group = year))
yo <- p + theme_cowplot(font_family = "Ubuntu Condensed", font_size = 24) +
background_grid(major = 'xy') +
geom_line(colour = '#d95f02') +
labs(title = expression(paste('Tokyo monthly ',
C[4],
' growth potential (GP) since 1875')),
subtitle = 'Year: {round(frame_time, 0)}',
x = '',
y = expression(paste(C[4], " GP")),
caption = 'data from jma.go.jp') +
theme(plot.title = element_text(hjust = 0)) +
transition_time(year) +
ease_aes('linear') +
shadow_mark(colour = 'grey', alpha = 0.3)
yo2 <- animate(yo, nframes = 200, end_pause = 35, start_pause = 1,
rewind = FALSE, width = 900, height = 506)
anim_save('~/Desktop/tokyo_c4_series.gif', animation = yo2)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment