Area line chart: Time Series with Negative Values

For this project, I created an area line chart that shows how incarceration numbers in NY could vary over 70 years. The red areas represent increases and the blue areas represent decreases. The incarceration totals are randomly generated via R.

Code can be found below.

# Load necessary libraries
library(lattice)
library(latticeExtra)

# Create fictional data with high standard deviation
set.seed(123)  # for reproducibility
years <- 1950:2020
base_rate <- 2000 + 1000 * sin((years - 1950) * 2 * pi / 70)  # sinusoidal pattern
noise <- rnorm(length(years), sd = 500)  # random noise with high standard deviation
incarceration_rate <- base_rate + noise

# Create data frame
incarceration_df <- data.frame(
  Year = years,
  Rate = incarceration_rate
)

# Plot the data
xyplot(Rate ~ Year,
       data = incarceration_df,
       panel = function(x, y, ...) {
         col <- rev(c("#B41414","#E03231","#F7A99C","#9FC8DC","#468CC8","#0165B3"))
         avg_rate <- mean(y)
         for (i in c(-3:-1, 2:0)) {
           if (i >= 0)
             yi <- pmax(avg_rate, pmin(y, avg_rate + 500 * (i+1)))
           if (i < 0)
             yi <- pmin(avg_rate, pmax(y, avg_rate + 500 * i))
           panel.xyarea(x, yi, origin = avg_rate,
                        col = col[i+4], border = NA)
         }
         panel.lines(x, y, col = "black")
         panel.abline(h = avg_rate, lty = 2)
       },
       ylab = "Incarcerations",
       main = "Plot of Annual NYC Incarceration (1950-2020)")