Seasonal Temperature Statistics

Hot Summer Day

Cold Winter Night

Historical Time Period

Recent Time Period

Future Climate

Daily Temperature Frequency for Fort Collins, Colorado

DESCRIPTION

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.

How this website works (including all the code!)

This website is controlled using the R package “shiny.” There are four important components:

  • A script (extract.pdf.R) that extracts temperature from data files
  • A script (plot.summer.R) that plots statistics for summer
  • A script (plot.winter.R) that plots statistics for winter
  • A script (plot.6.R) that combines all the plots for the user
  • The user interface (ui.R) that controls the sliders and passes inputs to the model
  • The “server” (server.R) that responds to user interface events in the web browser

Scroll down or click links in the list above to read all about it!


Program to extract temperature statistics from data files

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))
}

Program to plot summer statistics

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)
  }

}

Program to plot winter statistics

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)
  }

}

Program to combine all plots on a single browser pane

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)

}

This is the user interface that actually controls this website

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'))
    )
  )
))

The “server” that calls other scripts when user does something

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)

})