Vfrdtyky

I have the following minimal reproducible example of a lollipop/dumbbell ggplot taken from the rgraph gallery.

How do I make the bullet end points vary depending on a lookup table? The number of lines would be dynamic so it should not hardcode these. So for instance if the lower end is negative it would show a left arrow, if it's zero it should show a bullet and if it's positive it should show a right pointing arrow.

I also wanted to change the color of each line/dumbell depending on these. So for instance if the lower end is ever negative the whole line would be red, if it touches zero the whole line would be blue and it's strictly positive it should show green.

library(tidyverse)



# Create data

value1=abs(rnorm(26))*2

data=data.frame(x=LETTERS[1:26], value1=value1, value2=value1+1+rnorm(26, sd=1) )



# Reorder data using average?

data = data %>% rowwise() %>% mutate( mymean = mean(c(value1,value2) )) %>% arrange(mymean) %>% mutate(x=factor(x, x))



# plot

ggplot(data) +

  geom_segment( aes(x=x, xend=x, y=value1, yend=value2), color="grey") +

  geom_point( aes(x=x, y=value1), color=rgb(0.2,0.7,0.1,0.5), size=3 ) +

  geom_point( aes(x=x, y=value2), color=rgb(0.7,0.2,0.1,0.5), size=3 ) +

  coord_flip() 



# With a bit more style

ggplot(data) +

  geom_segment( aes(x=x, xend=x, y=value1, yend=value2), color="grey") +

  geom_point( aes(x=x, y=value1), color=rgb(0.2,0.7,0.1,0.5), size=3 ) +

  geom_point( aes(x=x, y=value2), color=rgb(0.7,0.2,0.1,0.5), size=3 ) +

  coord_flip()+

  theme_light() +

  theme(

    legend.position = "none",

    panel.border = element_blank()

  ) +

  xlab("") +

  ylab("Value of Y")

This is one way but you'll have to build the legend (if any) manually. I am concerned that you are masking which of value1 or value2 is on the left by the way you want to set the color (IMO the color should always be associated with the measure name but you are the one who wants to do it this way). It uses plain text shapes for the left bullet since you'd have to do some interesting "arrow()"-ing or use custom geoms that use emoji or images otherwise _{(others who also know how to do that and actually have spare time should definitely answer with those as there's likely going to be alot of back-and-forth with the OP with such answers given the fragility of those geoms and I just don't have that cycles it will likely take to keep tweaking an answer incessantly until all those work on the OP's system)}.

library(hrbrthemes)

library(tidyverse)

# Create data

set.seed(2018-11-14)



data_frame(

  cond = LETTERS[1:26], 

  value1 = abs(rnorm(26)) * 2,

  value2 = value1 + 1 + rnorm(26, sd = 1)

) -> xdf



# ensure there are representative conditions to test logic

xdf[9, "value1"] <- 0

xdf[10, "value1"] <- 1.1

xdf[11, "value2"] <- 0

xdf[21, "value2"] <- -xdf[21, "value2"]

xdf[26, "value1"] <- -xdf[26, "value1"]

xdf[26, "value2"] <- 0



print(xdf, n=26)



# Reorder data using average?

rowwise(xdf) %>% 

  mutate(mymean = mean(c(value1, value2))) %>% 

  arrange(mymean) %>% 

  mutate(x = factor(cond, cond)) %>% 

  mutate(left_shp = case_when(

    (value1 < 0) | (value2 < 0) ~ "<",

    (value1 == 0) | (value2 == 0) ~ "•",

    (value1 > 0) & (value2 > 0) ~ ">"

  )) %>% 

  mutate(left_size = case_when(

    (value1 < 0) | (value2 < 0) ~ 6,

    (value1 == 0) | (value2 == 0) ~ 11,

    (value1 > 0) & (value2 > 0) ~ 6

  )) %>% 

  mutate(hjust = case_when(

    (value1 < 0) | (value2 < 0) ~ 0.2,

    (value1 == 0) | (value2 == 0) ~ 0.5,

    (value1 > 0) & (value2 > 0) ~ 0.5

  )) %>% 

  mutate(

    col = case_when(

      (value1 < 0) | (value2 < 0) ~ "#cb181d",

      (value1 == 0) | (value2 == 0) ~ "#2171b5",

      (value1 > 0) & (value2 > 0) ~ "#238b45"

    )

  ) %>% 

  mutate(left = ifelse(value1 < value2, value1, value2)) %>% 

  mutate(right = ifelse(value1 > value2, value1, value2)) -> xdf



# plot

ggplot(xdf) +

  geom_segment(

    aes(x = left, xend = right, y = cond, yend = cond, color = I(col)), size = 1

  ) +

  geom_text(

    aes(x = left, y = cond, color = col, label = left_shp, hjust = I(hjust), size = I(left_size))

  ) +

  geom_point(aes(x = right, y = cond, color = col), size = 3) +

  labs(x=NULL, y= NULL) +

  theme_ipsum_rc(grid="X")