Create geom_hline with different values on each facet_grid

Hello,
Can you please help me figure out how to get different horizontal lines on each facet? I Have successfully created the 3 lines for the 3 facets, but all 3 lines appear on all 3 facets. I would like to have only one of those lines on each respective facet. I feel like I'm doing exactly what the various helpers are saying to do, but can't get it!

Here is my example...this is the first time I've tried using reprex, so I'm not sure I did it right.
Thanks! -Ryan

data_hline <- data.frame(group = unique(PercentCompliant$SubMeasureID),
                         hline = c(.5729, .3936, .93))
#> Error in unique(PercentCompliant$SubMeasureID): object 'PercentCompliant' not found

Created on 2023-01-05 with reprex v2.0.2

PercentCompliant %>% 
    ggplot(aes(x = Provider_ShortName, 
                       y = PercentCompliant)) +
    geom_point(aes(color = Provider_ShortName,
                   size = (PercTotalEligible))) +
    geom_segment(aes(x = Provider_ShortName,
                     xend = Provider_ShortName,
                     y = 0,
                     yend = PercentCompliant,
                     color = Provider_ShortName))+
    geom_hline(data = data_hline,
              aes(yintercept = hline))+
    facet_grid(cols = vars(SubMeasureID),
              scales = "fixed",
              space = "fixed"
              #labeller = (SubMeasureID = SubMeasureLabs)
              )
#> Error in PercentCompliant %>% ggplot(aes(x = Provider_ShortName, y = PercentCompliant)): could not find function "%>%"

Created on 2023-01-05 with reprex v2.0.2

The data is:

> dput(head(PercentCompliant, 100))
structure(list(Provider_ShortName = c("CPI", "CPI", "CPI", "EHS", 
"EHS", "EHS", "LCBHC", "LCBHC", "LCBHC", "MMHC", "MMHC", "MMHC", 
"PH", "PH", "PH", "SBHS", "SBHS", "SBHS", "SHG", "SHG", "SHG", 
"TGC", "TGC", "TGC", "CBI", "CBI", "CBI"), SubMeasureID = c("AMM2", 
"FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", 
"AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", 
"HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", 
"FUH7", "HDO"), TotalEligible = c(277, 147, 484, 55, 26, 93, 
81, 31, 177, 377, 174, 905, 162, 78, 245, 520, 220, 849, 101, 
51, 122, 113, 53, 118, 162, 69, 156), PercentCompliant = c(0.664259927797834, 
0.496598639455782, 0.935950413223141, 0.654545454545455, 0.461538461538462, 
0.946236559139785, 0.592592592592593, 0.354838709677419, 0.932203389830508, 
0.676392572944297, 0.511494252873563, 0.974585635359116, 0.666666666666667, 
0.5, 0.975510204081633, 0.630769230769231, 0.386363636363636, 
0.963486454652532, 0.633663366336634, 0.352941176470588, 0.942622950819672, 
0.663716814159292, 0.39622641509434, 0.966101694915254, 0.592592592592593, 
0.27536231884058, 0.955128205128205), PercTotalEligible = c(0.149891774891775, 
0.173144876325088, 0.15369958717053, 0.0297619047619048, 0.0306242638398115, 
0.0295331851381391, 0.0438311688311688, 0.0365135453474676, 0.0562083201016196, 
0.204004329004329, 0.204946996466431, 0.28739282311845, 0.0876623376623377, 
0.0918727915194346, 0.077802476976818, 0.281385281385281, 0.259128386336867, 
0.269609399809463, 0.0546536796536797, 0.0600706713780919, 0.0387424579231502, 
0.0611471861471861, 0.0624263839811543, 0.0374722134010797, 0.0876623376623377, 
0.0812720848056537, 0.0495395363607494)), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -27L), groups = structure(list(
    SubMeasureID = c("AMM2", "FUH7", "HDO"), .rows = structure(list(
        c(1L, 4L, 7L, 10L, 13L, 16L, 19L, 22L, 25L), c(2L, 5L, 
        8L, 11L, 14L, 17L, 20L, 23L, 26L), c(3L, 6L, 9L, 12L, 
        15L, 18L, 21L, 24L, 27L)), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -3L), .drop = TRUE))
library(ggplot2)
library(magrittr)
library(patchwork)
d <- data.frame(Provider_ShortName = c(
  "CPI", "CPI", "CPI", "EHS",
  "EHS", "EHS", "LCBHC", "LCBHC", "LCBHC", "MMHC", "MMHC", "MMHC",
  "PH", "PH", "PH", "SBHS", "SBHS", "SBHS", "SHG", "SHG", "SHG",
  "TGC", "TGC", "TGC", "CBI", "CBI", "CBI"
), SubMeasureID = c(
  "AMM2",
  "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO",
  "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7",
  "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2",
  "FUH7", "HDO"
), TotalEligible = c(
  277, 147, 484, 55, 26, 93,
  81, 31, 177, 377, 174, 905, 162, 78, 245, 520, 220, 849, 101,
  51, 122, 113, 53, 118, 162, 69, 156
), PercentCompliant = c(
  0.664259927797834,
  0.496598639455782, 0.935950413223141, 0.654545454545455, 0.461538461538462,
  0.946236559139785, 0.592592592592593, 0.354838709677419, 0.932203389830508,
  0.676392572944297, 0.511494252873563, 0.974585635359116, 0.666666666666667,
  0.5, 0.975510204081633, 0.630769230769231, 0.386363636363636,
  0.963486454652532, 0.633663366336634, 0.352941176470588, 0.942622950819672,
  0.663716814159292, 0.39622641509434, 0.966101694915254, 0.592592592592593,
  0.27536231884058, 0.955128205128205
), PercTotalEligible = c(
  0.149891774891775,
  0.173144876325088, 0.15369958717053, 0.0297619047619048, 0.0306242638398115,
  0.0295331851381391, 0.0438311688311688, 0.0365135453474676, 0.0562083201016196,
  0.204004329004329, 0.204946996466431, 0.28739282311845, 0.0876623376623377,
  0.0918727915194346, 0.077802476976818, 0.281385281385281, 0.259128386336867,
  0.269609399809463, 0.0546536796536797, 0.0600706713780919, 0.0387424579231502,
  0.0611471861471861, 0.0624263839811543, 0.0374722134010797, 0.0876623376623377,
  0.0812720848056537, 0.0495395363607494
))

data_hline <- c(0.25,0.5,0.75)
to_facet <- unique(d$SubMeasureID)

theme_sides <- function(){ 
  theme_minimal() %+replace% 
    theme(
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
    )
}

plot_one <- function(x) {
  d[d$SubMeasureID == to_facet[x],] %>%
    ggplot(aes(Provider_ShortName, 
               PercentCompliant)) +
    geom_point(aes(color = Provider_ShortName,
                   size = (PercTotalEligible))) +
    geom_segment(aes(Provider_ShortName,
                     xend = Provider_ShortName,
                     0,
                     yend = PercentCompliant,
                     color = Provider_ShortName)) +
    geom_hline(aes(yintercept = data_hline[x])) +
    ylim(0,1) +
    labs(x = NULL) +
    (if(x != 2) labs(y = NULL)) +
    theme_sides() +
    (if(x != 2) theme(legend.position = "none"))
}

plot_one(1) + plot_one(2) + plot_one(3)

1 Like

Thanks technocrat!
This works, but I confess, I do not understand why it works. I understand parts of it. Would you mind giving me a brief, "Hey, this is why it works..."?

There's a lot of plumbing.

The simple part is patchwork::+ which places separate ggplot objects horizontally. / for vertically.

Because there appears no way (or at least obvious) way to give each geom_facet ~element an individual treatment, we need to set hline on a separate plot for each of the faceting variables.

We do that one-at-a-time with plot(1) + plot(2) + plot(3).

The plot_one() avoids having to adjust the particulars one by one. That's the purpose of subsetting the source data frame by the three SubMeasureID values, and data_hline[1]` which takes the respective index given to the function.

Every thing else is decoration. theme_minimal() clears out the background, just as a matter of principle and it is touched up to clear the grid. Then because otherwise there would be multiple legends, that is handled in the if statement. That has to be enclosed in its own () to evaluate before being passed on to + so that it's treated as aggplot object to be handled as such or whether the ordinary method of + applies.

theme() provides very fine tuned capacity to individually vary elements, but it's easy to fall into a rabbit hole fiddling.

A title can be added to one of the panels, but I didn't do that.

Thank you for the walk through! I think I am getting it. Clever work. I think I need to do some more research on creating functions. I'll report back with the final product.

1 Like

Once I cobble something together I use the RStudio menu Code | Extract Function, then take out all of the arguments that don’t change.

OK, so I was cruising along to polishing this up and hit a couple hicups.

I removed the legends altogether because I don't need them. The things I do need are, 1) titles over the panels for the SubMeasureIDs (which would be strip text), 2) the scale_y_continuous to be 0-100% on all three plots, and 3) the Plot Title, Subtitle, and caption. I tried a few different options, but each came out wonkier than the next.

Here is another question. In the IF statements, why does "x != 1" work, but "x = 1" always errors out.

Thanks for your time. It would of course be easier to just say "forget the threshold lines", but we've come so far!
-Ryan

data_hline <- c(0.5729, 0.3936, 0.93)
to_facet <- unique(d$SubMeasureID)

My_Lollipop_Theme <- function(){ 
  theme_minimal() %+replace% 
    theme(
      legend.position = "none",
      panel.grid.major.y = element_line(
        color = NULL,
        linewidth = .5
      ),
      panel.grid.major.x = element_blank(),
      panel.grid.minor = element_blank(),
      # panel.border = element_rect(
      #   color = "gray",
      #   linewidth = .5
      #),
      axis.text.x = element_text(
        angle = 65, 
        vjust = 1.1, 
        hjust=1,
        size = 12
      )
      )
}

plot_one <- function(x) {
  d[d$SubMeasureID == to_facet[x],] %>%
    ggplot(aes(Provider_ShortName, 
               PercentCompliant)) +
    geom_point(aes(color = Provider_ShortName,
                   size = (PercTotalEligible))) +
    geom_segment(aes(Provider_ShortName,
                     xend = Provider_ShortName,
                     0,
                     yend = PercentCompliant,
                     color = Provider_ShortName)) +
    geom_hline(aes(yintercept = data_hline[x],
                   color = "gray")) +
    ylim(0,1) +
    labs(x = NULL) +
    (if(x != 1) labs(y = NULL))+
    #scale_y_continuous(labels = scales::percent)+
    My_Lollipop_Theme()
}

plot_one(1) + plot_one(2) + plot_one(3)

  # labs(title = "Alliance Provider Target Measure Compliance",
  #     subtitle = "With Percent of Total Eligible Participants",
  #     caption = "Data source: BCBSAZ VBP Report, Claims Adjudicated Through Sept. 2022") 
  #     caption = "Data source: BCBSAZ VBP Report, Claims Adjudicated Through Sept. 2022") 

Do you want x == 1 (equality operator, rather than assignment)?

I'll get back to you on the tweaking. Ping me after a decent interval?

Oh, good point. I believe the former, equality operator.
But, when I do:

(if(x == 2) labs(title = "Alliance Provider Target Measure Compliance"))

I get this error:
Error in [.data.frame(d, d$SubMeasureID == to_facet, ) : object 'x' not found

x means different things in different contexts.

 x
# Error: object 'x' not found
print(x"foo")
#  Error: unexpected string constant in "print(x"foo""
x <- 5
f <- function(x) x+x # a parameter
f(x) # argument to the parameter
[1] 10
f(y)
# Error in f(y) : object 'y' not found
y <- 2
f(y)
# 4

Do you want the y-axis scale on all three? If just one, which?

image

Hello,
Just on one. The first (furthest to the left).
Thanks!

via

library(ggplot2)
library(magrittr)
library(patchwork)
d <- data.frame(Provider_ShortName = c(
  "CPI", "CPI", "CPI", "EHS",
  "EHS", "EHS", "LCBHC", "LCBHC", "LCBHC", "MMHC", "MMHC", "MMHC",
  "PH", "PH", "PH", "SBHS", "SBHS", "SBHS", "SHG", "SHG", "SHG",
  "TGC", "TGC", "TGC", "CBI", "CBI", "CBI"
), SubMeasureID = c(
  "AMM2",
  "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO",
  "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7",
  "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2",
  "FUH7", "HDO"
), TotalEligible = c(
  277, 147, 484, 55, 26, 93,
  81, 31, 177, 377, 174, 905, 162, 78, 245, 520, 220, 849, 101,
  51, 122, 113, 53, 118, 162, 69, 156
), PercentCompliant = c(
  0.664259927797834,
  0.496598639455782, 0.935950413223141, 0.654545454545455, 0.461538461538462,
  0.946236559139785, 0.592592592592593, 0.354838709677419, 0.932203389830508,
  0.676392572944297, 0.511494252873563, 0.974585635359116, 0.666666666666667,
  0.5, 0.975510204081633, 0.630769230769231, 0.386363636363636,
  0.963486454652532, 0.633663366336634, 0.352941176470588, 0.942622950819672,
  0.663716814159292, 0.39622641509434, 0.966101694915254, 0.592592592592593,
  0.27536231884058, 0.955128205128205
), PercTotalEligible = c(
  0.149891774891775,
  0.173144876325088, 0.15369958717053, 0.0297619047619048, 0.0306242638398115,
  0.0295331851381391, 0.0438311688311688, 0.0365135453474676, 0.0562083201016196,
  0.204004329004329, 0.204946996466431, 0.28739282311845, 0.0876623376623377,
  0.0918727915194346, 0.077802476976818, 0.281385281385281, 0.259128386336867,
  0.269609399809463, 0.0546536796536797, 0.0600706713780919, 0.0387424579231502,
  0.0611471861471861, 0.0624263839811543, 0.0374722134010797, 0.0876623376623377,
  0.0812720848056537, 0.0495395363607494
))

data_hline <- c(0.5729, 0.3936, 0.93)
to_facet <- unique(d$SubMeasureID)

title <- "Alliance Provider Target Measure Compliance"
subtitle <- "With Percent of Total Eligible Participants"
caption <- "Data source: BCBSAZ VBP Report, Claims Adjudicated Through Sept. 2022"
theme_sides <- function(){ 
  theme_minimal() %+replace% 
    theme(
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
    )
}

plot_one <- function(x) {
  d[d$SubMeasureID == to_facet[x],] %>%
    ggplot(aes(Provider_ShortName, 
               PercentCompliant)) +
    geom_point(aes(color = Provider_ShortName,
                   size = (PercTotalEligible))) +
    geom_segment(aes(Provider_ShortName,
                     xend = Provider_ShortName,
                     0,
                     yend = PercentCompliant,
                     color = Provider_ShortName)) +
    geom_hline(aes(yintercept = data_hline[x])) +
    ylim(0,1) +
    (if(x != 2) xlab(NULL)) +
    (if(x != 1) ylab(NULL)) +
    scale_y_continuous(labels = scales::percent) +
    theme_sides() +
    (if(x != 2) theme(legend.position = "none"))
}

main_plot <- plot_one(1) + plot_one(2) + plot_one(3)

title_plot <- ggplot() + labs(title = title,
                            subtitle = subtitle) +
                         theme_minimal()

caption_plot <- ggplot() + labs(caption = caption) + theme_minimal()
title_plot / main_plot / caption_plot

Good morning,
Thanks for your continued assistance. When I run this, I get: Error in ggplot_add():
! Can't add plot_one(2) to a object. Ultimately telling me main_plot can't be found.

Run my example, again? You should get the screenshot below

Greetings. This did work, but still wasn't quite what I wanted visually. Then a colleague of mine, with basically no R knowledge, came up with the most brilliantly simple answer. She suggested, "Can you just layer a line graph on top of it all?" :exploding_head:

It totally works. In the original data table there is already a vector for the target mean that we use for other analyses.

I hope you're not offended technocrat. Your help has been instrumental!

The final code went like this:

#Data
structure(list(Provider_ShortName = c("CPI", "CPI", "CPI", "EHS", 
"EHS", "EHS", "LCBHC", "LCBHC", "LCBHC", "MMHC", "MMHC", "MMHC", 
"PH", "PH", "PH", "SBHS", "SBHS", "SBHS", "SHG", "SHG", "SHG", 
"TGC", "TGC", "TGC", "CBI", "CBI", "CBI"), SubMeasureID = c("AMM2", 
"FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", 
"AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", 
"HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", 
"FUH7", "HDO"), TotalEligible = c(277, 147, 484, 55, 26, 93, 
81, 31, 177, 377, 174, 905, 162, 78, 245, 520, 220, 849, 101, 
51, 122, 113, 53, 118, 162, 69, 156), PercentCompliant = c(0.664259927797834, 
0.496598639455782, 0.935950413223141, 0.654545454545455, 0.461538461538462, 
0.946236559139785, 0.592592592592593, 0.354838709677419, 0.932203389830508, 
0.676392572944297, 0.511494252873563, 0.974585635359116, 0.666666666666667, 
0.5, 0.975510204081633, 0.630769230769231, 0.386363636363636, 
0.963486454652532, 0.633663366336634, 0.352941176470588, 0.942622950819672, 
0.663716814159292, 0.39622641509434, 0.966101694915254, 0.592592592592593, 
0.27536231884058, 0.955128205128205), PercTotalEligible = c(0.149891774891775, 
0.173144876325088, 0.15369958717053, 0.0297619047619048, 0.0306242638398115, 
0.0295331851381391, 0.0438311688311688, 0.0365135453474676, 0.0562083201016196, 
0.204004329004329, 0.204946996466431, 0.28739282311845, 0.0876623376623377, 
0.0918727915194346, 0.077802476976818, 0.281385281385281, 0.259128386336867, 
0.269609399809463, 0.0546536796536797, 0.0600706713780919, 0.0387424579231502, 
0.0611471861471861, 0.0624263839811543, 0.0374722134010797, 0.0876623376623377, 
0.0812720848056537, 0.0495395363607494), AdaptedNCQAMean = c(0.57, 
0.39, 0.93, 0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 
0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 0.57, 0.39, 
0.93, 0.57, 0.39, 0.93)), class = c("grouped_df", "tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -27L), groups = structure(list(
    SubMeasureID = c("AMM2", "FUH7", "HDO"), .rows = structure(list(
        c(1L, 4L, 7L, 10L, 13L, 16L, 19L, 22L, 25L), c(2L, 5L, 
        8L, 11L, 14L, 17L, 20L, 23L, 26L), c(3L, 6L, 9L, 12L, 
        15L, 18L, 21L, 24L, 27L)), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -3L), .drop = TRUE))
#Code
PercentCompliant1 %>% 
  ggplot(aes(x = Provider_ShortName, 
             y = PercentCompliant)) +
  geom_line(aes(x = Provider_ShortName,
                y = AdaptedNCQAMean,
                group = SubMeasureID,
                color = "#9a0138",
                size = .025)) +
  geom_point(aes(color = Provider_ShortName,
                 size = (PercTotalEligible))) +
  geom_segment(aes(x = Provider_ShortName,
                   xend = Provider_ShortName,
                   y = 0,
                   yend = PercentCompliant,
                   color = Provider_ShortName))+
  facet_grid(cols = vars(SubMeasureID),
             scales = "fixed",
             space = "fixed")+
  theme_classic()+
  theme(legend.position = "none") + 
  theme(panel.spacing = unit(.5, "lines"),
        panel.border = element_rect(
          color = "black", 
          fill = NA, 
          linewidth = .5), 
        panel.grid.major.y = element_line(
          color = "gray", 
          linewidth = .5),
        axis.text.x = element_text(
          angle = 65, 
          hjust=1),
        axis.text.y = element_text(
          size = 12),
        axis.title.x = element_blank(),
        axis.line = element_blank(),
        strip.background = element_rect(
          color = NULL, 
          fill = "#e1e7fa"))+
  scale_y_continuous(labels = scales::percent)+
  labs(title = "Test",
       subtitle = "Test",
       caption = "Test")
1 Like

Good work. Props to your colleague!

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

If you have a query related to it or one of the replies, start a new topic and refer back with a link.