Plotting different regression models on the same scatter plot

7361 · June 16, 2020, 8:15am

I've got a problem with the following regression models. I want to get two polynomial regression lines and one linear regression line on the same scatter plot. In addition, i want to show the equations for the three different models on the same graph using ggpmisc package.

I've coded my problem as follows:

library(tidyverse)
library(ggpmisc)
equation <- y ~ x

df %>%
  filter(Year == 2010) %>%
  ggplot(aes(x = commutetime, y = carcommute, color=Fabric, shape = Fabric)) +
  geom_point() +
  theme_minimal()+
  geom_point(size = 3.5, aes(color = Fabric, shape = Fabric))+
  stat_smooth(method = "lm", formula = y ~ poly(x, 2), size = 1, se = FALSE)+
  scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  scale_fill_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  stat_poly_eq(aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               label.x.npc = "center", label.y.npc = 0.39,
               formula = equation, parse = TRUE, size = 5)

But i am getting the graph below my data : Automobile and Walking fabrics should reflect the quadratic regression while Transit should show decreasing trend as commute time increases. That means i want transit to be straight line and keep the quadratic regression for both automobile and walking. Any idea of how i can modify my code to show that.

Similarly my equations for the three models overlap? How can i solve this? Thank you very much in advance!!!

Here's my data:

  carcommute commutetime  Fabric
3         35.9        41.6    Walking
4         84.0        34.9    Walking
7         28.3        37.1    Transit
8         82.6        31.4    Transit
11        23.3        35.1    Walking
12        63.0        30.3    Walking
15        34.2        36.4    Walking
16        80.7        29.3    Walking
19        31.1        36.8    Walking
20        76.1        33.1    Walking
23        29.9        37.8    Walking
24        78.4        33.2    Walking
27        32.2        39.5    Walking
28        79.8        35.2    Walking
31        31.7        42.7    Walking
32        82.9        38.6    Walking
35        34.1        43.1    Walking
36        79.7        37.6    Walking
39        28.5        45.1    Walking
40        76.3        39.3    Walking
43        32.2        47.1    Walking
44        81.9        38.5    Walking
47        36.6        47.6    Walking
48        85.5        41.3    Walking
51        34.4        43.3    Walking
52        83.3        38.6    Walking
55        36.7        40.3    Walking
56        91.0        35.4    Walking
59        33.8        39.2    Walking
60        82.5        31.4    Walking
63        47.0        43.3    Walking
64        89.9        36.8    Walking
67        41.1        43.5    Walking
68        87.8        39.1    Walking
71        33.6        43.8    Walking
72        90.4        35.7    Walking
75        38.9        42.7    Walking
76        86.7        36.4    Walking
79        32.1        39.3    Walking
80        84.4        31.9    Walking
83        32.2        42.2    Walking
84        88.7        35.3    Walking
87        32.9        44.0    Walking
88        87.5        36.4    Walking
91        41.2        38.2    Transit
92        89.1        31.5    Transit
95        42.6        39.5    Walking
96        87.6        30.3    Walking
99        42.2        39.4    Walking
100       84.2        33.5    Walking
103       40.2        42.1    Walking
104       88.5        31.0    Walking
107       59.9        41.1 Automobile
108       76.9        35.9 Automobile
111       59.4        32.7 Automobile
112       75.8        32.5 Automobile
115       57.0        38.1    Walking
116       67.1        35.8    Transit
119       56.9        39.7    Walking
120       76.2        33.0    Walking
123       67.9        37.5    Transit
124       78.7        36.0    Transit
127       60.7        41.1    Transit
128       75.2        38.6    Transit
131       50.6        43.7    Walking
132       81.5        37.9    Walking
135       61.0        45.5    Transit
136       76.5        38.8    Transit
139       67.2        42.0    Transit
140       83.5        36.8    Transit
143       60.7        22.4 Automobile
144       49.7        17.5 Automobile
147       70.4        44.3 Automobile
148       87.4        22.7 Automobile
151       61.6        39.4 Automobile
152       80.1        41.4 Automobile
155       62.7        39.9    Transit
156       79.6        42.1    Transit
175       50.4        41.9    Transit
176       67.0        44.7    Transit
191       50.1        45.3    Transit
192       83.1        43.8    Transit
195       51.0        43.1    Walking
196       75.1        43.4    Walking
207       52.1        40.3    Walking
208       78.3        47.3    Walking
223       46.0        42.7    Transit
224       77.7        45.9    Transit
227       74.0        29.0 Automobile
228       80.7        29.7 Automobile
231       62.4        34.4 Automobile
232       88.1        45.9 Automobile
235       66.4        38.3    Transit
236       81.6        44.0    Transit
247       59.8        42.7    Transit
248       81.5        49.2    Transit
267       52.4        41.9 Automobile
268       83.6        46.6 Automobile
271       55.0        40.9    Transit
272       80.5        42.8    Transit
275       61.5        44.1 Automobile
276       82.3        40.7 Automobile
279       73.5        33.7    Transit
280       89.5        35.8    Transit
283       74.0        36.0 Automobile
284       81.8        42.0 Automobile
287       50.6        41.9    Transit
288       79.0        50.1    Transit
291       60.5        41.8 Automobile
292       82.8        46.2 Automobile
295       55.3        41.3 Automobile
296       77.8        43.0 Automobile
299       68.7        43.7 Automobile
300       82.1        44.2 Automobile
315       69.9        36.9 Automobile
316       86.6        40.1 Automobile
319       78.9        25.9 Automobile
320       73.9        30.1 Automobile
323       76.8        25.5 Automobile
324       76.3        29.1 Automobile
327       72.0        39.2 Automobile
328       86.4        45.7 Automobile
331       74.1        35.9 Automobile
332       86.3        33.8 Automobile
335       74.6        33.9 Automobile
336       78.6        40.4 Automobile
339       65.0        39.4 Automobile
340       90.5        39.6 Automobile
343       73.2        31.2 Automobile
344       79.0        30.7 Automobile
351       73.6        29.9 Automobile
352       63.0        27.3 Automobile
355       74.7        20.1 Automobile
356       72.7        31.9 Automobile
359       77.4        26.1 Automobile
360       79.2        29.4 Automobile

You can also have a look at my graph. Thank you very much in advance!!!

nirgrahamuk · June 16, 2020, 9:56am

when sharing data, its best to do so in a way that is directly useable by other forum members.
The dput() function is commonly used for this. for example

structure(list(dummy = c(3, 4, 7, 8, 11, 12, 15, 16, 19, 20, 
23, 24, 27, 28, 31, 32, 35, 36, 39, 40, 43, 44, 47, 48, 51, 52, 
55, 56, 59, 60, 63, 64, 67, 68, 71, 72, 75, 76, 79, 80, 83, 84, 
87, 88, 91, 92, 95, 96, 99, 100, 103, 104, 107, 108, 111, 112, 
115, 116, 119, 120, 123, 124, 127, 128, 131, 132, 135, 136, 139, 
140, 143, 144, 147, 148, 151, 152, 155, 156, 175, 176, 191, 192, 
195, 196, 207, 208, 223, 224, 227, 228, 231, 232, 235, 236, 247, 
248, 267, 268, 271, 272, 275, 276, 279, 280, 283, 284, 287, 288, 
291, 292, 295, 296, 299, 300, 315, 316, 319, 320, 323, 324, 327, 
328, 331, 332, 335, 336, 339, 340, 343, 344, 351, 352, 355, 356, 
359, 360), carcommute = c(35.9, 84, 28.3, 82.6, 23.3, 63, 34.2, 
80.7, 31.1, 76.1, 29.9, 78.4, 32.2, 79.8, 31.7, 82.9, 34.1, 79.7, 
28.5, 76.3, 32.2, 81.9, 36.6, 85.5, 34.4, 83.3, 36.7, 91, 33.8, 
82.5, 47, 89.9, 41.1, 87.8, 33.6, 90.4, 38.9, 86.7, 32.1, 84.4, 
32.2, 88.7, 32.9, 87.5, 41.2, 89.1, 42.6, 87.6, 42.2, 84.2, 40.2, 
88.5, 59.9, 76.9, 59.4, 75.8, 57, 67.1, 56.9, 76.2, 67.9, 78.7, 
60.7, 75.2, 50.6, 81.5, 61, 76.5, 67.2, 83.5, 60.7, 49.7, 70.4, 
87.4, 61.6, 80.1, 62.7, 79.6, 50.4, 67, 50.1, 83.1, 51, 75.1, 
52.1, 78.3, 46, 77.7, 74, 80.7, 62.4, 88.1, 66.4, 81.6, 59.8, 
81.5, 52.4, 83.6, 55, 80.5, 61.5, 82.3, 73.5, 89.5, 74, 81.8, 
50.6, 79, 60.5, 82.8, 55.3, 77.8, 68.7, 82.1, 69.9, 86.6, 78.9, 
73.9, 76.8, 76.3, 72, 86.4, 74.1, 86.3, 74.6, 78.6, 65, 90.5, 
73.2, 79, 73.6, 63, 74.7, 72.7, 77.4, 79.2), commutetime = c(41.6, 
34.9, 37.1, 31.4, 35.1, 30.3, 36.4, 29.3, 36.8, 33.1, 37.8, 33.2, 
39.5, 35.2, 42.7, 38.6, 43.1, 37.6, 45.1, 39.3, 47.1, 38.5, 47.6, 
41.3, 43.3, 38.6, 40.3, 35.4, 39.2, 31.4, 43.3, 36.8, 43.5, 39.1, 
43.8, 35.7, 42.7, 36.4, 39.3, 31.9, 42.2, 35.3, 44, 36.4, 38.2, 
31.5, 39.5, 30.3, 39.4, 33.5, 42.1, 31, 41.1, 35.9, 32.7, 32.5, 
38.1, 35.8, 39.7, 33, 37.5, 36, 41.1, 38.6, 43.7, 37.9, 45.5, 
38.8, 42, 36.8, 22.4, 17.5, 44.3, 22.7, 39.4, 41.4, 39.9, 42.1, 
41.9, 44.7, 45.3, 43.8, 43.1, 43.4, 40.3, 47.3, 42.7, 45.9, 29, 
29.7, 34.4, 45.9, 38.3, 44, 42.7, 49.2, 41.9, 46.6, 40.9, 42.8, 
44.1, 40.7, 33.7, 35.8, 36, 42, 41.9, 50.1, 41.8, 46.2, 41.3, 
43, 43.7, 44.2, 36.9, 40.1, 25.9, 30.1, 25.5, 29.1, 39.2, 45.7, 
35.9, 33.8, 33.9, 40.4, 39.4, 39.6, 31.2, 30.7, 29.9, 27.3, 20.1, 
31.9, 26.1, 29.4), Fabric = c("Walking", "Walking", "Transit", 
"Transit", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Walking", "Walking", "Walking", "Walking", "Transit", 
"Transit", "Walking", "Walking", "Walking", "Walking", "Walking", 
"Walking", "Automobile", "Automobile", "Automobile", "Automobile", 
"Walking", "Transit", "Walking", "Walking", "Transit", "Transit", 
"Transit", "Transit", "Walking", "Walking", "Transit", "Transit", 
"Transit", "Transit", "Automobile", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Transit", "Transit", 
"Transit", "Transit", "Transit", "Transit", "Walking", "Walking", 
"Walking", "Walking", "Transit", "Transit", "Automobile", "Automobile", 
"Automobile", "Automobile", "Transit", "Transit", "Transit", 
"Transit", "Automobile", "Automobile", "Transit", "Transit", 
"Automobile", "Automobile", "Transit", "Transit", "Automobile", 
"Automobile", "Transit", "Transit", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Automobile", "Automobile", 
"Automobile", "Automobile", "Automobile", "Automobile", "Automobile", 
"Automobile")), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
), row.names = c(NA, -136L), spec = structure(list(cols = list(
    dummy = structure(list(), class = c("collector_double", "collector"
    )), carcommute = structure(list(), class = c("collector_double", 
    "collector")), commutetime = structure(list(), class = c("collector_double", 
    "collector")), Fabric = structure(list(), class = c("collector_character", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
"collector")), skip = 1), class = "col_spec"))

you will see that this is runnable code that recreates the data.

nirgrahamuk · June 16, 2020, 10:36am

with the above data in df I did

library(tidyverse)

wdf <- filter(df,
              Fabric=='Walking')
wlm <- lm(formula = carcommute ~ poly(commutetime, 2,raw=TRUE),
          data = wdf)
wdf$pred <- predict(wlm,newdata = wdf)

adf <- filter(df,
              Fabric=='Automobile')
alm <- lm(formula = carcommute ~ poly(commutetime, 2,raw=TRUE),
          data = adf)
adf$pred <- predict(alm,newdata = adf)

tdf <- filter(df,
              Fabric=='Transit')
tlm <- lm(formula = carcommute ~ commutetime,
          data = tdf)
tdf$pred <- predict(tlm,newdata = tdf)

all_df <- wdf %>% union_all(adf) %>% union_all(tdf)

label_centers <- select(all_df,
                        carcommute,commutetime,
                        Fabric) %>% group_by(Fabric) %>% summarise_all(mean)

(equations_df <-tibble(
  Fabric = c("Walking","Automobile","Transit"),
  intercept = c(wlm$coefficients[[1]],
                alm$coefficients[[1]],
                tlm$coefficients[[1]]),
  deg1 = c(wlm$coefficients[[2]],
           alm$coefficients[[2]],
           tlm$coefficients[[2]]),
  deg2 = c(wlm$coefficients[[3]],
           alm$coefficients[[3]],
           NA_real_)) %>% mutate_if(is.numeric,~round(.,digits=3)))

equations_df$deg1sign <- if_else(equations_df$deg1>0,"+","-")
equations_df$deg2sign <- if_else(equations_df$deg2>0,"+","-")
equations_df$deg1 <- abs(equations_df$deg1)
equations_df$deg2 <- abs(equations_df$deg2)
equations_df$deg2sign <- if_else(is.na(equations_df$deg2sign),"",as.character(equations_df$deg2sign))
equations_df$deg2 <- if_else(is.na(equations_df$deg2),"",as.character(equations_df$deg2))
equations_df <- equations_df %>%
  mutate(eq_text = paste("y =",intercept,
                          deg1sign,deg1,"x",deg2sign,deg2,"x^2",sep = " "))

equations_df<- left_join(equations_df,label_centers)


all_df %>%
  ggplot(aes(x = commutetime, y = carcommute, color=Fabric, shape = Fabric)) +
  geom_point() +
  theme_minimal()+
  geom_point(size = 3.5, aes(color = Fabric, shape = Fabric))+
  geom_line(mapping = aes(y=pred), size = 1)+
  scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
  scale_fill_manual(values = c("#00AFBB", "#E7B800", "#FC4E07")) +
  geom_label(data=equations_df,mapping =aes(label=eq_text), alpha=.9,nudge_x = -8,nudge_y=4,show.legend = FALSE)

HanOostdijk · June 16, 2020, 10:57am

More in line with the original code but with far less solution for the labels

# df = structure given by @nirgrahmuk
 #library(tidyverse)
 library(ggplot2)
 library(ggpmisc)
 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
 library(magrittr)
 my_equation <- y ~ x
 
 p= 
   ggplot(data=df,aes(x = commutetime, y = carcommute, color=Fabric, shape = Fabric)) +
   geom_point() +
   theme_minimal()+
   geom_point(size = 3.5, aes(color = Fabric, shape = Fabric))+
   stat_smooth(data=filter(df,!Fabric=='Transit'),method = "lm", formula = y ~ poly(x, 2), size = 1, se = FALSE)+
   stat_smooth(data=filter(df,Fabric=='Transit'),method = "lm", formula = y ~ x, size = 1, se = FALSE)+
   scale_color_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
   scale_fill_manual(values = c("#00AFBB", "#E7B800", "#FC4E07"))+
   stat_poly_eq(aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
                label.x = c('left','center','right'), label.y=c('top','center','bottom'),
                # label.x.npc = "center",label.y.npc = 0.39,
                formula = my_equation, parse = TRUE, size = 5)   
 p

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

system · July 7, 2020, 10:57am

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