How do I Bind geom_line to Grouped geom_bar

Question

I am stuck implementing the idea to combine the barplot containing fact, target and prognosis values with a line representing a fitted model based on fact and leading to prognosis values.

I am trying the following:

library(dplyr)
library(ggplot2)

bardf <- data.frame(vals = c(12,12.5, 11, 14,14.5, 15.2,14.5),
           groups = c("fact", "target", "fact", "fact", "target", "target","prognosis") %>% factor,
           xaxs = c("Jan","Jan", "Feb", "Mar","Mar", "Apr","Apr") %>% 
             factor(ordered = T, levels = c("Jan", "Feb", "Mar", "Apr"))) 
p <- bardf %>% 
  ggplot(aes(x = xaxs, y = vals, group = groups, fill = groups))+
  geom_bar(stat= "identity", position = position_dodge(0.9))

model_fits<- data.frame(fittedvals = c(12.1, 11.5, 14.1, 14.5),
                      groups = c("fact", "fact", "fact", "prognosis") %>% factor,
                      xaxs = c("Jan", "Feb", "Mar", "Apr") %>% 
                        factor(ordered = T, levels = c("Jan", "Feb", "Mar", "Apr"))) 

p +
  geom_line(aes(x = xaxs, y = fittedvals, group = groups),
            data = model_fits, stat= "identity",position = position_dodge(0.9))

This is returning the following plot:

I would like to place the nodes of the line at the x axis middle of fact or prognosis bars like this:

Note: there will be no situation when the prognosis and fact bars will be plotted for the same month simultaneously but I need to consider different fact sources like this:

data.frame(vals = c(12,12.5,13, 11, 14,14.5, 15.2,14.5),
           groups = c("fact1","target","fact2", "fact1", "fact1", "target", "target","prognosis") %>% factor,
           xaxs = c("Jan","Jan","Jan", "Feb", "Mar","Mar", "Apr","Apr") %>% 
             factor(ordered = T, levels = c("Jan", "Feb", "Mar", "Apr"))) %>% 
  ggplot(aes(x = xaxs, y = vals, group = groups, fill = groups))+
  geom_bar(stat= "identity", position = position_dodge(0.9))

For groups where two or more fact sources are available I would like to skip any x adjustments of the plotted line and plot it at exactly month x position:

In other words: how do I manually specify adjustment of each node of the line plotted over barplotor or set that the x adjustment is not required for the specific node?

Answer 1

Rather than using position_dodge for the line, you could use position_nudge to specify a vector of adjustments for the x co-ordinate:

p +
  geom_line(aes(x = xaxs, y = fittedvals, group = 1),
            data = model_fits, stat = "identity",
            position = position_nudge(x = c(-0.25, 0, -0.25, -0.25)))

Extended answer with calculation of nudge offsetts:

DODGE_WIDTH <- 0.9

bardf$usedInModel<-c(1,0,1,1,1,0,0,1) # Mark fact columns 

# used for modelling and result in prognosis columns
model_fits <-  bardf %>% 
  mutate(
    groups = groups %>% factor(ordered = T),
    usedInModelNotNA = ifelse(usedInModel&!is.na(vals), 1, 0), # skip is.na that will not be plotted
         barID = as.integer(groups)) %>% # for ordering of bars in a group
  group_by(xaxs ) %>% 
  mutate(nBars = n(), # We require number of bars in each group, and ids of bars where the line node is placed
         usedInModelNotNA = sum(usedInModelNotNA),
         barID =  barID %>% rank(),
         barID = ifelse(usedInModel, barID, NA),
         plottedBar = ifelse(nBars %in% c(0,1), 0,
                             ifelse(usedInModelNotNA > 1, 0, # if > 1 bars (values) used - place node in the middle
                                    min(barID, na.rm = T))
         )
  ) %>% 
  summarise(nBars = min(nBars),
            plottedBar = min(plottedBar)) %>% 
  ungroup() %>% 
  transmute(xaxs , 
            nudgeOffset = ifelse(plottedBar == 0, # calculate offset
                                 0, 
                                 ((plottedBar * 2 - 1) / (nBars * 2) - 0.5) * DODGE_WIDTH)
  )   %>% 
  right_join(model_fits, by = "xaxs") %>% 
  filter(!is.na(fittedvals)) 

p <- bardf %>% 
  ggplot(aes(x = xaxs, y = vals, group = groups, fill = groups))+
  geom_bar(stat= "identity", position = position_dodge(DODGE_WIDTH))


p +
  geom_line(aes(x = xaxs, y = fittedvals, group = 1),
            data = model_fits, stat = "identity",
            position = position_nudge(model_fits$nudgeOffset), 
            ) +
  geom_point(aes(xaxs, fittedvals, color = NULL, fill = NULL), 
             model_fits, 
             position = position_nudge(model_fits$nudgeOffset), 
             show.legend = FALSE,
             size = 2
  )
 

will return: