R code used to generate the publication-ready knowledge subsystem map

# ============================================================
# Publication-ready Knowledge Subsystem Map
# Non-optimal Veterinary AMU/AMS in Canada
# Revised for cleaner academic presentation
# ============================================================

# Packages
library(ggplot2)
library(grid)
library(stringr)

# ------------------------------------------------------------
# 1. Core large nodes
# ------------------------------------------------------------
large_nodes <- data.frame(
  id = c("AMU", "Awareness", "Motivation", "SelfReliance",
         "VetOversight", "Benchmark", "Diagnostics", "Protocols"),
  label = c(
    "Non-optimal\nveterinary\nAMU / AMS\n[2,4,5,6]",
    "AMR /\nstewardship\nawareness\n[2-7]",
    "Stewardship\nmotivation\n[2,3,6]",
    "Self-reliance /\nprior experience\n[4,6]",
    "Veterinary\nconsultation /\noversight\n[2,6]",
    "Benchmarking /\neducation\n[2,6,7]",
    "Diagnostics\naccess / use\n[2,6]",
    "Protocols &\ncommunication\nreview\n[2,6]"
  ),
  x = c(0.0, -4.8, 4.8, -7.0, 7.0, -4.6, 4.1, 8.7),
  y = c(0.0, 3.8, 3.8, -0.2, -0.2, -4.4, -4.4, -4.4),
  fill = c("#C93B32", "#B8D9B1", "#B8D9B1", "#F0D58A",
           "#A7C7DD", "#B8D9B1", "#A7C7DD", "#A7C7DD"),
  text_col = c("white", "black", "black", "black",
               "black", "black", "black", "black"),
  radius = c(1.12, 1.02, 1.02, 1.04, 1.04, 1.02, 1.02, 1.04),
  stringsAsFactors = FALSE
)

# ------------------------------------------------------------
# 2. Small reason nodes
# Repositioned slightly for cleaner spacing and visual balance
# ------------------------------------------------------------
small_nodes <- data.frame(
  id = c(
    "A1","A2","A3","A4",
    "M1","M2","M3","M4",
    "S1","S2","S3","S4",
    "V1","V2","V3","V4",
    "B1","B2","B3",
    "D1","D2","D3",
    "P1","P2"
  ),
  label = c(
    "Low own-context\nAMR salience\n[4,5,6,7]",
    "Stewardship term not\nwell understood\n[3,6,7]",
    "Human AMR seen as\nmore important\n[3,4,5,6]",
    "Media / public\nmessages uneven\n[3,7]",
    
    "Animal welfare\nimperative\n[2,6]",
    "Belief: already\nlow users\n[6]",
    "Public / industry\nexpectations\n[6]",
    "Need practical,\nusable options\n[2,6]",
    
    "Past treatment\nsuccess\n[4,6]",
    "Peers / family /\nother farmers\n[6,7]",
    "Common cases handled\nwithout vet input\n[6]",
    "Digital / social-media\ninformation\n[6,7]",
    
    "Vet consulted mainly for\nunusual / chronic cases\n[6]",
    "Conflicting advice across\nvets / clinics\n[6]",
    "Technical language /\ncommunication gaps\n[6,7]",
    "Client / farmer demand\nshapes decisions\n[2,6]",
    
    "Need practical,\ntailored examples\n[6,7]",
    "Benchmarking shows\n\"where we stand\"\n[2,6]",
    "Education seen as\nrepetitive\n[6]",
    
    "Poor lab access /\nslow turnaround\n[2,6]",
    "Diagnostics cost /\nimplementation burden\n[2,6]",
    "Limited treatment options\nreduce value\n[2]",
    
    "SOPs too broad /\nhard to apply\n[6]",
    "Need regular review with\nvet + client/farmer\n[2,6]"
  ),
  x = c(
    # Awareness
    -9.7, -8.9, -3.0, -1.5,
    # Motivation
    7.1, 10.1, 9.7, 2.1,
    # Self-reliance
    -10.0, -9.8, -7.3, -7.3,
    # Vet oversight
    10.2, 10.2, 5.6, 5.3,
    # Benchmark
    -7.7, -4.6, -1.5,
    # Diagnostics
    1.4, 4.2, 7.0,
    # Protocols
    11.0, 11.0
  ),
  y = c(
    # Awareness
    5.7, 3.6, 5.8, 3.2,
    # Motivation
    5.8, 4.0, 5.8, 2.8,
    # Self-reliance
    1.0, -1.8, 1.6, -2.3,
    # Vet oversight
    1.3, -1.9, 1.8, -2.2,
    # Benchmark
    -5.9, -6.2, -5.7,
    # Diagnostics
    -6.1, -6.3, -6.1,
    # Protocols
    -5.8, -3.3
  ),
  category = c(
    rep("Awareness", 4),
    rep("Motivation", 4),
    rep("SelfReliance", 4),
    rep("VetOversight", 4),
    rep("Benchmark", 3),
    rep("Diagnostics", 3),
    rep("Protocols", 2)
  ),
  sign = c(
    "-", "-", "+", "-",
    "-", "-", "+", "+",
    "+", "+", "+", "+",
    "-", "-", "-", "-",
    "+", "+", "-",
    "-", "-", "-",
    "-", "+"
  ),
  stringsAsFactors = FALSE
)

# ------------------------------------------------------------
# 3. Core relationships among large nodes
# NOTE:
# We use straight, shortened segments for reliability and clarity.
# This is usually preferable for publication figures.
# ------------------------------------------------------------
large_edges <- data.frame(
  from = c("Awareness","Motivation","SelfReliance","VetOversight",
           "Benchmark","Diagnostics","VetOversight","Protocols","Protocols"),
  to   = c("Motivation","AMU","AMU","AMU",
           "Awareness","AMU","Protocols","Diagnostics","AMU"),
  sign = c("+","-","+","-","+","-","+","+","-"),
  stringsAsFactors = FALSE
)

# ------------------------------------------------------------
# 4. Colour helpers
# ------------------------------------------------------------
edge_palette <- c("+" = "#5E5E5E", "-" = "#1B8A5A")

small_border_col <- function(cat) {
  if (cat %in% c("Awareness", "Motivation", "Benchmark")) return("#6F9770")
  if (cat %in% c("VetOversight", "Diagnostics", "Protocols")) return("#6E95AF")
  return("#BFA54C")
}

small_fill_col <- function(cat) {
  if (cat %in% c("Awareness", "Motivation", "Benchmark")) return("#F7FBF6")
  if (cat %in% c("VetOversight", "Diagnostics", "Protocols")) return("#F5FAFD")
  return("#FFFBEF")
}

small_nodes$border <- vapply(small_nodes$category, small_border_col, character(1))
small_nodes$fill   <- vapply(small_nodes$category, small_fill_col, character(1))

# ------------------------------------------------------------
# 5. Helpers
# ------------------------------------------------------------
get_node <- function(df, id_value) {
  df[df$id == id_value, , drop = FALSE]
}

# Create circle polygons for large nodes
circle_df <- function(x0, y0, r = 1, n = 240) {
  theta <- seq(0, 2*pi, length.out = n)
  data.frame(
    x = x0 + r * cos(theta),
    y = y0 + r * sin(theta)
  )
}

circle_polys <- do.call(rbind, lapply(seq_len(nrow(large_nodes)), function(i) {
  cc <- circle_df(large_nodes$x[i], large_nodes$y[i], large_nodes$radius[i])
  cc$id <- large_nodes$id[i]
  cc$fill <- large_nodes$fill[i]
  cc
}))

# Shorten a line so it starts/ends at node boundaries rather than centres
shorten_line <- function(x1, y1, x2, y2, offset_start = 0, offset_end = 0) {
  dx <- x2 - x1
  dy <- y2 - y1
  d  <- sqrt(dx^2 + dy^2)
  if (d == 0) {
    return(data.frame(x = x1, y = y1, xend = x2, yend = y2))
  }
  ux <- dx / d
  uy <- dy / d
  data.frame(
    x    = x1 + ux * offset_start,
    y    = y1 + uy * offset_start,
    xend = x2 - ux * offset_end,
    yend = y2 - uy * offset_end
  )
}

# Build large-to-large edges, shortened to circle boundaries
build_large_edges <- function(edges, nodes) {
  out <- list()
  for (i in seq_len(nrow(edges))) {
    from_node <- get_node(nodes, edges$from[i])
    to_node   <- get_node(nodes, edges$to[i])
    
    seg <- shorten_line(
      from_node$x, from_node$y,
      to_node$x, to_node$y,
      offset_start = from_node$radius,
      offset_end   = to_node$radius
    )
    seg$from <- edges$from[i]
    seg$to   <- edges$to[i]
    seg$sign <- edges$sign[i]
    out[[i]] <- seg
  }
  do.call(rbind, out)
}

# Build small-to-large connector lines
# Use a modest gap so labels appear visually connected without heavy overlap
build_small_edges <- function(small_nodes, large_nodes, label_gap = 0.65) {
  out <- list()
  for (i in seq_len(nrow(small_nodes))) {
    s <- small_nodes[i, ]
    t <- get_node(large_nodes, s$category)
    
    seg <- shorten_line(
      t$x, t$y,
      s$x, s$y,
      offset_start = t$radius,
      offset_end   = label_gap
    )
    seg$id   <- s$id
    seg$sign <- s$sign
    seg$cat  <- s$category
    out[[i]] <- seg
  }
  do.call(rbind, out)
}

large_edge_df <- build_large_edges(large_edges, large_nodes)
small_edge_df <- build_small_edges(small_nodes, large_nodes, label_gap = 0.62)

# Midpoints for large-edge sign markers
large_mid <- transform(
  large_edge_df,
  xm = (x + xend) / 2,
  ym = (y + yend) / 2
)

# Section titles
section_labels <- data.frame(
  x = c(-10.8, 10.8, -10.8, 10.8, -8.8, 10.8),
  y = c(6.45, 6.45, 2.15, 2.15, -7.0, -7.0),
  label = c(
    "Reasons shaping\nawareness",
    "Reasons shaping\nmotivation",
    "Reasons shaping\nself-reliance",
    "Reasons shaping\nveterinary consultation",
    "Reasons shaping\neducation / benchmarking",
    "Reasons shaping\ndiagnostics / protocols"
  ),
  colour = c("#456E46", "#456E46", "#8A6D1D", "#4A6E84", "#456E46", "#4A6E84"),
  hjust = c(0, 1, 0, 1, 0, 1),
  stringsAsFactors = FALSE
)

# ------------------------------------------------------------
# 6. Plot
# ------------------------------------------------------------
p <- ggplot() +
  coord_equal(
    xlim = c(-11.5, 12.3),
    ylim = c(-7.5, 7.1),
    expand = FALSE,
    clip = "off"
  ) +
  theme_void(base_family = "sans") +
  theme(
    plot.margin = margin(18, 24, 18, 24),
    plot.background = element_rect(fill = "white", colour = NA)
  ) +
  
  # Small connectors first (under everything)
  geom_segment(
    data = small_edge_df,
    aes(x = x, y = y, xend = xend, yend = yend, colour = sign),
    linewidth = 0.55,
    lineend = "round",
    show.legend = FALSE
  ) +
  
  # Large node polygons
  geom_polygon(
    data = circle_polys,
    aes(x = x, y = y, group = id),
    fill = circle_polys$fill,
    colour = "#2B2B2B",
    linewidth = 0.65,
    show.legend = FALSE
  ) +
  
  # Core subsystem edges on top of circles
  geom_segment(
    data = large_edge_df,
    aes(x = x, y = y, xend = xend, yend = yend, colour = sign),
    linewidth = 0.90,
    lineend = "round",
    arrow = arrow(length = unit(0.16, "inches"), type = "closed"),
    show.legend = FALSE
  ) +
  
  # Sign labels only for core subsystem edges
  geom_label(
    data = large_mid,
    aes(x = xm, y = ym, label = sign, colour = sign),
    fill = "white",
    label.size = 0.15,
    size = 3.2,
    fontface = "bold",
    label.padding = unit(0.18, "lines"),
    show.legend = FALSE
  ) +
  
  # Large node labels
  geom_text(
    data = large_nodes,
    aes(x = x, y = y, label = label),
    colour = large_nodes$text_col,
    size = 3.25,
    fontface = "bold",
    lineheight = 0.95,
    family = "sans",
    show.legend = FALSE
  ) +
  
  # Small reason nodes (larger boxes)
  geom_label(
    data = small_nodes,
    aes(x = x, y = y, label = label),
    fill = small_nodes$fill,
    colour = "black",
    label.size = 0.4,
    label.r = unit(0.12, "lines"),
    label.padding = unit(0.55, "lines"),   # bigger internal padding
    size = 3.35,                           # slightly larger text
    lineheight = 0.98,                     # a bit more vertical spacing
    family = "sans",
    show.legend = FALSE
  ) +
  
  # Section labels
  geom_text(
    data = section_labels,
    aes(x = x, y = y, label = label, hjust = hjust),
    colour = section_labels$colour,
    size = 3.2,
    fontface = "bold",
    lineheight = 0.95,
    family = "sans",
    show.legend = FALSE
  ) +
  
  scale_colour_manual(values = edge_palette)

# Display plot
p

# ------------------------------------------------------------
# 7. Save outputs
# ------------------------------------------------------------

# High-resolution TIFF (common journal format)
ggsave(
  filename = "knowledge_subsystem_map_veterinary_ams_canada.tiff",
  plot = p,
  width = 10.5,
  height = 6.8,
  units = "in",
  dpi = 600,
  compression = "lzw",
  bg = "white"
)

# Vector PDF (best for editing and publication workflows)
ggsave(
  filename = "knowledge_subsystem_map_veterinary_ams_canada.pdf",
  plot = p,
  width = 10.5,
  height = 6.8,
  units = "in",
  device = cairo_pdf,
  bg = "white"
)

# PNG for slides / drafts
ggsave(
  filename = "knowledge_subsystem_map_veterinary_ams_canada.png",
  plot = p,
  width = 10.5,
  height = 6.8,
  units = "in",
  dpi = 600,
  bg = "white"
)

Generated figure

``