Statistics of daily high and low temperatures are from NOAA Global Historical Climatology Network (GHCN).
The program that does the calculation is very simple, and the code that controls this website is surprisingly simple too! It is all written in the programming language R, using a web programming package called shiny. You can read all about it on the “Website Code” tab to the right.
This website is controlled using the R package “shiny.” There are four important components:
Scroll down or click links in the list above to read all about it!
extract.pdf.R:
extract.pdf <- function(start.old, end.old, start.new, end.new){
############### S U M M E R ################
# Read daily summer high temperatures from file
load(file='data/JA.rda')
# Extract specified years for first period
summer.old <- summer[as.numeric(format(as.POSIXct(summer$Date), "%Y")) >= start.old &
as.numeric(format(as.POSIXct(summer$Date), "%Y")) <= end.old,
"MaxTemperature"]
# Compute pdf of daily high temperatures for first period
density.old <- density(summer.old, na.rm=TRUE)
# Cumulative PDF of old summer temperatures
P.old <- ecdf(summer.old)
# Save statistics of old temperatures in a list
old.summer <- list(start=start.old, end=end.old, density=density.old, P=P.old)
# Compute pdf of daily high temperatures for first period
summer.new <- summer[as.numeric(format(as.POSIXct(summer$Date), "%Y")) >= start.new &
as.numeric(format(as.POSIXct(summer$Date), "%Y")) <= end.new,
"MaxTemperature"]
# Compute pdf of daily high temperatures for second period
density.new <- density(summer.new, na.rm=TRUE)
# Cumulative PDF of newer summer temperatures
P.new <- ecdf(summer.new)
# Save statistics of old temperatures in a list
new.summer <- list(start=start.new, end=end.new, density=density.new, P=P.new)
############### W I N T E R ################
# Read daily winter low temperatures from file
load(file='data/DJF.rda')
# Extract specified years for first period
winter.old <- winter[as.numeric(format(as.POSIXct(winter$Date), "%Y")) >= start.old &
as.numeric(format(as.POSIXct(winter$Date), "%Y")) <= end.old,
"MinTemperature"]
# Compute pdf of daily high temperatures for first period
density.old <- density(winter.old, na.rm=TRUE)
# Cumulative PDF of old winter temperatures
P.old <- ecdf(winter.old)
# Save statistics of old temperatures in a list
old.winter <- list(start=start.old, end=end.old, density=density.old, P=P.old)
# Compute pdf of daily high temperatures for first period
winter.new <- winter[as.numeric(format(as.POSIXct(winter$Date), "%Y")) >= start.new &
as.numeric(format(as.POSIXct(winter$Date), "%Y")) <= end.new,
"MinTemperature"]
# Compute pdf of daily high temperatures for second period
density.new <- density(winter.new, na.rm=TRUE)
# Cumulative PDF of newer winter temperatures
P.new <- ecdf(winter.new)
# Save statistics of old temperatures in a list
new.winter <- list(start=start.new, end=end.new, density=density.new, P=P.new)
return(list(old.summer=old.summer, new.summer=new.summer,
old.winter=old.winter, new.winter=new.winter))
}
plot.summer.R
plot.summer <- function(temps, T.min=70, T.max=110, marker=95,
line.color='black', shade.color='yellow',
delta.T=0){
# Find temperature limits
coldest <- min(temps$density$x)
hottest <- max(temps$density$x)
# Plot the old temperature PDF
plot(temps$density, col=line.color, lwd=5, xlim=c(T.min,T.max),
main='', xlab='', ylab='', xaxt='n', yaxt='n')
# Find user coordinates of plot corners
usr <- par('usr') # usr [1,2,3,4] = [xleft, xright, ybottom, ytop]
height <- usr[4] - usr[3]
width <- usr[2] - usr[1]
# Set text positions
x.year.text <- usr[1] + 0.15 * width
x.warming.text <- usr[1] + 0.15 * width
y.year.text <- usr[3] + 0.85 * height
y.warming.text <- usr[3] + 0.7 * height
x.marker.text <- usr[1] + 0.75 * width
y.marker.text <- usr[3] + 0.65 * height
# Add years text
text(x.year.text, y.year.text, paste(temps$start,'to',temps$end), cex=1.5)
# Add text about warming if needed
if (delta.T != 0)
text(x.warming.text, y.warming.text, paste(delta.T,' F warming'), cex=1.4)
# Add x-axis with tick marks
axis(1, at=seq(T.min,T.max,5))
# Add shading and text about hot days
if (marker < hottest) {
hot <- min(which(temps$density$x >= marker))
end <- max(which(temps$density$x < T.max + 5 ))
with(temps$density, polygon(x=c(x[c(hot,hot:end,end)]),
y= c(0, y[hot:end], 0), col=shade.color))
hot.percent <- 100 * (1 - temps$P(marker-delta.T))
text(x.marker.text, y.marker.text,
paste(format(hot.percent,digits=2),'% > ',marker, sep=''), cex=1.3)
} else {
text(x.marker.text, y.marker.text,
paste('No days hotter than ',marker), cex=1.3)
}
}
plot.winter.R:
plot.winter <- function(temps, T.min=-40, T.max=50, marker=0,
line.color='blue', shade.color='lightblue',
delta.T=0){
# Find temperature limits
coldest <- min(temps$density$x)
hottest <- max(temps$density$x)
# Plot the old temperature PDF
plot(temps$density, col=line.color, lwd=5, xlim=c(T.min,T.max),
main='', xlab='', ylab='', xaxt='n', yaxt='n')
# Find user coordinates of plot corners
usr <- par('usr') # usr [1,2,3,4] = [xleft, xright, ybottom, ytop]
height <- usr[4] - usr[3]
width <- usr[2] - usr[1]
# Set text positions
x.year.text <- usr[1] + 0.15 * width
x.warming.text <- usr[1] + 0.15 * width
y.year.text <- usr[3] + 0.85 * height
y.warming.text <- usr[3] + 0.7 * height
x.marker.text <- usr[1] + 0.2 * width
y.marker.text <- usr[3] + 0.5 * height
# Add years text
text(x.year.text, y.year.text, paste(temps$start,'to',temps$end), cex=1.5)
# Add text about warming if needed
if (delta.T != 0)
text(x.warming.text, y.warming.text, paste(delta.T,' F warming'), cex=1.4)
# Add x-axis with tick marks
axis(1, at=seq(T.min,T.max,5))
# Add shading to indicate cold days
if (marker > coldest) {
end <- min(which(temps$density$x >= T.min))
cold <- max(which(temps$density$x < marker))
with(temps$density, polygon(x=c(x[c(end,end:cold,cold)]),
y= c(0, y[end:cold], 0), col=shade.color))
# Add text about frequency of cold days
cold.percent <- 100 * (temps$P(marker-delta.T))
text(x.marker.text, y.marker.text,
paste(format(cold.percent,digits=2),'% < ',marker, sep=''), cex=1.3)
} else {
text(x.marker.text, y.marker.text,
paste('No days colder than ', marker), cex=1.3)
}
}
plot.6.R:
plot.6.pdf <- function(station, RCP='RCP6', hot.marker=95, cold.marker=0){
# Source required plotting scripts
source('model/plot.summer.R')
source('model/plot.winter.R')
# Figure out how much Fort Collins warming from RCP
scenario <- c('RCP2.6','RCP4.5','RCP6','RCP8.5')
index <- which(scenario == RCP)
global.warming <- c(1, 1.8, 2.5, 4.5) # IPCC AR5 Fig TS.15
regional.multiplier <- 1.5 # IPCC AR5 Box TS.6 Fig 1
delta.T <- global.warming[index] * regional.multiplier * 1.8 # Fahrenheit
# Remember original plotting parameters and then set them the way we want
orig.par <- par(no.readonly=TRUE)
par(mfcol=c(3,2), mar=c(2,0,2,1), oma=c(3,1,0,0), cex.lab=1.3, cex.axis=1.3)
############### W I N T E R ################
# Plot the old winter temperatures
plot.winter(station$old.winter, marker=cold.marker, line.color='blue')
# An overall title for the winter plots
mtext('Winter Low Temperatures', side=3)
# Plot the current winter temperatures
plot.winter(station$new.winter, marker=cold.marker, line.color='green')
# Create a future PDF by warming all current temps by delta.T
future.winter <- station$new.winter
future.winter$density$x <- future.winter$density$x + delta.T
future.winter$start <- 2090
future.winter$end <- 2100
# Plot the future winter temperatures
plot.winter(future.winter, marker=cold.marker, line.color='red', delta.T=delta.T)
# An overall axis label for the winter plots
mtext('Fahrenheit', side=1, line=3)
############### S U M M E R ################
# Plot the old summer temperatures
plot.summer(station$old.summer, marker=hot.marker, line.color='blue')
# An overall title for the summer plots
mtext('Summer High Temperatures', side=3)
# Plot the current summer temperatures
plot.summer(station$new.summer, marker=hot.marker, line.color='green')
# Create a future PDF by warming all current temps by delta.T
future.summer <- station$new.summer
future.summer$density$x <- future.summer$density$x + delta.T
future.summer$start <- 2090
future.summer$end <- 2100
# Plot the future summer temperatures
plot.summer(future.summer, marker=hot.marker, line.color='red', delta.T=delta.T)
# An overall axis label for the summer plots
mtext('Fahrenheit', side=1, line=3)
par(orig.par)
}
ui.R:
library(shiny)
library(markdown)
library(knitr)
# Define user interface for historical and future temperatures
shinyUI(pageWithSidebar(
# Application title
headerPanel("Seasonal Temperature Statistics"),
# Sidebar on the left with controls for the user
sidebarPanel(
img(src='fclwx.jpg', height=200, width=150),
h4('Hot Summer Day'),
sliderInput("hot.marker", 'Fahrenheit',
min=80, max=110, value=90, step=1),
h4('Cold Winter Night'),
sliderInput("cold.marker", 'Fahrenheit',
min=-20, max=20, value=0, step=1),
h4('Historical Time Period'),
sliderInput("old.years", "years",
min = 1893, max = 1970, value = c(1893,1925), step=1),
h4('Recent Time Period'),
sliderInput("new.years", "years",
min = 1980, max = 2015, value = c(2000,2015), step= 1),
h4('Future Climate'),
selectInput("RCP", "Emission Scenario:",
list("RCP 8.5: Business as Usual" = "RCP8.5",
"RCP 6: Slower Growth" = "RCP6",
"RCP 4.5: Big Reductions" = "RCP4.5",
"RCP 2.6: Very Aggressive" = "RCP2.6")
)
),
# Show a tabset in the main panel of the browser that displays model output
mainPanel(
tabsetPanel(
# First tab shows plots of assimilation rate vs light and CO2
tabPanel("Temperatures",
h4('Daily Temperature Frequency for Fort Collins, Colorado'),
plotOutput('six.panel.plot')),
# Second tab displays a brief model description
tabPanel("Model Description",
includeHTML('doc/temperature.description.html')),
# Third tab displays website code
tabPanel("Website code",
includeMarkdown('doc/website.code.md'))
)
)
))
server.R:
library(shiny)
# Source required R scripts
source('model/extract.pdf.R')
source('model/plot.6.pdf.R')
shinyServer(function(input, output) {
# Run the model, saving output to a structured list called "modelOutput"
station <- reactive({
extract.pdf(input$old.years[1], input$old.years[2],
input$new.years[1], input$new.years[2])
})
# Plot changing seasonal temperatures
output$six.panel.plot <- renderPlot(plot.6.pdf(station(),
RCP=input$RCP,
hot.marker=input$hot.marker,
cold.marker=input$cold.marker),
height=800)
})