Etapa II OSCC — Modelul economiei sănătăţii

# library(ggplot2)
# library(grid)

BG <- "#F0F3F7"

# ── 1. Nodes ─────────────────────────────────────────────────────────────────
# Layout: left=initial treatment, center=adjuvant/NED, right=outcomes/death
nodes <- data.frame(
  id    = 1:8,
  label = c(
    "S1nSurgeryn± Neck Dissection",
    "S2nDefinitivenRadiation",
    "S3nPost-opnSurveillance",
    "S4nAdjuvant RTn(PORT)",
    "S5nAdjuvantnChemoRT (POCRT)",
    "S6nNEDn(Health)",
    "S7nLocoregionalnRecurrence",
    "S8nDeath"
  ),
  x    = c(1.5,  1.5,  4.5,  4.5,  4.5,  7.0,  9.5,  11.5),
  y    = c(8.5,  3.0,  9.5,  6.5,  3.5,  6.5,  7.5,   5.5),
  fill = c("#E67E22","#8E44AD","#F39C12","#2980B9","#16A085",
           "#27AE60","#C0392B","#2C3E50"),
  stringsAsFactors = FALSE
)

# ── 2. Edge definitions: from, to, label, curvature, nudge_x, nudge_y ────────
edge_defs <- list(
  # Surgery → downstream
  c(1, 3,  "No high-risknfeatures",    0.00,  0.10,  0.30),
  c(1, 4,  "High-risk:nmargins/PNI/nLVI/nodes",  0.10, -0.20,  0.20),
  c(1, 5,  "ECE/posnmargins",          0.18,  0.00, -0.30),
  c(1, 8,  "Peri-opndeath",           -0.22,  0.10, -0.20),
  # Definitive RT → downstream
  c(2, 6,  "NED",                       0.18,  0.00,  0.25),
  c(2, 7,  "Treatmentnfailure",        0.00,  0.00,  0.25),
  c(2, 8,  "Death",                     0.14, -0.10, -0.20),
  # Post-op Surveillance → downstream
  c(3, 6,  "",                          0.00,  0.10,  0.25),
  c(3, 7,  "",                          0.22,  0.20, -0.10),
  c(3, 8,  "",                         -0.18,  0.10, -0.18),
  # PORT → downstream
  c(4, 6,  "",                          0.00,  0.10,  0.25),
  c(4, 7,  "",                          0.12,  0.10,  0.18),
  c(4, 8,  "",                          0.14,  0.10, -0.18),
  # POCRT → downstream
  c(5, 6,  "",                          0.00,  0.10,  0.25),
  c(5, 7,  "",                          0.00,  0.10,  0.22),
  c(5, 8,  "",                          0.12,  0.10, -0.18),
  # NED → outcomes
  c(6, 7,  "LR recurrence",             0.00, -0.10,  0.25),
  c(6, 8,  "Death",                     0.18,  0.10, -0.14),
  # Locoregional Recurrence → outcomes
  c(7, 8,  "Death",                     0.00,  0.00,  0.25),
  c(7, 6,  "Salvagensuccess",         -0.28, -0.28,  0.00)
)

edges <- do.call(rbind, lapply(edge_defs, function(r) {
  data.frame(from=as.integer(r((1))), to=as.integer(r((2))),
             prob=r((3)), curvature=as.numeric(r((4))),
             nudge_x=as.numeric(r((5))), nudge_y=as.numeric(r((6))),
             stringsAsFactors=FALSE)
}))

# Attach node coordinates
edges <- merge(edges, nodes(, c("id","x","y")), by.x="from", by.y="id", sort=FALSE)
names(edges)(names(edges)=="x") <- "x0"; names(edges)(names(edges)=="y") <- "y0"
edges <- merge(edges, nodes(, c("id","x","y","fill")), by.x="to", by.y="id", sort=FALSE)
names(edges)(names(edges)=="x") <- "x1"; names(edges)(names(edges)=="y") <- "y1"
names(edges)(names(edges)=="fill") <- "dest_col"

# Shorten endpoints to node perimeter
NODE_R <- 0.58
shorten <- function(x0,y0,x1,y1,r) {
  dx<-x1-x0; dy<-y1-y0; d<-sqrt(dx^2+dy^2)
  list(xs=x0+dx*r/d, ys=y0+dy*r/d, xe=x1-dx*r/d, ye=y1-dy*r/d)
}
segs     <- Map(shorten, edges$x0, edges$y0, edges$x1, edges$y1, MoreArgs=list(r=NODE_R))
edges$xs <- sapply(segs,`((`,"xs"); edges$ys <- sapply(segs,`((`,"ys")
edges$xe <- sapply(segs,`((`,"xe"); edges$ye <- sapply(segs,`((`,"ye")
edges$lx <- (edges$xs+edges$xe)/2 + edges$nudge_x
edges$ly <- (edges$ys+edges$ye)/2 + edges$nudge_y

# ── 3. Build layers ───────────────────────────────────────────────────────────
arrow_layers <- lapply(seq_len(nrow(edges)), function(i) {
  e <- edges(i,,drop=FALSE)
  geom_curve(data=e, mapping=aes(x=xs,y=ys,xend=xe,yend=ye),
             curvature=e$curvature((1)), colour=e$dest_col((1)),
             linewidth=1.0, alpha=0.80,
             arrow=arrow(length=unit(9,"pt"), type="closed", ends="last"),
             show.legend=FALSE)
})

label_layers <- lapply(seq_len(nrow(edges)), function(i) {
  e <- edges(i,,drop=FALSE)
  if (nchar(trimws(e$prob((1)))) == 0) return(NULL)
  geom_label(data=e, mapping=aes(x=lx,y=ly,label=prob),
             colour=e$dest_col((1)), fill=BG, size=2.6, fontface="bold",
             label.size=0.22, label.r=unit(0.10,"lines"),
             label.padding=unit(0.15,"lines"), show.legend=FALSE)
})
label_layers <- Filter(Negate(is.null), label_layers)

# ── 4. Base plot ──────────────────────────────────────────────────────────────
base_plot <- ggplot() +
  theme_void(base_size=10) +
  theme(
    plot.background  = element_rect(fill=BG, colour=NA),
    panel.background = element_rect(fill=BG, colour=NA),
    plot.title  = element_text(family="serif", face="bold", size=16,
                               colour="#1A2535", hjust=0.5, margin=margin(b=4)),
    plot.subtitle = element_text(size=9, colour="#555555", hjust=0.5,
                                 margin=margin(b=10))
  ) +
  coord_fixed(xlim=c(0, 13), ylim=c(1.5, 11), clip="off") +
  labs(title="Stage II Oral Squamous Cell Carcinoma",
       subtitle="CTMC State Transition Diagram")

# ── 5. Assemble ───────────────────────────────────────────────────────────────
all_layers <- c(arrow_layers, label_layers,
  list(
    # Column labels
    annotate("text", x=1.5,  y=10.8, label="InitialnTreatment",
             size=3.2, colour="#555", fontface="italic", hjust=0.5),
    annotate("text", x=4.5,  y=10.8, label="Post-surgicalnPathway",
             size=3.2, colour="#555", fontface="italic", hjust=0.5),
    annotate("text", x=7.0,  y=10.8, label="No Evidencenof Disease",
             size=3.2, colour="#555", fontface="italic", hjust=0.5),
    annotate("text", x=9.5,  y=10.8, label="DiseasenProgression",
             size=3.2, colour="#555", fontface="italic", hjust=0.5),
    annotate("text", x=11.5, y=10.8, label="AbsorbingnState",
             size=3.2, colour="#555", fontface="italic", hjust=0.5),
    # Nodes
    geom_point(data=nodes, aes(x=x, y=y, colour=fill),
               size=28, show.legend=FALSE),
    scale_colour_identity(),
    geom_text(data=nodes, aes(x=x, y=y, label=label),
              colour="white", size=2.8, fontface="bold", lineheight=0.9),
    # Surgical candidate bracket
    annotate("segment", x=0.25, xend=0.25, y=2.2, yend=9.3,
             colour="#888", linewidth=0.5),
    annotate("segment", x=0.25, xend=0.45, y=9.3, yend=9.3,
             colour="#888", linewidth=0.5),
    annotate("segment", x=0.25, xend=0.45, y=2.2, yend=2.2,
             colour="#888", linewidth=0.5),
    annotate("text", x=0.0, y=5.75, label="Surgicalncandidate?nYes ↑nNo ↓",
             size=2.8, colour="#666", hjust=0.5, lineheight=0.9)
  )
)

Reduce("+", all_layers, init=base_plot)