Search code examples
rggplot2time-seriesdata-visualizationtrendline

Is it possible to draw multiple trendlines within a single time series graph in ggplot2?


I was planning to plot few trendlines within one time series graph so that I could visualize the changes of trends, spanning between several time limits. I managed to draw a single linear trend throughout the time series, but I was hoping maybe drawing a couple more trends at 2007 to 2010 and 2010 to 2013, which would help me to address the stable trend between 2007 to 2010 and decreasing pattern between 2010 and 2013. I used the following codes:

data <- read.csv("sample.csv",
                 header = T,
                 sep = ",",
                 dec = ".")
head(data)
data$Year <- as.Date(data$ï..Date, format = "%m/%d/%Y")
class(data$Year)
attach(data)
time_plot <- ggplot(data, aes(x = Year, y = SPM)) +
  geom_line(color = 'black', size = 1.3)  + geom_point(color = "blue", size = 1.3) +
  scale_x_date(date_labels = "%Y", date_breaks = "1 year") + xlab(label = "Time (Years)") + ylab(label = "Concentration") +
    theme_bw() + stat_smooth(
      method = "lm",
      formula = y ~ x,
      size = 0.75,
      se = T,
      color = "blue",
      fill = "#9AE5D7"
    ) + stat_poly_eq(
      face = "bold",
      parse = T,
      aes(label = ..eq.label..),
      formula = y ~ x,
      label.x.npc = 0.5,
      label.y.npc = 0.1,
      size = 6,
      coef.digits = 4
    ) +
    theme(
      plot.title = element_text(
        size = 17,
        face = "bold",
        colour = "black"
      ),
      axis.title.x = element_text(
        size = 20,
        face = "bold",
        colour = "black"
      ),
      axis.title.y = element_text(
        size = 20,
        face = "bold",
        colour = "black"
      ),
      axis.text.x = element_text(
        size = 18,
        face = "bold",
        colour = "black"
      ),
 
      axis.text.y = element_text(
        size = 18,
        face = "bold",
        colour = "black"
      ),
     
      strip.text.x = element_text(
        size = 16,
        
        face = "bold",
        colour = "black"
      ),
      strip.text.y = element_text(
        size = 16,
        
        face = "bold",
        colour = "black"
      ),
      axis.line.x = element_line(color = "black", size = 1),
      axis.line.y = element_line(color = "black", size = 1),
      axis.ticks = element_line(color = "black", size = 1.2),
      axis.ticks.length = unit(0.2, "cm"),
      panel.border = element_rect(
        colour = "black",
        fill = NA,
        size = 1
      ),
      legend.title = element_blank(),
      legend.position = c(.8, .2),
    ) +
    stat_fit_glance(
      method = 'lm',
      method.args = list(formula = y ~ x),
      geom = 'text',
      aes(label = paste(
        "P-value = ", signif(..p.value.., digits = 4), sep = ""
      )),
      size = 6,
      label.x = "left",
      label.y = "top",
    ) 

Which returned with the following graph:

enter image description here

However, I am hoping to generate plots like these, which would possess several trend lines:

enter image description here

enter image description here

There has been a post in the stack overflow earlier, which was similar to my query but it was for "python". I was thinking if I could do similar things using ggplot2, in R ? I would be grateful if you could take few moments to point me to some solutions to my problem or maybe suggest any tutorials, sites or packages that would help me to generate such figures. I have also access to golden software's grapher, would that be a better platoform to get such figures? I attaching the dataset below:

ï..Date   SPM       Year
1   1/1/2007 6.412 2007-01-01
2   2/1/2007 7.827 2007-02-01
3   3/1/2007 6.816 2007-03-01
4   4/1/2007 8.021 2007-04-01
5   5/1/2007 6.130 2007-05-01
6   6/1/2007 4.982 2007-06-01
7   7/1/2007 3.776 2007-07-01
8   8/1/2007 4.764 2007-08-01
9   9/1/2007 5.699 2007-09-01
10 10/1/2007 7.264 2007-10-01
11 11/1/2007 8.168 2007-11-01
12 12/1/2007 7.518 2007-12-01
13  1/1/2008 7.157 2008-01-01
14  2/1/2008 7.996 2008-02-01
15  3/1/2008 5.806 2008-03-01
16  4/1/2008 5.388 2008-04-01
17  5/1/2008 6.535 2008-05-01
18  6/1/2008 3.715 2008-06-01
19  7/1/2008 4.723 2008-07-01
20  8/1/2008 4.259 2008-08-01
21  9/1/2008 5.524 2008-09-01
22 10/1/2008 7.755 2008-10-01
23 11/1/2008 8.393 2008-11-01
24 12/1/2008 5.702 2008-12-01
25  1/1/2009 5.816 2009-01-01
26  2/1/2009 5.954 2009-02-01
27  3/1/2009 5.142 2009-03-01
28  4/1/2009 6.286 2009-04-01
29  5/1/2009 7.408 2009-05-01
30  6/1/2009 5.866 2009-06-01
31  7/1/2009 7.188 2009-07-01
32  8/1/2009 3.729 2009-08-01
33  9/1/2009 4.284 2009-09-01
34 10/1/2009 6.392 2009-10-01
35 11/1/2009 6.642 2009-11-01
36 12/1/2009 6.365 2009-12-01
37  1/1/2010 6.999 2010-01-01
38  2/1/2010 6.906 2010-02-01
39  3/1/2010 6.205 2010-03-01
40  4/1/2010 3.497 2010-04-01
41  5/1/2010 2.278 2010-05-01
42  6/1/2010 3.510 2010-06-01
43  7/1/2010 4.112 2010-07-01
44  8/1/2010 5.469 2010-08-01
45  9/1/2010 5.402 2010-09-01
46 10/1/2010 5.365 2010-10-01
47 11/1/2010 6.412 2010-11-01
48 12/1/2010 7.384 2010-12-01
49  1/1/2011 7.660 2011-01-01
50  2/1/2011 7.380 2011-02-01
51  3/1/2011 7.880 2011-03-01
52  4/1/2011 5.971 2011-04-01
53  5/1/2011 6.944 2011-05-01
54  6/1/2011 3.911 2011-06-01
55  7/1/2011 4.438 2011-07-01
56  8/1/2011 3.266 2011-08-01
57  9/1/2011 4.554 2011-09-01
58 10/1/2011 7.247 2011-10-01
59 11/1/2011 7.607 2011-11-01
60 12/1/2011 7.791 2011-12-01
61  1/1/2012 9.193 2012-01-01
62  2/1/2012 7.312 2012-02-01
63  3/1/2012 3.753 2012-03-01
64  4/1/2012 3.458 2012-04-01
65  5/1/2012 1.211 2012-05-01
66  6/1/2012 2.052 2012-06-01
67  7/1/2012 2.055 2012-07-01
68  8/1/2012 3.804 2012-08-01
69  9/1/2012 5.728 2012-09-01
70 10/1/2012 6.501 2012-10-01
71 11/1/2012 5.177 2012-11-01
72 12/1/2012 4.829 2012-12-01 

Any help, advice or suggestions would be deeply appreciated. Thanks in advance.


Solution

  • You can simply repeat your geom_smooth call with subsets of the original data frame:

    ggplot(data, aes(x = Year, y = SPM)) +
      geom_line(color = 'black', size = 1.3)  + 
      geom_point(color = "blue", size = 1.3) +
      stat_smooth(method = "lm", formula = y ~ x, size = 0.75, se = TRUE,
                  color = "blue", fill = "#9AE5D7") + 
      stat_smooth(method = "lm", formula = y ~ x, size = 0.75, se = TRUE,
                  color = "red", fill = "red", alpha = 0.2, 
                  data = data[data$Year < as.Date("2009-06-01"),]) + 
      stat_smooth(method = "lm", formula = y ~ x, size = 0.75, se = TRUE,
                  color = "forestgreen", fill = "forestgreen", alpha = 0.2,
                  data = data[data$Year >= as.Date("2009-06-01"),]) + 
      stat_poly_eq(face = "bold", parse = TRUE, aes(label = ..eq.label..),
                   formula = y ~ x, label.x.npc = 0.5, label.y.npc = 0.1, 
                   size = 6, coef.digits = 4) +
      stat_fit_glance(method = 'lm', method.args = list(formula = y ~ x),
                      geom = 'text', 
                      aes(label = paste(
                        "P-value = ", signif(..p.value.., digits = 4), sep = ""
                      )), size = 6, label.x = "left", label.y = "top") +
      scale_x_date(date_labels = "%Y", date_breaks = "1 year") + 
      labs(x = "Time (Years)", y = "Concentration") +
      theme_bw() + 
      theme(plot.title        = element_text(size = 17, face = "bold"),
            axis.title.x      = element_text(size = 20, face = "bold"),
            axis.title.y      = element_text(size = 20, face = "bold"),
            axis.text.x       = element_text(size = 18, face = "bold"),
            axis.text.y       = element_text(size = 18, face = "bold"),
            strip.text.x      = element_text(size = 16, face = "bold"),
            strip.text.y      = element_text(size = 16, face = "bold"),
            axis.line.x       = element_line(color = "black", size = 1),
            axis.line.y       = element_line(color = "black", size = 1),
            axis.ticks        = element_line(color = "black", size = 1.2),
            axis.ticks.length = unit(0.2, "cm"),
            panel.border      = element_rect(fill = NA, size = 1),
            legend.title      = element_blank(),
            legend.position   = c(.8, .2))
    

    enter image description here

    In this case, the overall trend is fairly constant, so the background blue line is obscured by the two partial segments.