Add the average value of a column as a point in a line plot

Question

I would like to add the average value of a column as a point/text at specific intervals.

I have this plot:

My dataframe consists of the following data:

structure(list(optz = c(1067, 1067, 1067, 1067, 1067, 1067, 1067, 
1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 
1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 
1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 
1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 
1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067), e_val = c(6.1565, 
5.4915, 4.647, 3.7871, 5.2397, 5.8252, 4.647, 5.8252, 4.5617, 
4.3906, 5.0711, 5.9082, 4.7321, 4.9866, 4.8171, 3.7003, 5.4078, 
4.0467, 4.7321, 4.647, 4.647, 5.0711, 4.0467, 4.9019, 5.3238, 
4.9866, 5.2397, 4.0467, 5.2397, 5.3238, 4.7321, 3.5262, 6.1565, 
3.4389, 5.6587, 5.742, 4.7321, 5.3238, 4.7321, 4.647, 4.0467, 
5.0711, 4.4762, 4.5617, 4.9019, 4.3906, 3.2638, 4.8171, 3.2638, 
4.647, 4.3049, 3.5262, 4.3906, 4.1329, 4.4762, 4.0467, 5.1555, 
5.1555, 3.3514, 3.3514), Ctime = c(100.8656, 105.7428, 113.8558, 
108.7743, 103.1432, 111.9795, 108.8254, 107.0829, 99.2327, 100.002, 
88.4304, 105.3633, 106.6242, 98.2432, 102.5163, 110.1165, 95.3913, 
95.3288, 108.5169, 114.2813, 152.393, 164.0396, 135.2379, 161.8865, 
162.6032, 139.7406, 163.0824, 167.3038, 155.7465, 166.0113, 159.9243, 
147.9156, 153.5766, 160.7025, 168.5825, 138.6539, 140.4861, 135.3083, 
153.4059, 152.83, 214.338, 214.0513, 192.4158, 203.7792, 216.6077, 
202.8908, 205.3991, 216.3706, 215.6574, 210.9652, 190.4783, 182.6495, 
205.7483, 199.6231, 194.0155, 203.9086, 196.9656, 205.351, 186.1295, 
173.8961), step = c(20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 
20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 30L, 30L, 
30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 
30L, 30L, 30L, 30L, 30L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 
40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L, 40L), 
    method = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L), .Label = c("QV", "VN"), class = "factor")), row.names = 2:61, class = "data.frame")

And my code is:

ggplot(data = df, aes(x = Ctime, y = e_val, group = method, color = method)) +
  stat_smooth(data = df, level = 0.8) +
  ggtitle('M1 vs M2 _ time')+
  ylab('e_val')+
  xlab('Ctime')

I would like to add the average value of step column on the intervals that appear (dynamically) on axis x. For example for the automatically generated intervals {120, 160, 200} shown on axis x:

mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 24.44
mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 28.88
    
mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 22.85
mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 25.71

So the desired plot should look like this:

user_2080848 · Answer

Try this approach computing loess() for the desired points and adding them with any of these two options. The key is the loess() values. Here the code:

library(tidyverse)
#Code
p1 <- ggplot(data = df, aes(x = Ctime, y = e_val, group = method, color = method)) +
  stat_smooth(data = df, level = 0.8) +
  ggtitle('M1 vs M2 _ time')+
  ylab('e_val')+
  xlab('Ctime')
#Create labels
v1 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
v2 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 24.44
v3 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 28.88
w1 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
w2 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 22.85
w3 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 25.71

A fundamental step is the loess() model for each group:

#Models and labels
m1 <- loess(e_val~Ctime,data=df[df$method=='VN',])
m2 <- loess(e_val~Ctime,data=df[df$method=='QV',])
pred1 <- predict(m1,data.frame(Ctime=c(120,160,200)))
pred2 <- predict(m2,data.frame(Ctime=c(120,160,200)))

With that, we compute the positions and labels:

#Labels and positions 1
df1 <- data.frame(x=c(120,160,200),
                  y=pred1,
                  lab=c(v1,v2,v3))
df2 <- data.frame(x=c(120,160,200),
                  y=pred2,
                  lab=c(w1,w2,w3))

#Labels and positions 2
df1 <- data.frame(x=c(120,160,200),
                  y=pred1,
                  lab=c(v1,v2,v3),
                  method='VN')
df2 <- data.frame(x=c(120,160,200),
                  y=pred2,
                  lab=c(w1,w2,w3),
                  method='QV')
df3 <- rbind(df1,df2)

Now the first option:

#Option 1
q1 <- p1+annotate(geom = 'point',x=df1$x,y=df1$y,color='blue',size=3,)+
  annotate(geom = 'point',x=df2$x,y=df2$y,color='red',size=3,)+
  annotate(geom = 'text',x=df1$x,y=df1$y,label=round(df1$lab,2),
           size=3,hjust=-0.5,color='cyan4',fontface='bold')+
  annotate(geom = 'text',x=df2$x,y=df2$y,label=round(df2$lab,2),
           size=3,hjust=-0.5,color='tomato',fontface='bold')

Output:

And the second option:

#Option 2
q1 <- p1+geom_point(data=df3,aes(x=x,y=y,group=method,color=method),size=3,show.legend = F)+
  geom_text(data=df3,aes(x=x,y=y,group=method,label=round(lab,2)),
            hjust=-0.5,size=3,fontface='bold',show.legend = F)

Output:

Update: You can use a vector for defined values of breaks like this mybreaks:

library(tidyverse)
#Code
mybreaks <- c(100,150,200)
#Plot
p1 <- ggplot(data = df, aes(x = Ctime, y = e_val, group = method, color = method)) +
  stat_smooth(data = df, level = 0.8) +
  scale_x_continuous(breaks = mybreaks)+
  ggtitle('M1 vs M2 _ time')+
  ylab('e_val')+
  xlab('Ctime')
#Create labels
v1 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
v2 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 24.44
v3 <- mean(df[df$method=='QV' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 28.88
w1 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 120 == 0),]$step) # 20
w2 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 160 == 0),]$step) # 22.85
w3 <- mean(df[df$method=='VN' & (df$Ctime - df$Ctime %% 200 == 0),]$step) # 25.71
#Models and labels
m1 <- loess(e_val~Ctime,data=df[df$method=='VN',])
m2 <- loess(e_val~Ctime,data=df[df$method=='QV',])
pred1 <- predict(m1,data.frame(Ctime=mybreaks))
pred2 <- predict(m2,data.frame(Ctime=mybreaks))
#Labels and positions 1
df1 <- data.frame(x=mybreaks,
                  y=pred1,
                  lab=c(v1,v2,v3))
df2 <- data.frame(x=mybreaks,
                  y=pred2,
                  lab=c(w1,w2,w3))

#Labels and positions 2
df1 <- data.frame(x=mybreaks,
                  y=pred1,
                  lab=c(v1,v2,v3),
                  method='VN')
df2 <- data.frame(x=mybreaks,
                  y=pred2,
                  lab=c(w1,w2,w3),
                  method='QV')
df3 <- rbind(df1,df2)
#Option 1
q1 <- p1+annotate(geom = 'point',x=df1$x,y=df1$y,color='blue',size=3,)+
  annotate(geom = 'point',x=df2$x,y=df2$y,color='red',size=3,)+
  annotate(geom = 'text',x=df1$x,y=df1$y,label=round(df1$lab,2),
           size=3,hjust=-0.5,color='cyan4',fontface='bold')+
  annotate(geom = 'text',x=df2$x,y=df2$y,label=round(df2$lab,2),
           size=3,hjust=-0.5,color='tomato',fontface='bold')
#Option 2
q1 <- p1+geom_point(data=df3,aes(x=x,y=y,group=method,color=method),size=3,show.legend = F)+
  geom_text(data=df3,aes(x=x,y=y,group=method,label=round(lab,2)),
            hjust=-0.5,size=3,fontface='bold',show.legend = F)

Outputs:

Add the average value of a column as a point in a line plot

1 Answers