Plotting negative and positive laues

General
1

Hi, I would like to generate a temperature anomalies graph with a trend line which looks almost like this:

image
image363×318 17.7 KB

This is my reprex:
library(ggplot2)
library(lubridate)
library(tidyverse)
df <- data.frame(stringsAsFactors = FALSE,
Date = c(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),
Temp = c(-0.2, -0.1, -0.2, -0.7, -0.3, -0.4, -0.7, -0.8, -0.8, -0.2, 0.2, -0.4, 0.1,
-0.1, 0.2, -0.1, 0.4, 0.5, 1.0, 0.2, 0.2, 0.2, 0.1, -0.6, 0.6, 0.6,
0.2, 0.2, 0.5, 0.2, 0.3, 0.3, 0.2, 0.4, 0.0, 0.6, 0.5))
df %>%
mutate(Date = dmy(paste("01-01-", Date))) %>%
ggplot(aes(x = Date, y = Temp)) +
geom_line() + geom_area(colour = "red",size = 1)+theme_bw()+
scale_x_date(date_labels = "%Y",
date_breaks = "1 year",
minor_breaks = "1 year") +
theme_minimal() +
theme(axis.text.x = element_text(angle=45, hjust=1, vjust = 1))
I have the following graph:
image
image628×304 31.3 KB

I need some help with this. Thanks

2

If you're OK with base R solution, here you go:

df <- data.frame(Date = c(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),
                 Temp = c(-0.2, -0.1, -0.2, -0.7, -0.3, -0.4, -0.7, -0.8, -0.8, -0.2, 0.2, -0.4, 0.1,
                          -0.1, 0.2, -0.1, 0.4, 0.5, 1.0, 0.2, 0.2, 0.2, 0.1, -0.6, 0.6, 0.6,
                          0.2, 0.2, 0.5, 0.2, 0.3, 0.3, 0.2, 0.4, 0.0, 0.6, 0.5))

with(data = df,
     expr = {
       plot(x = Date,
            y = Temp,
            pch = NA_integer_)
       polygon(x = c(min(Date), Date, max(Date)),
               y = c(0, Temp, 0),
               col = "red")
       clip(x1 = min(Date),
            x2 = max(Date),
            y1 = min(Temp),
            y2 = 0)
       polygon(x = c(min(Date), Date, max(Date)),
               y = c(0, Temp, 0),
               col = "blue")
     })

672×480 2.35 KB

Created on 2019-05-01 by the reprex package (v0.2.1)

Hope this helps.

3

Thanks a lot Yanakabrina. This is the right graph I want. Is it possible to include a trend line as well?. Its my first time hearing about Base R solutions but I will do some reading.

4

Well, my username is Yarnabrina :smile:

Can you please elaborate? Do you want something like geom_smooth? In that case, you can do something like the following. This can be made better, but I don't know much about loess.

df <- data.frame(Date = c(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),
                 Temp = c(-0.2, -0.1, -0.2, -0.7, -0.3, -0.4, -0.7, -0.8, -0.8, -0.2,
                          0.2, -0.4, 0.1, -0.1, 0.2, -0.1, 0.4, 0.5, 1.0, 0.2,
                          0.2, 0.2, 0.1, -0.6, 0.6, 0.6, 0.2, 0.2, 0.5, 0.2,
                          0.3, 0.3, 0.2, 0.4, 0.0, 0.6, 0.5))

with(data = df,
     expr = {
       plot(x = Date,
            y = Temp,
            pch = NA_integer_)
       polygon(x = c(min(Date), Date, max(Date)),
               y = c(0, Temp, 0),
               col = "red")
       usr <- par("usr")
       clip(x1 = min(Date),
            x2 = max(Date),
            y1 = min(Temp),
            y2 = 0)
       polygon(x = c(min(Date), Date, max(Date)),
               y = c(0, Temp, 0),
               col = "blue")
       do.call(what = clip,
               args = as.list(x = usr))
       lines(x = loess.smooth(x = Date,
                              y = Temp,
                              span = 0.25),
             col = "green",
             lwd = 2)
     })

672×480 3.71 KB

For a ggplot solution, you might want to look at this SO post. You'll have to change this for your own data, of course.

https://stackoverflow.com/a/27137211

5

This is a tidyverse based solution, is this what you are trying to do?

library(tidyverse)
library(lubridate)

df <- data.frame(stringsAsFactors = FALSE,
                 Date = c(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),
                 Temp = c(-0.2, -0.1,   -0.2,   -0.7,   -0.3,   -0.4,   -0.7,   -0.8,   -0.8,   -0.2,   0.2, -0.4,  0.1,
                          -0.1, 0.2,    -0.1,   0.4,    0.5,    1.0,    0.2,    0.2,    0.2,    0.1,    -0.6,   0.6,    0.6,
                          0.2,  0.2, 0.5,   0.2,    0.3,    0.3,    0.2,    0.4,    0.0,    0.6,    0.5))
df %>%
    mutate(Date = dmy(paste("01-01-", Date)),
           Sign = if_else(Temp >= 0, "Positive", "Negative")) %>%
    ggplot(aes(x = Date, y = Temp)) +
    geom_area(aes(fill = Sign), show.legend = FALSE) +
    geom_smooth(method = "lm", se = FALSE) +
    theme_bw() +
    scale_x_date(date_labels = "%Y",
                 date_breaks = "1 year",
                 minor_breaks = "1 year") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle=45, hjust=1, vjust = 1))

672×480 17.5 KB

6

Thanks again, this is helpful

7

Thanks again Andres, this will work for me.

8

Hi Andres, I realize the polygons overlap between 1991 - 2004 showing both positive and negative values for the years yet each year is to have either a positive or negative value. Can there be a work around this? Thanks

9

Yeah, I noticed later, I'm thinkng about a solution but I haven't came up with one yet, you can go with Yarnabrina's base R solution, if I figure out a correct ggplot2 solution I will post it later.

10

Here's a result of shameless copy-paste from the SO thread I mentioned, and hence full credit goes to Henrik, and recursively to kohske.

df <- data.frame(Date = c(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),
                 Temp = c(-0.2, -0.1, -0.2, -0.7, -0.3, -0.4, -0.7, -0.8, -0.8, -0.2,
                          0.2, -0.4, 0.1, -0.1, 0.2, -0.1, 0.4, 0.5, 1.0, 0.2,
                          0.2, 0.2, 0.1, -0.6, 0.6, 0.6, 0.2, 0.2, 0.5, 0.2,
                          0.3, 0.3, 0.2, 0.4, 0.0, 0.6, 0.5))

df$grp <- "orig"

new_df <- do.call(what = "rbind",
                  args = sapply(X = 1:(nrow(x = df) -1),
                                FUN = function(i) 
                                {
                                  f <- lm(formula = (Date ~ Temp),
                                          data = df[i:(i + 1),])
                                  if (f$qr$rank < 2)
                                  {
                                    return(NULL)
                                  }
                                  r <- predict(object = f,
                                               newdata = data.frame(Temp = 0))
                                  if(df[i,]$Date < r & r < df[i+1,]$Date)
                                  {
                                    return(data.frame(Date = r,
                                                      Temp = 0))
                                  } else
                                  {
                                    return(NULL)
                                  }
                                }))

new_df$grp <- "new"

df_mod <- rbind(df, new_df)

library(ggplot2)
#> Registered S3 methods overwritten by 'ggplot2':
#>   method         from 
#>   [.quosures     rlang
#>   c.quosures     rlang
#>   print.quosures rlang

ggplot(data = df_mod,
       mapping = aes(x = Date,
                     y = Temp)) +
  geom_area(data = subset(x = df_mod,
                          subset = (Temp <= 0)),
            fill = "red") +
  geom_area(data = subset(x = df_mod,
                          subset = (Temp >= 0)),
            fill = "blue") +
  geom_smooth(se = FALSE,
              colour = "green")
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

672×480 3.28 KB

Created on 2019-05-01 by the reprex package (v0.2.1)

11

Great thanks once again Yarnabrina for your help. This is a nice graph as well with ggplot. Thank you guys for your effort.

12

I figured out a simple but not exact or generalizable solution (intersecting values are not exact but I think they are good enough for visualization purposes)

intersection <- df %>%
    mutate(Date = dmy(paste("01-01-", Date))) %>% 
    mutate(sign_change = Temp/lead(Temp) < 0) %>% 
    filter(sign_change == TRUE) %>% 
    mutate(Date = Date + months(6),
           Positive = 0, 
           Negative = 0) %>% 
    select(-sign_change)

df %>%
    mutate(Date = dmy(paste("01-01-", Date)),
           Positive = ifelse(Temp >= 0, Temp, 0),
           Negative = ifelse(Temp < 0, Temp, 0)) %>%
    bind_rows(intersection) %>% 
    gather(Sign, Temp, -Date, -Temp) %>% 
    ggplot(aes(x = Date, y = Temp)) +
    geom_area(aes(fill = Sign), show.legend = FALSE, position = "identity") +
    geom_smooth(se = FALSE) +
    theme_bw() +
    scale_x_date(date_labels = "%Y",
                 date_breaks = "1 year",
                 minor_breaks = "1 year", 
                 expand = c(0,0)) +
    theme_minimal() +
    theme(axis.text.x = element_text(angle=45, hjust=1, vjust = 1))

672×480 16.4 KB

13

Thanks a lot Andres, this is great work. Thanks for the effort put in