---
title: "Lab 2 Data Exploration and Analysis"
subtitle: Data Exploration and Analysis of Climate Data
output:
flexdashboard::flex_dashboard:
storyboard: true
source: embed
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
require(flexdashboard)
```
### Analysis of Climate Data
Purpose
=====================================
This dashboard analyses the climate data to show how global warming has affected our planet. Notes are at the bottom of each graph
Global Temperature Change since 1850
=====================================
```{r,echo = FALSE, message = FALSE}
library(dplyr)
library(tidyr)
library(ggplot2)
#install.packages("animation", repos = "http://cran.us.r-project.org")
library(animation)
#Data from https://crudata.uea.ac.uk/cru/data/temperature/
#As well as data read in script
source("C:/Users/sowmyapk/OneDrive/Analytics_512/read_cru_hemi.R")
url_dat <- "https://crudata.uea.ac.uk/cru/data/temperature/HadCRUT4-gl.dat"
temp_dat <- read_cru_hemi(url_dat)
#remove cover
temp_dat_monthly <- temp_dat %>%
select(-starts_with("cover")) %>%
select(-starts_with("annual")) %>%
gather(month, anomaly, -year) %>%
mutate(month = gsub("month\\.", "", month)) %>%
mutate(month = as.numeric(month)) %>%
filter(year !=2019)
mo <- months(seq(as.Date("1910/1/1"), as.Date("1911/1/1"), "months"))
mo <- gsub("(^...).*", "\\1", mo)
saveGIF({
for(i in 1850:2019){
print(ggplot(temp_dat_monthly %>% filter(year <= i),
aes(x=month, y=anomaly, color=year, group=year)) +
geom_line() +
scale_color_gradient(low="blue", high="red", limits=c(1850, 2015), guide="none") +
geom_hline(yintercept=1.5, color="black", lty=2) +
geom_hline(yintercept=2, color="black", lty=2) +
coord_polar() +
annotate(x=1, y=-1.5, geom="text", label=i) +
annotate(x=1, y=1.5, geom="label", label="1.5C", fill="white", label.size=0) +
annotate(x=1, y=2, geom="label", label="2.0C", fill="white", label.size=0) +
ggtitle("Global Temperature Change 1850-2019") +
scale_x_continuous(labels=mo, breaks=1:13) +
scale_y_continuous(labels=NULL, breaks=NULL) +
ylab("") + xlab("")
)}
}, interval=0.1)
out<-knitr::include_graphics("C:/Users/sowmyapk/OneDrive/Analytics_512/animation.gif")
out
```
> We notice that the tempratures on the planet changed dramatically since 2000 and the planet has been getting warmer since
CO2 Concentration over the years
=====================================
```{r,echo = FALSE, message = FALSE}
mauna_loa_yearly <- read.table('ftp://aftp.cmdl.noaa.gov/products/trends/co2/co2_annmean_mlo.txt')
names(mauna_loa_yearly) <- c('year', 'co2ppm', 'uncertainty')
library(ggplot2)
ggplot(data = mauna_loa_yearly, aes(year, co2ppm)) +
geom_ribbon(data = mauna_loa_yearly, aes(ymin = co2ppm - uncertainty, ymax = co2ppm + uncertainty), alpha=0.3) +
geom_line() +
xlab('Date') +
ylab('CO2 Concentration PPM') +
ggtitle('Mauna Loa Yearly Carbon Dioxide Concentration')
mauna_loa_yearly$co2ppm.inc <- c(NA, diff(mauna_loa_yearly$co2ppm))
ggplot(data = mauna_loa_yearly, aes(year, co2ppm.inc)) +
geom_line() +
xlab('Year') +
ylab('Change in CO2 Concentration PPM') +
ggtitle('Mauna Loa Annual Increase in CO2 Concentration') +
stat_smooth(method = lm, color = 'red') +
scale_x_continuous(breaks = seq(1960, 2020, 10)) +
theme(axis.text.x = element_text(angle = 0, vjust = 0.5))
```
> We use yearly averages of the Mauna Loa data to determine the trend in CO2 emissions. We can see that the CO2 emmisons have been steadily increasing. We can also see from the chane in CO2 over the years that not only has CO2 been accumulating in the atmosphere, it's been accumulating faster over time
Artic Ice Accumulation
=====================================
```{r,echo = FALSE, message = FALSE}
library(lubridate)
library(gganimate)
file_url <- 'ftp://sidads.colorado.edu/DATASETS/NOAA/G02135/north/monthly/data/N_09_extent_v3.0.csv'
download.file(file_url, 'arctic_ice_min.csv')
arctic_ice_min <- read.csv("arctic_ice_min.csv")
arctic_ice_min$year <- round_date(date_decimal(arctic_ice_min$year), 'year')
ggplot(arctic_ice_min,aes(x=year, y=extent)) + geom_line(size=1, color='red') +
scale_x_datetime(name=NULL, date_breaks='5 years', date_labels='%Y', lim=c(ymd_hms('1978-01-01 00:00:00'), ymd_hms('2020-01-01 00:00:00'))) +
scale_y_continuous(lim=c(3,8)) + geom_smooth(method='lm', se=F, linetype=2, size=0.5) +
labs(title='Arctic Sea Ice Minimum', subtitle='September average sea ice extent.',y='million square km')
```
> We notice that the Artic Ice leves has been dropping significantly over the last two decades
US Extreme Temperatures
=====================================
```{r,echo = FALSE, message = FALSE}
library(ggplot2)
# NOAA adds title row; skip
temps <- read.csv(url("https://www.ncdc.noaa.gov/extremes/cei/us/2/06-08/data.csv"), skip=1)
# Make "Below" values negative; *-1
temps$Much.Below.Normal <- temps$Much.Below.Normal*-1
ggplot(temps, mapping = aes(x=Date)) +
geom_bar(stat="identity", mapping = aes(y=Much.Above.Normal), fill="red", color="black") +
geom_smooth(mapping = aes(y=Much.Above.Normal), color='green') +
geom_hline(yintercept=mean(temps$Much.Above.Normal), linetype="dashed") +
geom_bar(stat="identity", mapping = aes(y=Much.Below.Normal), fill="blue", color="black") +
geom_smooth(mapping = aes(y=Much.Below.Normal), color='green') +
geom_hline(yintercept=mean(temps$Much.Below.Normal), linetype="dashed") +
scale_x_continuous(breaks = seq(1910,2018, by=10)) +
scale_y_continuous(breaks = seq(-60,60, by=10),
limits = c(-60,60),
sec.axis = sec_axis(~.+0)) +
labs(x="Year", y="Temperature relative to normal (%)") +
ggtitle("US extremes for minimum temperatures in Summer (Jun-Aug)")
```
> Graph shows contiguous 48 U.S. states experiencing extreme nightly low temperatures during summer. The area of land experiencing unusually cold temperatures has decreased over the past century, while the area of land experiencing unusually hot temperatures (red bars) reached record levels during the past decade.
