How to add semicircles overlying geom_point in ggplot2

Question

I am trying to generate a dotplot that shows changes in virus infection over time in multiple individuals. More than one virus can be detected, and I want each virus to have its own color in the dotplot. Where it gets complicated is when an individual has more than one virus at the same timepoint. I would like to display this data by showing the 2nd virus as a semicircle on top of the first virus present. I have been playing around with this and it looks like adding a 2nd geom_point layer in ggplot2 with a unicode character for a semicircle (e.g. "\u25D7") is one of the easier ways to do this. However, I'm running into two issues.

First: I can't get the unicode characters to display in any ggplot. I get the hollow square of failure instead.

Second: I need to suppress one of the result categories ("Neg" in "Res2") so that semicircles are only imposed at dots where two viruses are detected simultaneously.

Any advice would be greatly appreciated! I'm running R v 4.4.0 with English_United States.utf8 on Windows 10.

Some example data and code:

library(ggplot2)
library(ggthemes)
library(tidyverse)
library(dplyr)

AnimalID<-c("A","A","A","A","A","B","B","B","B","B","C","C","C","C","C")
Week<-c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)
Res1<-c("HV1","HV1","Neg","HV2","Neg","Neg","HV2","HV1","HV1","HV1","HV1","HV1","HV2","Neg","HV1")
Res2<-c("HV2","Neg","Neg","Neg","Neg","Neg","Neg","HV2","Neg","Neg","Neg","HV2","Neg","Neg","Neg")
AllHV<-c("HV1 and HV2","HV1","Neg","HV2","Neg","Neg","HV2","HV1 and HV2","HV1","HV1","HV1","HV1 and      HV2","HV2","Neg","HV1")
     
db<-data.frame(AnimalID,Week,Res1,Res2,AllHV)

Exgraph<-
ggplot(db,aes(x= Week, y=AnimalID, color=Res1)) + 
geom_point(size=3,shape=16) +
theme_tufte() +
ggtitle("HV Shedding Patterns") +
xlab("Study Week") +
ylab("Animal ID") +
theme(axis.line = element_line(colour = "black")) +
theme(plot.title = element_text(face = "bold",size=18)) +
theme(axis.text = element_text(size = 10)) +
theme(axis.title = element_text(face = "bold",size = 14)) +
theme(legend.title = element_text(size = 14, face = "bold"),legend.text = element_text(size = 11)) +
labs(color='HV')+
geom_point(aes(x= Week, y=AnimalID, color=Res2)) ## this is where I'd be adding the unicode +
scale_color_manual(values=c("green","blue","grey80"))

Exgraph`

Answer 1

A more elaborated option would be to use some custom shapes. The approach below builds on this answer by @AllanCameron (which I already applied here) and this answer by @Baptiste to create the custom shape using grid:

library(dplyr, warn = FALSE)
library(purrr)
library(grid)
library(ggplot2)
library(ggpmisc)

pal_color <- c(HV1 = "green", HV2 = "blue", Neg = "grey80")

custom_shape <- function(r1 = .1,
                         r2 = r1,
                         scale = 1,
                         angle = 0,
                         shape = "full",
                         gp = gpar()) {
  if (shape == "half") {
    th2 <- seq(0, pi, length = 180)
    th1 <- th2 + pi
    d1 <- r1 * scale * cbind(cos(th1 + angle * pi / 180), sin(th1 + angle * pi / 180))
    d2 <- r2 * scale * cbind(cos(th2 + angle * pi / 180), sin(th2 + angle * pi / 180))

    polygonGrob(
      unit(c(d1[, 1], d2[, 1]), "snpc") + unit(0.5, "npc"),
      unit(c(d1[, 2], d2[, 2]), "snpc") + unit(0.5, "npc"),
      id = rep(1:2, each = length(th1)),
      gp = gp
    )
  } else {
    circleGrob(
      x = unit(0.5, "npc"),
      y = unit(0.5, "npc"),
      r = r1 * scale,
      gp = gp
    )
  }
}

db <- db |>
  mutate(
    is_neg = Res1 == "Neg" | Res2 == "Neg",
    is_full = (Res1 == Res2) | is_neg,
    shape = if_else(is_full, "full", "half"),
    fill = purrr::map2(Res1, Res2, ~ unique(pal_color[c(.x, .y)])),
    grob = purrr::pmap(
      list(fill = fill, shape = shape),
      \(fill, shape) {
        custom_shape(
          shape = shape,
          gp = gpar(fill = fill, col = NA),
          angle = 90,
          scale = 1
        )
      }
    )
  )

ggplot(db, aes(x = Week, y = AnimalID, color = Res1)) +
  # Only used to get a legend
  geom_point(x = NA, y = NA, na.rm = TRUE) +
  #
  geom_grob(aes(x = Week, y = AnimalID, label = grob)) +
  scale_color_manual(values = pal_color) +
  labs(
    title = "HV Shedding Patterns",
    x = "Study Week",
    y = "Animal ID",
    color = "HV"
  )

UPDATE The code below offers a refactored version of custom_shape which now allows for circles of an arbitrary numbers of parts.

pal_color <- c(HV1 = "green", HV2 = "blue", HV3 = "red", Neg = "grey80")

custom_shape <- function(r = .1,
                         scale = 1,
                         angle = 0,
                         n = 1,
                         gp = gpar()) {
  make_polygon_data <- function(n = 1, r = .1, scale = 1) {
    th_base <- seq(0, 2 * pi / n, length = 180)
    th <- lapply(seq_len(n), \(i) th_base + (i - 1) * 2 * pi / n)

    lapply(th, \(th) {
      r * scale * cbind(
        c(0, cos(th + angle * pi / 180), 0),
        c(0, sin(th + angle * pi / 180), 0)
      )
    })
  }

  d <- make_polygon_data(n, r = r, scale = scale)

  x <- Reduce(\(xx, x) c(xx, x[, 1]), d, NULL)
  y <- Reduce(\(yy, y) c(yy, y[, 2]), d, NULL)

  polygonGrob(
    unit(x, "snpc") + unit(0.5, "npc"),
    unit(y, "snpc") + unit(0.5, "npc"),
    id = rep(seq_len(n), each = 182),
    gp = gp
  )
}

tibble(
  x = seq(5),
  n = seq(5),
  fill = purrr::map(seq(5), \(n) scales::hue_pal()(n))
) |>
  mutate(
    grob = map2(
      fill, n,
      \(fill, n) {
        custom_shape(
          n = n,
          gp = gpar(fill = fill, col = NA),
          scale = 4
        )
      }
    )
  ) |>
  ggplot() +
  geom_grob(aes(x = factor(x), y = factor(x), label = grob))

And now applied to your real data where I added a third results column Res3:

set.seed(123)

db$Res3 <- sample(c("HV1", "HV2", "HV3", "Neg"), nrow(db), replace = TRUE)

db <- db |>
  mutate(
    is_neg = rowSums(across(c(Res1, Res2, Res3), ~ .x == "Neg")) > 0,
    n = purrr::pmap_int(list(Res1, Res2, Res3), \(x, y, z) n_distinct(c(x, y, z))),
    n = if_else(is_neg, 1, n),
    fill = purrr::pmap(list(Res1, Res2, Res3), \(x, y, z) unique(pal_color[c(x, y, z)])),
    grob = map2(
      fill, n,
      \(fill, n) {
        custom_shape(
          n = n,
          gp = gpar(fill = fill, col = NA),
          angle = 90,
          scale = 1
        )
      }
    )
  )

ggplot(db, aes(x = Week, y = AnimalID)) +
  # Only used to get a legend
  geom_point(
    data = data.frame(color = names(pal_color)),
    aes(color = color),
    x = NA, y = NA, na.rm = TRUE
  ) +
  #
  geom_grob(aes(x = Week, y = AnimalID, label = grob)) +
  scale_color_manual(values = pal_color) +
  labs(
    title = "HV Shedding Patterns",
    x = "Study Week",
    y = "Animal ID",
    color = "HV"
  )