In this milestone, you’ll reshape the nasa_power
dataset to recreate a plot showing temperature values over the course of the year 2020.
Run the code below to see this week’s recreation plot.
::include_graphics("images/solution_05_plot.png") knitr
In order to recreate this plot, you’ll need to reshape the nasa_power
dataset to match the following table:
<-readr::read_csv("data/solution_05_table.csv")
temp_tbl
temp_tbl
Consider saving your transformed data as a new object (e.g. power_tidy
), then use that object to recreate the example plot.
Write your code in the following chunk:
%>%
temp_tbl ::filter(year==2020) %>%
dplyrggplot(data=.,aes(x=doy,y=temp_value,col=temp_var))+
geom_point()+
geom_line()+
labs(x="Day of year (2020)",y="Temperature (C)",col="Temperature\nvariable")
For your extension, consider investigating other years of data, or comparing temperature variables to others in the dataset. You also have access to data/precip.xlsx
if you’d like to join tables for your extension.
Write your extension code in the following chunk:
library(magrittr) #included because of this symbol %<>%
<- read_excel("data/precip.xlsx")
prcp_tbl
#makes the information wider
<-pivot_wider(temp_tbl,names_from = "temp_var",values_from="temp_value")
temp_w_tbl
#join two tables prcp and temperature
<-left_join(temp_w_tbl,prcp_tbl,by=c("lon","lat","year","mm","dd","doy"))
met_tbl
#transmute to include just needed parameters
%<>%
met_tbl transmute(dates=as.Date(paste0(year,"-",mm,"-",dd)),
mon=mm,
yr=year,
rain=if_else(t2m>0,prectotcorr,0),
snow=if_else(t2m<=0,prectotcorr,0),
prcp=prectotcorr,
tavg=t2m)
#makes a monthly summary
<-met_tbl %>%
met_mon_tblgroup_by(yr,mon) %>%
summarize(rain=sum(rain),
snow=sum(snow),
prcp=sum(prcp),
tavg=mean(tavg)) %>%
group_by(mon) %>%
summarise(rain=mean(rain),
snow=mean(snow),
prcp=mean(prcp),
tavg=mean(tavg)) %>%
ungroup()%>%
mutate(mon=factor(month.abb[mon],month.abb,ordered=T))
#adjust the table to include rain and snow in just one column
<-met_mon_tbl %>%
met_mon_gppivot_longer(.,cols = c("rain","snow"),names_to = "variable",values_to="value" )
::pandoc.table(met_mon_tbl,round=0,caption="mean monthly tables" ) pander
mon | rain | snow | prcp | tavg |
---|---|---|---|---|
Jan | 120 | 0 | 120 | 10 |
Feb | 105 | 0 | 105 | 10 |
Mar | 91 | 0 | 91 | 8 |
Apr | 37 | 13 | 50 | 4 |
May | 11 | 4 | 16 | 1 |
Jun | 6 | 9 | 15 | 0 |
Jul | 1 | 2 | 3 | 0 |
Aug | 0 | 5 | 5 | 1 |
Sep | 6 | 2 | 7 | 4 |
Oct | 21 | 2 | 23 | 6 |
Nov | 62 | 1 | 63 | 8 |
Dec | 82 | 0 | 82 | 11 |
#Ranges
<-max(met_mon_gp$prcp)
prcp_range_max
<-min(met_mon_gp$prcp,0)
prcp_range_min
<-max(met_mon_gp$tavg)
tavg_range_max
<-min(met_mon_gp$tavg)
tavg_range_min
#ranges in Kelvin + some more space
<-(tavg_range_max+273.15)*1.003-273.15
tavg_range_max
<-(tavg_range_min+273.15)*0.998-273.15
tavg_range_min
<-(prcp_range_max-prcp_range_min)/(tavg_range_max-tavg_range_min)
slope_temp
<-prcp_range_min-tavg_range_min*slope_temp inter_temp
# create the graph.
ggplot(data=met_mon_gp,aes(x=variable))+
geom_bar(data=met_mon_gp,stat = "Identity", aes(x=mon,y=value,fill=variable) ,col="black") +
geom_point( aes(x=mon,y=slope_temp*tavg+inter_temp), size=2, color="red",alpha=0.6,shape=21,fill="red")+
geom_line(aes(x=mon,y=slope_temp*tavg+inter_temp,group="tavg"), size=1, color="red",alpha=0.6)+
scale_y_continuous(sec.axis=sec_axis(trans=~(.-inter_temp)/slope_temp,
name="Temperature [degC]"))+
geom_text(aes(x=mon,y=prcp*1.05,label=round(prcp,1)),alpha=0.6,nudge_y = 0.6)+
geom_text(aes(x=mon,y=slope_temp*tavg+inter_temp,label=round(tavg,1)),alpha=0.6,
nudge_y = 2.5,col="red",fontface="bold")+
theme_bw()+
theme(axis.line.y.right = element_line(color = "red"),
axis.ticks.y.right = element_line(color = "red"),
axis.text.y.right = element_text(color = "red"),
axis.title.y.right = element_text(color = "red"))+
labs(x="",y="Total Precipitation [mm]",
title="Climatogram",col="Air temperature:",
fill="")+
scale_fill_manual(values = c("rain"="dodgerblue3","snow"="snow2"))+
theme(legend.position="bottom")