ggplot gallery - add lollipop with ref line

[OskaratOmni]

Can we please add this kind of graph to the gallery: [sorry, screen shot, crude ggplot code, and data coming soon - David what is best way for me to attach an rds with the data used to make this figure to this issue?]

[OskaratOmni]

Here's a screenshot of an example:

[OskaratOmni]

code used to make it:

knitr::opts_chunk$set(echo = FALSE,
                      warning = FALSE,
                      error = FALSE,
                      message = FALSE,
                      fig.topcaption = FALSE,
                      fig.cap = FALSE,
                      dpi = 150)

library(tidyverse) #loads multiple packages for BP data management, viz, and more. Should always incldue
library(omni)
library(gridExtra)
library(janitor)
library(reshape2)

#import data
report_data_wide <- read_rds("data/outcomes_wide_11.7.rds")

#filter for csb
report_data_wide <- report_data_wide 

#create function for sig. test pvalue star
pvalue <- function(value) {
  case_when(
    value <= .05 ~ "*",
    value > .05 ~ "",
    TRUE ~ "")
}

# set suppression threshold 
suppression_threshold <- 15 # set min n of responses csb must have to display data

# prep barc df for plot

#intake barc10 score
intake_barc <- report_data_wide %>% 
  filter(!is.na(Barc10_pre_new)) %>% # these filters together mandate only "paired" records where we have data for the client at intake (pre) and latest assessment (post)
  filter(!is.na(Barc10_post_new)) %>% 
  summarise(Intake=mean(Barc10_pre_new, na.rm = T))

#fu barc10 score
followup_barc <- report_data_wide %>% 
  filter(!is.na(Barc10_pre_new)) %>% # these filters together mandate only "paired" records where we have data for the client at intake (pre) and latest assessment (post)
  filter(!is.na(Barc10_post_new)) %>% 
  summarise(`Latest Assessment`=mean(Barc10_post_new, na.rm = T))

#create values of n for intake and follow-up
barc_n <- report_data_wide %>% 
  filter(!is.na(Barc10_pre_new)) %>% 
  filter(!is.na(Barc10_post_new)) %>%
  nrow()

#merge these 3 values (mean barc pre, mean barc post, n paired records) into a df
barc_data <- data.frame(intake_barc,followup_barc,barc_n)

# conditional statement saying that the intake & latest a n must be > suppression threshold, or turn result into 0

if (barc_data$barc_n < suppression_threshold){

  barc_data <- barc_data %>% 
    mutate(Intake = 0,
           `Latest.Assessment` = 0)
}

# prep df for plot
barc_data <- barc_data %>% 
  select(-'barc_n') %>% 
  mutate(label = "BARC-10 Score") %>% 
  mutate(Intake = as.numeric(Intake)) %>% 
  mutate(`Latest.Assessment` = as.numeric(`Latest.Assessment`))

barc_data$Intake = round_half_up(barc_data$Intake, 0)
barc_data$`Latest.Assessment` = round_half_up(barc_data$`Latest.Assessment`, 0)

colnames(barc_data) <- c("Intake", "Latest Assessment", "label")

# reformat so that intake and latest assessment are on own row
barc_melted <- melt(data = barc_data, id = "label")

# modify class of "variable"/ create temp "newvar"
barc_melted$newvar = str_wrap(barc_melted$variable, width = 5)

barc_melted$variable <- factor(barc_melted$variable, levels = c("Intake", "Latest Assessment"), labels=c("Intake", "Latest Assessment"))

# make plot 

# assign colors for plot 
blue <- "#314160"
charcoal <- "#465966" 
grey <- "#bfbfbf"

# par sets plotting parameters. mar sets margins (vector of length 4 setting bottom, left, top, right)
par(mar=c(0,0,0,0))

# create plot with arranged df! 
barc_plot <- barc_melted %>% 
  arrange(newvar) %>%
  ggplot()+
  aes(x = value, 
      y = forcats::fct_rev(newvar), 
      color = newvar) + 
  geom_point(size = 12, shape = 19) +
  theme_bw() + 
  labs(x = "", y = "") +
  scale_x_continuous(limits = c(20,60), breaks = c(20,60)) +
  scale_color_manual(values = c(Intake = blue, "Latest\nAssessment" = blue)) +
  geom_vline(xintercept = 47, linewidth = 1.5, color = "#779aab") +
  geom_text(aes(x=38, label="Sustained Remission: 47", y="Intake"), colour="#779aab", vjust = -2) + # text=element_text(size=11)
  annotate("text", x = barc_melted$value, y = barc_melted$newvar, label = barc_melted$value, size = 4, fontface = "bold", color = "white") +
  theme( legend.position = "none",
         axis.ticks = element_blank(),
         panel.border = element_blank(),
         panel.grid.minor.x = element_blank(),
         panel.grid.major.x = element_blank(),
         # panel.grid.major.y = element_line(color = grid, size = 0.5))
         axis.line.x = element_blank(),
         axis.line.y = element_blank(),
         axis.text.y = element_text(colour = "black", size = 12),
         axis.text.x = element_text(colour = "black", size = 12, vjust = 85))

barc_plot

# create label to present plot

if(barc_n < suppression_threshold){
  barc_label <- "Not enough participants responded to report on BARC-10 scores."
} else if(barc_data$Intake[1] == barc_data$`Latest Assessment`[1]) {
     barc_label <- paste0("The average BARC-10 score at the latest assessment GPRA and intake was <B>",barc_data$intake[1],"</B>.")
} else {
     barc_label <- paste0(
       "The average BARC-10 score at the latest assessment GPRA was <B>",barc_data$`Latest Assessment`[1],"</B>, compared to <B>",barc_data$Intake[1],"</B> at intake."
     )
}

# do sig testing 
 barc_diff <-  report_data_wide$Barc10_pre_new - report_data_wide$Barc10_post_new

if(barc_n < suppression_threshold){
  shapiro_barc <- NA
} else{
  shapiro_barc <- shapiro.test(barc_diff)
}

# shapiro_barc <- shapiro.test(barc_diff)

if(length(shapiro_barc)==1){
  t_barc <- NA
} else if(shapiro_barc$p.value > .05){
  t_barc <- t.test(report_data_wide$Barc10_pre_new, report_data_wide$Barc10_post_new, paired = TRUE, alternative = "two.sided")
} else{
  t_barc <- wilcox.test(report_data_wide$Barc10_pre_new, report_data_wide$Barc10_post_new, paired = TRUE)
}

if(length(t_barc)==1){
  star_barc <- ""
} else if(t_barc$p.value < .05){
  star_barc <- "*"
} else{
  star_barc <- ""
}

\newpage

**Recovery Capital**

`r barc_label``r star_barc`

```{r fig.height=2, dpi = 70} barc_plot ```

`

[OskaratOmni]

data used to make the example plot above - outcomes_wide.csv

[dgkeyes]

I've added this here: https://stupendous-biscuit-9f1c75.netlify.app/ggplot/graph_lollipop_ref_line.html