Help me plotting above and below average vaues

RicHuesitos · February 25, 2020, 12:06am

Hi, I would like to generate a precipitation graph with an average line which looks almost like this

At the same time, I'd like to fill this with two different colors, blue for wet years (values above the average) and red for dry years (valures below the average).

This is my reprex:

library(ggplot2)
df <- data.frame(stringsAsFactors = FALSE,
year = c((1900, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1908, 1909, 1910, 1911, 1912, 1913, 1914, 1915, 1916, 1917, 1918, 1919, 1920, 1921, 1922, 1923, 1924, 1925, 1926, 1927, 1928, 1929, 1930, 1931, 1932, 1933, 1934, 1935, 1936, 1937, 1938, 1939, 1940, 1941, 1942, 1943, 1944, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018),
prep = c(341.33, 296.05, 132.92, 320.21,  76.38, 333.38, 279.70, 278.20, 263.03, 259.62, 195.00, 156.81, 307.90, 338.10, 378.34, 291.46, 271.30, 348.59, 357.72, 337.60, 384.65, 159.94, 235.19, 274.70, 320.57, 100.45, 264.89, 269.30, 242.19, 158.39, 276.11, 290.33, 247.36, 348.87, 146.72, 191.37, 171.43, 222.52, 205.08,  87.82, 339.74, 326.75, 293.82, 273.57, 284.06, 223.16, 260.85, 256.45, 258.35, 247.59, 281.20, 246.36, 379.34, 268.98, 215.62, 251.54, 180.78, 325.11, 401.68, 321.66, 287.24, 315.85, 344.96, 257.22, 331.88, 297.18, 377.29, 211.12, 370.39, 297.59, 376.16, 199.36, 287.06, 229.01, 104.99, 306.36, 317.39, 263.76, 270.84, 326.75, 208.21, 348.09, 115.25, 266.39, 358.72, 326.88, 406.63, 384.56, 514.45, 144.18, 274.52, 357.99, 295.55, 342.96, 344.60, 363.22, 219.80, 417.99, 413.54, 206.76, 157.94, 373.03, 152.17, 291.32, 304.77, 302.77, 152.67, 219.80, 258.35, 265.48, 382.84,  47.49, 107.03,  48.99, 187.28, 288.28, 255.22, 253.08, 145.36),
spli = c(277.88, 265.71, 249.86, 240.60, 238.87, 246.77, 253.72, 254.67, 250.04, 243.87, 242.37, 252.59, 274.66, 298.18, 315.03, 323.48, 328.75, 332.83, 331.33, 320.66, 300.91, 276.61, 258.53, 246.95, 237.28, 229.38, 229.29, 232.51, 236.01, 241.69, 250.72, 256.58, 254.08, 242.00, 222.02, 204.90, 195.91, 196.41, 205.40, 224.11, 250.81, 271.89, 280.83, 279.61, 272.57, 264.35, 259.31, 257.99, 260.03, 264.76, 270.98, 275.88, 276.52, 269.80, 262.44, 262.71, 273.52, 293.14, 310.67, 318.44, 319.25, 317.71, 315.12, 312.62, 312.85, 314.03, 314.49, 312.81, 311.22, 304.36, 290.33, 270.21, 252.04, 239.60, 238.23, 249.50, 262.53, 270.21, 272.34, 269.66, 263.80, 261.12, 265.71, 285.47, 314.40, 341.73, 360.49, 364.49, 352.41, 330.43, 317.35, 315.58, 319.48, 325.98, 331.11, 332.42, 330.02, 324.84, 309.40, 285.92, 267.66, 259.58, 256.17, 258.08, 258.99, 254.54, 247.23, 243.32, 239.87, 229.51, 207.12, 176.42, 156.81, 157.67, 177.11, 200.81, 214.98, 216.21, 208.58))

interp <- approx(df$year, df$spli, n=10000)
orig2 <- data.frame(year=interp$x, spli=interp$y)
orig2$col[orig2$spli >= 276.86] <- "pos"
orig2$col[orig2$spli < 276.86] <- "neg"

ggplot(orig2, aes(x=year, y=spli)) +
  geom_area(aes(fill=col)) + 
  scale_x_continuous("", expand = c(0,0), breaks = seq(1900, 2018, 10)) +
  geom_line() +
  geom_hline(yintercept=276.86, color="black") +
  theme_bw()

RicHuesitos · February 25, 2020, 12:06am

And I have the following graph and I dont know where my error is.

And finally, I dont know either how I can graph the "prep" column in the same graph (as it can be seen from the first image).
I hope someone can help me.

nirgrahamuk · February 25, 2020, 1:29am

I have almost no experience with ggplot2 (I've almost exclusively used plotly), but I got fairly far. I was glad for the practice, and happy to learn a few things.

The main outstanding requirement I think is how to modify the legend to include the prep line.... any one? I tried a few scale_* things but couldnt figure it.

notes: I think your starting df data got corrupted, as there is one less year than entries for split and prep, and an extra bracket in there at the start of defining year. So I removed the bracket and added 1899...

The pos and neg fill colours were simply in an undesirable order, so I set a the col variable to be a factor and defined the ordering that way.

library(ggplot2)
df <- data.frame(stringsAsFactors = FALSE,
  year = c(1899,1900, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1908, 1909, 1910, 1911, 1912, 1913, 1914, 1915, 1916, 1917, 1918, 1919, 1920, 1921, 1922, 1923, 1924, 1925, 1926, 1927, 1928, 1929, 1930, 1931, 1932, 1933, 1934, 1935, 1936, 1937, 1938, 1939, 1940, 1941, 1942, 1943, 1944, 1945, 1946, 1947, 1948, 1949, 1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018),
  prep = c(341.33, 296.05, 132.92, 320.21, 76.38, 333.38, 279.70, 278.20, 263.03, 259.62, 195.00, 156.81, 307.90, 338.10, 378.34, 291.46, 271.30, 348.59, 357.72, 337.60, 384.65, 159.94, 235.19, 274.70, 320.57, 100.45, 264.89, 269.30, 242.19, 158.39, 276.11, 290.33, 247.36, 348.87, 146.72, 191.37, 171.43, 222.52, 205.08, 87.82, 339.74, 326.75, 293.82, 273.57, 284.06, 223.16, 260.85, 256.45, 258.35, 247.59, 281.20, 246.36, 379.34, 268.98, 215.62, 251.54, 180.78, 325.11, 401.68, 321.66, 287.24, 315.85, 344.96, 257.22, 331.88, 297.18, 377.29, 211.12, 370.39, 297.59, 376.16, 199.36, 287.06, 229.01, 104.99, 306.36, 317.39, 263.76, 270.84, 326.75, 208.21, 348.09, 115.25, 266.39, 358.72, 326.88, 406.63, 384.56, 514.45, 144.18, 274.52, 357.99, 295.55, 342.96, 344.60, 363.22, 219.80, 417.99, 413.54, 206.76, 157.94, 373.03, 152.17, 291.32, 304.77, 302.77, 152.67, 219.80, 258.35, 265.48, 382.84, 47.49, 107.03, 48.99, 187.28, 288.28, 255.22, 253.08, 145.36),
  spli = c(277.88, 265.71, 249.86, 240.60, 238.87, 246.77, 253.72, 254.67, 250.04, 243.87, 242.37, 252.59, 274.66, 298.18, 315.03, 323.48, 328.75, 332.83, 331.33, 320.66, 300.91, 276.61, 258.53, 246.95, 237.28, 229.38, 229.29, 232.51, 236.01, 241.69, 250.72, 256.58, 254.08, 242.00, 222.02, 204.90, 195.91, 196.41, 205.40, 224.11, 250.81, 271.89, 280.83, 279.61, 272.57, 264.35, 259.31, 257.99, 260.03, 264.76, 270.98, 275.88, 276.52, 269.80, 262.44, 262.71, 273.52, 293.14, 310.67, 318.44, 319.25, 317.71, 315.12, 312.62, 312.85, 314.03, 314.49, 312.81, 311.22, 304.36, 290.33, 270.21, 252.04, 239.60, 238.23, 249.50, 262.53, 270.21, 272.34, 269.66, 263.80, 261.12, 265.71, 285.47, 314.40, 341.73, 360.49, 364.49, 352.41, 330.43, 317.35, 315.58, 319.48, 325.98, 331.11, 332.42, 330.02, 324.84, 309.40, 285.92, 267.66, 259.58, 256.17, 258.08, 258.99, 254.54, 247.23, 243.32, 239.87, 229.51, 207.12, 176.42, 156.81, 157.67, 177.11, 200.81, 214.98, 216.21, 208.58)
)

interp1 <- approx(df$year, df$spli, n = 10000)
interp2 <- approx(df$year,df$prep, n = 10000)
orig2 <- data.frame(year = interp1$x, 
                    spli = interp1$y,
                    prep = interp2$y)

orig2$col[orig2$spli >= 276.86] <- "pos"
orig2$col[orig2$spli < 276.86]  <- "neg"
orig2$col <-  factor(x = orig2$col, 
                     levels = c("pos","neg"))

ggplot(orig2, aes(x = year, y = spli)) +
  geom_area(aes(fill = col)) +
  scale_x_continuous("", expand = c(0, 0), breaks = seq(1900, 2018, 10)) +
  geom_line() +
  geom_hline(yintercept = 276.86, color = "black") +
 geom_line(aes(x=year,y=prep )  ,linetype="solid",color="#888888")+
  theme_bw()

FJCC · February 25, 2020, 1:38am

Here is my attempt. I interpreted the request somewhat differently.

library(ggplot2)
df <- data.frame(stringsAsFactors = FALSE,
                 year = c(1900, 1901, 1902, 1903, 1904, 1905, 1906, 1907, 1908, 1909, 
                          1910, 1911, 1912, 1913, 1914, 1915, 1916, 1917, 1918, 1919, 
                          1920, 1921, 1922, 1923, 1924, 1925, 1926, 1927, 1928, 1929, 
                          1930, 1931, 1932, 1933, 1934, 1935, 1936, 1937, 1938, 1939, 
                          1940, 1941, 1942, 1943, 1944, 1945, 1946, 1947, 1948, 1949, 
                          1950, 1951, 1952, 1953, 1954, 1955, 1956, 1957, 1958, 1959, 
                          1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 
                          1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 
                          1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 
                          1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 
                          2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 
                          2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018),
                 prep = c(341.33, 296.05, 132.92, 320.21,  76.38, 333.38, 279.70, 
                          278.20, 263.03, 259.62, 195.00, 156.81, 307.90, 338.10, 
                          378.34, 291.46, 271.30, 348.59, 357.72, 337.60, 384.65, 
                          159.94, 235.19, 274.70, 320.57, 100.45, 264.89, 269.30, 
                          242.19, 158.39, 276.11, 290.33, 247.36, 348.87, 146.72, 
                          191.37, 171.43, 222.52, 205.08,  87.82, 339.74, 326.75, 
                          293.82, 273.57, 284.06, 223.16, 260.85, 256.45, 258.35, 
                          247.59, 281.20, 246.36, 379.34, 268.98, 215.62, 251.54, 
                          180.78, 325.11, 401.68, 321.66, 287.24, 315.85, 344.96, 
                          257.22, 331.88, 297.18, 377.29, 211.12, 370.39, 297.59, 
                          376.16, 199.36, 287.06, 229.01, 104.99, 306.36, 317.39, 
                          263.76, 270.84, 326.75, 208.21, 348.09, 115.25, 266.39, 
                          358.72, 326.88, 406.63, 384.56, 514.45, 144.18, 274.52, 
                          357.99, 295.55, 342.96, 344.60, 363.22, 219.80, 417.99, 
                          413.54, 206.76, 157.94, 373.03, 152.17, 291.32, 304.77, 
                          302.77, 152.67, 219.80, 258.35, 265.48, 382.84,  47.49, 
                          107.03,  48.99, 187.28, 288.28, 255.22, 253.08, 145.36),
                 spli = c(277.88, 265.71, 249.86, 240.60, 238.87, 246.77, 253.72, 
                          254.67, 250.04, 243.87, 242.37, 252.59, 274.66, 298.18, 
                          315.03, 323.48, 328.75, 332.83, 331.33, 320.66, 300.91, 
                          276.61, 258.53, 246.95, 237.28, 229.38, 229.29, 232.51, 
                          236.01, 241.69, 250.72, 256.58, 254.08, 242.00, 222.02, 
                          204.90, 195.91, 196.41, 205.40, 224.11, 250.81, 271.89, 
                          280.83, 279.61, 272.57, 264.35, 259.31, 257.99, 260.03, 
                          264.76, 270.98, 275.88, 276.52, 269.80, 262.44, 262.71, 
                          273.52, 293.14, 310.67, 318.44, 319.25, 317.71, 315.12, 
                          312.62, 312.85, 314.03, 314.49, 312.81, 311.22, 304.36, 
                          290.33, 270.21, 252.04, 239.60, 238.23, 249.50, 262.53, 
                          270.21, 272.34, 269.66, 263.80, 261.12, 265.71, 285.47, 
                          314.40, 341.73, 360.49, 364.49, 352.41, 330.43, 317.35, 
                          315.58, 319.48, 325.98, 331.11, 332.42, 330.02, 324.84, 
                          309.40, 285.92, 267.66, 259.58, 256.17, 258.08, 258.99, 
                          254.54, 247.23, 243.32, 239.87, 229.51, 207.12, 176.42, 
                          156.81, 157.67, 177.11, 200.81, 214.98, 216.21, 208.58))
                 
interp <- approx(df$year, df$spli, n=10000)
orig2 <- data.frame(year=interp$x, spli=interp$y)
#orig2$col[orig2$spli >= 276.86] <- "pos"
#orig2$col[orig2$spli < 276.86] <- "neg"
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

origPos <- mutate(orig2, Value = ifelse(spli >= 276.86, spli, 276.86),
                  FLOOR = 276.86) 
origNeg <- mutate(orig2, Value = ifelse(spli < 276.86, spli, 276.86),
                  CEILING = 276.86) 

ggplot() + geom_ribbon(data = origPos, 
                       mapping = aes(x = year, ymin = FLOOR, ymax = Value), fill = "skyblue") +
  geom_hline(yintercept = 276.86) +
  geom_ribbon(data = origNeg, 
              mapping = aes(x = year, ymin = Value, ymax = CEILING), fill = "red") +
  geom_line(mapping = aes(x = year, y = prep), data = df) +
  geom_line(mapping = aes(year, spli), data = orig2, size = 1.5)

^{Created on 2020-02-24 by the reprex package (v0.3.0)}

nirgrahamuk · February 25, 2020, 1:40am

I think you got me beat

FJCC · February 25, 2020, 1:46am

I have learned a lot from your posts. I am happy I may have paid a little back.

RicHuesitos · February 25, 2020, 5:00pm

Hi FJCC

In fact, your graph was what I was looking for. Thank you so much for your help.

system · March 17, 2020, 5:00pm

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.