Circular Dendrogram Difficulty

Question

I'm looking to create a circular diagram that resembles the attached photo. I like that there are symptom clusters as an inner circle and then connectors from the clusters to each individual symptom in an outer circle. However, I'm having trouble replicating it.

My code is below, as well as the dataset:

library(igraph)
library(ggraph)
library(dplyr)
library(readxl)

# Load the data
data <- read_excel("Final.xlsx")

# Create a unique list of symptoms and clusters for vertices
vertices <- data.frame(name = unique(c(data$Symptom, data$Cluster)))

# Create edges for the graph
edges <- data.frame(from = data$Cluster, to = data$Symptom)

# Create a graph object
graph <- graph_from_data_frame(d = edges, vertices = vertices, directed = FALSE)

# Add a cluster column to vertices
vertices <- vertices %>%
  mutate(cluster = ifelse(name %in% data$Cluster, name, "Symptom"))

# Ensure the graph object has the updated vertices data
V(graph)$cluster <- vertices$cluster[match(V(graph)$name, vertices$name)]

# Plot the network graph
ggraph(graph, layout = 'circle') + 
  geom_edge_link(aes(color = from), alpha = 0.8) +
  geom_node_point(aes(color = cluster), alpha = 0.6) +
  geom_node_text(aes(label = name), repel = TRUE, size = 3) +
  scale_color_manual(values = rainbow(length(unique(vertices$cluster)))) +
  theme_void() +
  labs(title = "Network Graph of Symptoms by Symptom Cluster")

Cluster	Symptom
Arthritis/Myalgias	New Muscle Aches (myalgia), Joint Aches, Body Aches, or Pain
Autonomic	Fast-beating or Pounding Heart (heart palpitations)
Autonomic	Dizziness
Cardiac	Fast-beating or Pounding Heart (heart palpitations)
Cardiac	Chest Pain
Cognitive	Brain Fog (worsened memory or concentration)
Cognitive	Confusion
Dermatologic	Hair Loss
Dermatologic	Rash
Fatigue	Fatigue or Tiredness
Fever/Chills	Fever or Feeling Feverish
Fever/Chills	Chills
Gastrointestinal	Diarrhea
Gastrointestinal	Nausea
Mood	Feeling Anxious or Worried
Mood	Feeling Depressed
Mood	Other Mood Changes
Multisystem Inflammatory Syndrome	Multisystem Inflammatory Syndrome, MIS
Neurologic	Headache
Neurologic	Change in Smell
Neurologic	Change in Taste
Neurologic	Loss or Change in Vision
Neurologic	Tinnitus (ringing in ears)
Respiratory	Cough
Respiratory	Sore Throat
Respiratory	Runny Nose and/or Nasal Congestion
Respiratory	Shortness of Breath (Dyspnea) or Difficulty Breathing
Sleep	Sleep Problems

This code resulted in the following image:

As you can see, there are not two distinct circles and I am having trouble getting that to work. Any help is appreciated!

Answer 1

Instead of using ggraph here is an approach which comes close to your desired result using some math and vanilla ggplot2 to draw your circular plot. The plot still requires some further tweaks to set the alignment and/or positions for the labels.

library(tidyverse)

dat <- data |>
  rename_with(tolower) |>
  add_count(cluster) |>
  arrange(cluster, symptom) |>
  mutate(
    across(c(cluster, symptom), list(alpha = ~ as.numeric(forcats::fct_inorder(.x)))),
    # + c(0, 1) extend the range to avoid that first and last point overlap
    symptom_alpha = scales::rescale(symptom_alpha, to = range(cluster_alpha) + c(0, 1)),
    across(
      c(cluster_alpha, symptom_alpha),
      # Rotate by pi / 4
      ~ scales::rescale(.x,
        to = c(0, 2 * pi) + pi / 4,
        from = range(.x) + c(0, 1)
      )
    ),
    cluster_x = cos(cluster_alpha) - sin(cluster_alpha),
    cluster_y = cos(cluster_alpha) + sin(cluster_alpha),
    symptom_x = cos(symptom_alpha) - sin(symptom_alpha),
    symptom_y = cos(symptom_alpha) + sin(symptom_alpha),
    across(c(symptom_x, symptom_y), ~ .x * 2),
    cluster_hjust = +(cluster_alpha > 5 / 4 * pi),
    symptom_hjust = +(symptom_alpha < 5 / 4 * pi),
  )

dat |>
  ggplot() +
  geom_segment(aes(
    x = symptom_x, xend = cluster_x,
    y = symptom_y, yend = cluster_y,
    color = cluster
  )) +
  geom_point(
    data = ~ distinct(.x, cluster, .keep_all = TRUE),
    aes(
      x = cluster_x, y = cluster_y,
      size = n, fill = cluster
    ),
    shape = 21
  ) +
  geom_point(
    aes(x = symptom_x, y = symptom_y),
    shape = 21, fill = "grey", size = 3
  ) +
  geom_text(
    data = ~ distinct(.x, symptom, .keep_all = TRUE),
    aes(
      x = 1.05 * symptom_x, y = 1.05 * symptom_y,
      label = label_wrap_gen(width = 15)(symptom),
      hjust = symptom_hjust
    ),
    size = 6 / .pt
  ) +
  geom_text(
    data = ~ distinct(.x, cluster, .keep_all = TRUE),
    aes(
      x = .8 * cluster_x, y = .8 * cluster_y,
      label = label_wrap_gen(width = 10)(cluster),
      hjust = cluster_hjust
    ),
    size = 6 / .pt
  ) +
  scale_size_area(max_size = 12) +
  theme_void() +
  guides(fill = "none", size = "none", color = "none") +
  coord_equal(clip = "off")

DATA

data <- data.frame(
  stringsAsFactors = FALSE,
  Cluster = c(
    "Arthritis/Myalgias",
    "Autonomic", "Autonomic", "Cardiac", "Cardiac", "Cognitive",
    "Cognitive", "Dermatologic", "Dermatologic", "Fatigue",
    "Fever/Chills", "Fever/Chills", "Gastrointestinal",
    "Gastrointestinal", "Mood", "Mood", "Mood",
    "Multisystem Inflammatory Syndrome", "Neurologic", "Neurologic", "Neurologic",
    "Neurologic", "Neurologic", "Respiratory", "Respiratory",
    "Respiratory", "Respiratory", "Sleep"
  ),
  Symptom = c(
    "New Muscle Aches (myalgia), Joint Aches, Body Aches, or Pain",
    "Fast-beating or Pounding Heart (heart palpitations)", "Dizziness",
    "Fast-beating or Pounding Heart (heart palpitations)", "Chest Pain",
    "Brain Fog (worsened memory or concentration)",
    "Confusion", "Hair Loss", "Rash", "Fatigue or Tiredness",
    "Fever or Feeling Feverish", "Chills", "Diarrhea", "Nausea",
    "Feeling Anxious or Worried", "Feeling Depressed",
    "Other Mood Changes", "Multisystem Inflammatory Syndrome, MIS",
    "Headache", "Change in Smell", "Change in Taste",
    "Loss or Change in Vision", "Tinnitus (ringing in ears)", "Cough",
    "Sore Throat", "Runny Nose and/or Nasal Congestion",
    "Shortness of Breath (Dyspnea) or Difficulty Breathing",
    "Sleep Problems"
  )
)