Pneumokokk NGS-dashboard

R pakkar og data

library(dplyr)
library(ggplot2)
library(wesanderson)
library(scales)
library(tidyr)
library(lubridate)
library(ggbump)
library(networkD3)

wes6_1 <- c("#d3d3d3", "#F4B5BD", "#C6CDF7", "#972D15", "#81A88D", "#FDD262")
wes11  <- c("#FDD262", "#F4B5BD", "#CDC08C", "#D8B70A", "#02401B", "#81A88D",
            "#972D15", "#85D4E3", "#C6CDF7", "#7294D4", "#D3DDDC")
wes15  <- c("#FDD262", "#F4B5BD", "#CDC08C", "#D8B70A", "#02401B", "#A2A475",
            "#81A88D", "#972D15", "#E6A0C4", "#C6CDF7", "#D8A499", "#7294D4",
            "#446455", "#C7B19C", "#D3DDDC")
wes19  <- c("#191970", "#F4B5BD", "#9C964A", "#CDC08C", "#FAD77B", "#D8B70A",
            "#02401B", "#A2A475", "#81A88D", "#972D15", "#E6A0C4", "#C6CDF7",
            "#D8A499", "#7294D4", "#446455", "#85D4E3", "#C7B19C", "#ffa700",
            "#555555", "#1e90ff", "#c08081", "#62ba7e")

PN <- read.csv(
  "/media/vegard/Work_volume_10TB1/2025_PK-dashboard_v2/poppunk/microreact/microreact_all_merged_metadata.csv",
  header = TRUE, sep = ","
)

# Fjern "__autocolour" fra kolonnenavn
colnames(PN) <- gsub("__autocolour", "", colnames(PN))

# Serotype: foretrekk Quellung, fall tilbake til WGS
PN$Serotype <- ifelse(PN$Quellung_serotype != "", PN$Quellung_serotype, PN$WGS_serotype)

# Collapse near-duplicate MIC values

top10_GPSC     <- names(sort(table(PN$GPSC),                                        decreasing = TRUE))[1:10]
top20_GPSC     <- names(sort(table(PN$GPSC),                                        decreasing = TRUE))[1:20]
top10_ST       <- names(sort(table(PN$ST[!is.na(PN$ST)       & PN$ST != ""]),       decreasing = TRUE))[1:10]
top20_Serotype <- names(sort(table(PN$Serotype[!is.na(PN$Serotype) & PN$Serotype != ""]), decreasing = TRUE))[1:20]
top10_Serotype <- names(sort(table(PN$Serotype[!is.na(PN$Serotype) & PN$Serotype != ""]), decreasing = TRUE))[1:10]

PN <- PN %>%
  mutate(
    GPSC_dominant = if_else(GPSC %in% top10_GPSC,                 GPSC,                  "other"),
    ST_dominant   = if_else(as.character(ST) %in% top10_ST,       as.character(ST),      "other"),
    Sero_dominant = if_else(as.character(Serotype) %in% top10_Serotype, as.character(Serotype), "other")
  )

PN <- PN %>%
  mutate(
    BEN_MIC = case_when(
      BEN_MIC == 0.015 ~ 0.016,
      BEN_MIC == 0.030 ~ 0.03,
      BEN_MIC == 0.032 ~ 0.03,
      BEN_MIC == 0.060 ~ 0.06,
      BEN_MIC == 0.064 ~ 0.06,
      BEN_MIC == 0.125 ~ 0.12,
      TRUE ~ BEN_MIC
    ),
    MIC_cat = case_when(
      BEN_MIC <= 0.06 ~ "S",
      BEN_MIC <= 1    ~ "PNS",
      TRUE             ~ "PRP"
    ),
    MIC_cat  = factor(MIC_cat, levels = c("S", "PNS", "PRP")),
    GPSC_sk  = if_else(GPSC %in% top20_GPSC, paste0("GPSC ", GPSC), "GPSC andre"),
    Sero_sk  = if_else(Serotype %in% top20_Serotype, Serotype, "Serotype andre")
  )

PCV13 <- c('4','6B','9V','14','18C','19F','23F','1','3','5','6A','7F','19A')
PCV15 <- c('4','6B','9V','14','18C','19F','23F','1','3','5','6A','7F','19A','22F','33F')
PCV20 <- c('1','3','4','5','6A','6B','7F','8','9V','10A','11A','12F','14','15B',
           '18C','19A','19F','22F','23F','33F')
PCV21 <- c('3','6A','7F','8','9N','10A','11A','12F','15A','15C','16F','17F','19A',
           '20A','22F','23A','23B','24F','31','33F','35B')
PPV23 <- c('1','2','3','4','5','6B','7F','8','9N','9V','10A','11A','12F','14','15B',
           '17F','18C','19F','19A','20','22F','23F','33F')

PN$PCV13 <- ifelse(PN$Serotype %in% PCV13, "YES", "NO")
PN$PCV15 <- ifelse(PN$Serotype %in% PCV15, "YES", "NO")
PN$PCV20 <- ifelse(PN$Serotype %in% PCV20, "YES", "NO")
PN$PCV21 <- ifelse(PN$Serotype %in% PCV21, "YES", "NO")
PN$PPV23 <- ifelse(PN$Serotype %in% PPV23, "YES", "NO")

age_order <- c("0-6", "7-15", "16-44", "45-66", "67-79", "80+")
PN$age_group <- factor(PN$age_group, levels = age_order)

PN <- PN %>%
  mutate(
    date = as.Date(date),
    year = factor(year(date), levels = sort(unique(year(date))))
  ) %>%
  filter(!is.na(year))

Vaksinedekning

Numerisk oversikt over talet på sekvenserte IPD tilfeller med serotypar dekka av utvalde tilgjengelege vaksinar.

pcv_counts <- PN %>%
  group_by(year, PCV13, PCV15, PCV20, PCV21, PPV23) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(year) %>%
  summarise(
    PCV13       = sum(count[PCV13 == "YES"]),
    PCV15       = sum(count[PCV15 == "YES"]),
    PCV20       = sum(count[PCV20 == "YES"]),
    PCV21       = sum(count[PCV21 == "YES"]),
    PPV23       = sum(count[PPV23 == "YES"]),
    Cases_total = sum(count)
  ) %>%
  pivot_longer(
    cols      = c(PCV13, PCV15, PCV20, PCV21, PPV23, Cases_total),
    names_to  = "CoveredBy",
    values_to = "Count"
  )

ggplot(pcv_counts, aes(x = year, y = Count, fill = CoveredBy, group = CoveredBy)) +
  geom_bar(stat = "identity", position = position_dodge()) +
  geom_text(aes(label = Count), vjust = 1.6, color = "white",
            position = position_dodge(0.9), size = 4) +
  labs(
    title = "Fig1 - Teoretisk vaksinedekning utvalgte vaksiner",
    x     = "",
    y     = "Antall",
    fill  = "Vaksine"
  ) +
  theme_minimal() +
  scale_fill_manual(values = wes6_1)

GPSC

Oversikt over dei ti vanlegaste GPSC gruppene i perioden fordelt på år.

gpsc_by_year <- PN %>%
  filter(!is.na(year)) %>%
  count(year, GPSC_dominant) %>%
  group_by(year) %>%
  mutate(fraction = n / sum(n))

ggplot(gpsc_by_year, aes(x = factor(year), y = fraction, fill = GPSC_dominant)) +
  geom_bar(stat = "identity", position = "stack") +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  scale_fill_manual(values = wes11) +
  labs(
    title = "Fig2 - Største GPSC grupper (n > 50 totalt) per år",
    x     = "",
    y     = "Fraksjon",
    fill  = "GPSC"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    axis.text.x        = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank()
  )

Topp ti GPSC grupper - rangering over tid (bump-plot)

GPSC_ranks <- PN %>%
  filter(GPSC %in% top10_GPSC) %>%
  mutate(year = as.factor(year)) %>%
  group_by(GPSC, year) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(year) %>%
  mutate(rank = rank(-count, ties.method = "min")) %>%
  ungroup()

ggplot(GPSC_ranks, aes(x = year, y = rank, color = GPSC, group = GPSC)) +
  geom_bump(linewidth = 1.5, smooth = 8) +
  geom_point(size = 3) +
  scale_y_reverse(breaks = 1:10) +
  scale_color_manual(values = wes11) +
  labs(
    title = "Fig3 - GPSC utvikling (topp 10)",
    x     = "",
    y     = "Rank",
    color = "GPSC"
  ) +
  theme_minimal() +
  theme(
    legend.position  = "right",
    axis.text.x      = element_text(angle = 45, hjust = 1)
  )

Serotypar

Oversikt over dei ti vanlegaste serotypane i perioden fordelt på år.

Sero_by_year <- PN %>%
  filter(!is.na(year)) %>%
  group_by(year, Sero_dominant) %>%
  summarise(n = n(), .groups = "drop_last") %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

ggplot(Sero_by_year, aes(x = factor(year), y = fraction, fill = Sero_dominant)) +
  geom_bar(stat = "identity", position = "stack") +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  scale_fill_manual(values = wes11) +
  labs(
    title = "Fig4 - Serotypar per år",
    x     = "År",
    y     = "Fraksjon",
    fill  = "Vanlegaste serotyper (topp 10)"
  ) +
  theme_minimal(base_size = 14) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Topp ti serotypar - rangering over tid (bump-plot)

Sero_ranks <- PN %>%
  filter(Serotype %in% top10_Serotype) %>%
  mutate(year = as.factor(year)) %>%
  group_by(Serotype, year) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(year) %>%
  mutate(rank = rank(-count, ties.method = "min")) %>%
  ungroup()

ggplot(Sero_ranks, aes(x = year, y = rank, color = Serotype, group = Serotype)) +
  geom_bump(linewidth = 1.5, smooth = 8) +
  geom_point(size = 3) +
  scale_y_reverse(breaks = 1:10) +
  scale_color_manual(values = wes11) +
  labs(
    title = "Fig5 - Serotype utvikling (topp 10)",
    x     = "",
    y     = "Rank",
    color = "Serotype"
  ) +
  theme_minimal() +
  theme(
    legend.position = "right",
    axis.text.x     = element_text(angle = 45, hjust = 1)
  )

Aldersfordeling per serotype (topp 20)

sero_age <- PN %>%
  filter(Serotype %in% top20_Serotype, !is.na(age_group)) %>%
  count(Serotype, age_group) %>%
  group_by(Serotype) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup() %>%
  mutate(Serotype = factor(Serotype, levels = top20_Serotype))

ggplot(sero_age, aes(x = age_group, y = fraction, fill = age_group)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ Serotype, ncol = 4) +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  scale_fill_manual(values = wes6_1) +
  labs(
    title = "Fig6 - Aldersfordeling og serotypar",
    x = "Aldersgruppe",
    y = "Fraksjon"
  ) +
  theme_bw(base_size = 14) +
  theme(
    axis.text.x  = element_text(angle = 45, hjust = 1),
    strip.text   = element_text(face = "bold"),
    panel.grid.major.x = element_blank()
  )

Serotypar per aldersgruppe, per år

age_sero <- PN %>%
  filter(!is.na(age_group), !is.na(Serotype), Serotype != "", !is.na(year)) %>%
  mutate(
    Sero20 = if_else(Serotype %in% top20_Serotype, Serotype, "Andre")
  ) %>%
  count(year, age_group, Sero20) %>%
  mutate(
    Sero20 = factor(Sero20, levels = c(top20_Serotype, "Andre"))
  )

sero20_colors <- setNames(
  c(wes19[seq_along(top20_Serotype)], "#d3d3d3"),
  c(top20_Serotype, "Andre")
)

pA <- ggplot(age_sero, aes(x = age_group, y = n, fill = Sero20)) +
  geom_col(position = "stack") +
  scale_fill_manual(values = sero20_colors, name = "Serotype") +
  scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
  facet_wrap(~ year, ncol = 1) +
  labs(
    title = "Fig7A) Absolutte tal",
    x     = "Aldersgruppe",
    y     = "Antal tilfelle"
  ) +
  theme_bw(base_size = 14) +
  theme(
    axis.text.x        = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank(),
    legend.position    = "none"
  )

age_sero_frac <- age_sero %>%
  group_by(year, age_group) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

pB <- ggplot(age_sero_frac, aes(x = age_group, y = fraction, fill = Sero20)) +
  geom_col(position = "stack") +
  scale_fill_manual(values = sero20_colors, name = "Serotype") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.02))) +
  facet_wrap(~ year, ncol = 1) +
  labs(
    title = "Fig7B) Relativ fraksjon",
    x     = "Aldersgruppe",
    y     = "Fraksjon"
  ) +
  theme_bw(base_size = 14) +
  theme(
    axis.text.x        = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank(),
    legend.position    = "right",
    legend.key.size    = unit(0.4, "cm"),
    legend.text        = element_text(size = 8)
  )

library(patchwork)
pA + pB + plot_layout(widths = c(1, 1))

Penicillin resistens

total_per_year <- PN %>%
  group_by(year) %>%
  summarise(total = n())

mic_per_year <- PN %>%
  filter(!is.na(year)) %>%  # Exclude NA years here
  group_by(year, BEN_MIC, ST, GPSC, Serotype) %>%
  summarise(count = n(), .groups = "drop")

mic_proportions <- mic_per_year %>%
  left_join(total_per_year, by = "year") %>%
  mutate(proportion = count / total,
         ST = as.factor(ST))

high_mic_proportions <- subset(mic_proportions, BEN_MIC >= 2)

Andel ikkje-følsome (MIC > 0.064 mg/l) “Penicillin non-susceptible” [PNS] isolat fordelt på MIC per år

Antal (n) observasjonar printa over kva søyle.

mic_labels <- mic_proportions %>%
  group_by(year, BEN_MIC) %>%
  summarise(
    n_total    = sum(count),
    proportion = sum(count) / first(total),
    .groups    = "drop"
  )

ggplot(mic_proportions, aes(x = factor(BEN_MIC), y = proportion, fill = year)) +
  geom_col() +
  geom_text(data = mic_labels,
            aes(x = factor(BEN_MIC), y = proportion, label = n_total),
            vjust = -0.3, size = 3, color = "black", inherit.aes = FALSE) +
  scale_x_discrete(limits = c("0.12", "0.25", "0.5", "1", "2", "4", "8")) +
  scale_fill_manual(values = wes15) +
  facet_wrap(~year, nrow = 3) +
  labs(
    title = "Fig8 - Andel av PNS pneumokokkisolat fordelt på MIC",
    x     = "Penicillin MIC",
    y     = "Andel av isolat",
    fill  = "År"
  ) +
  theme_bw() +
  ylim(0,0.1) +
  theme(legend.position = "right")

Sekvenstype-fordeling blant penicillin-resistente pneumokokkar (MIC ≥ 2, “PRP”)

ggplot(high_mic_proportions, aes(x = factor(year), y = proportion, fill = ST)) +
  geom_col() +
  scale_fill_manual(values = wes19) +
  labs(
    title = "Fig9 - Penicillinresistente pneumokokker: sekvenstyper",
    x     = "År",
    y     = "Andel av isolat",
    fill  = "ST"
  ) +
  theme_bw() +
  theme(legend.position = "right")

GPSC-fordeling blant PRP-isolat (MIC ≥ 2)

ggplot(high_mic_proportions, aes(x = factor(year), y = proportion, fill = GPSC)) +
  geom_col() +
  scale_fill_manual(values = wes19) +
  labs(
    title = "Fig10 - GPSC-fordeling blant PRP-tilfeller",
    x     = "År",
    y     = "Andel av isolat",
    fill  = "GPSC"
  ) +
  theme_bw() +
  theme(legend.position = "right")

Serotype-fordeling blant PRP-isolat (MIC ≥ 2)

ggplot(high_mic_proportions, aes(x = factor(year), y = proportion, fill = Serotype)) +
  geom_col() +
  scale_fill_manual(values = wes19) +
  labs(
    title = "Fig11 - Serotype-fordeling blant PRP-tilfeller",
    x     = "År",
    y     = "Andel av isolat",
    fill  = "Serotype"
  ) +
  theme_bw() +
  theme(legend.position = "right")

PNS og PRP isolatar: GPSC, Serotype, MIC kombinasjonar

library(networkD3)
library(htmlwidgets)
library(htmltools)

# Ordered MIC levels low → high
mic_order <- c("MIC 0.008", "MIC 0.016", "MIC 0.03", "MIC 0.06",
               "MIC 0.12", "MIC 0.25", "MIC 0.5", "MIC 1",
               "MIC 2", "MIC 4", "MIC 8")

# MIC colour ramp: light pink → dark red
mic_pns_levels <- c("MIC 0.12", "MIC 0.25", "MIC 0.5", "MIC 1")
mic_prp_levels <- c("MIC 2", "MIC 4", "MIC 8")

mic_pal <- setNames(
  c(
    colorRampPalette(c("#FADADD", "#972D15"))(length(mic_pns_levels)),
    colorRampPalette(c("#FADADD", "#972D15"))(length(mic_prp_levels))
  ),
  c(mic_pns_levels, mic_prp_levels)
)

# GPSC colours: one per top20, grey for andre
gpsc_pal <- setNames(c(wes19[seq_along(top20_GPSC)], "#d3d3d3"),
                     c(paste0("GPSC ", top20_GPSC), "GPSC andre"))

# Serotype colours: wes19 for top20, grey for andre
sero_pal <- setNames(c(wes19[seq_along(top20_Serotype)], "#d3d3d3"),
                     c(top20_Serotype, "Serotype andre"))

make_sankey <- function(df, title_label) {
  n_total <- nrow(df)

  flows <- df %>%
    mutate(
      MIC_node = factor(paste0("MIC ", BEN_MIC), levels = mic_order)
    ) %>%
    filter(!is.na(MIC_node)) %>%
    count(GPSC_sk, Sero_sk, MIC_node)

  # Node order: GPSC by descending count, Sero by descending count, MIC low→high
  gpsc_order <- flows %>% group_by(GPSC_sk) %>%
    summarise(n = sum(n), .groups = "drop") %>%
    arrange(desc(n)) %>% pull(GPSC_sk)
  sero_order <- flows %>% group_by(Sero_sk) %>%
    summarise(n = sum(n), .groups = "drop") %>%
    arrange(desc(n)) %>% pull(Sero_sk)
  mic_present <- mic_order[mic_order %in% unique(as.character(flows$MIC_node))]

  node_names <- c(gpsc_order, sero_order, mic_present)
  nodes <- data.frame(name = node_names, stringsAsFactors = FALSE)
  idx   <- function(x) match(x, node_names) - 1L

  links <- bind_rows(
    flows %>% transmute(source = idx(GPSC_sk),
                        target = idx(Sero_sk),
                        value  = n),
    flows %>% transmute(source = idx(Sero_sk),
                        target = idx(as.character(MIC_node)),
                        value  = n)
  ) %>% filter(!is.na(source), !is.na(target))

  # Look up colour for each node by name
  node_cols <- sapply(node_names, function(nm) {
  if (nm %in% names(gpsc_pal)) return(unname(gpsc_pal[nm]))
  if (nm %in% names(sero_pal)) return(unname(sero_pal[nm]))
  if (nm %in% names(mic_pal))  return(unname(mic_pal[nm]))
  return("#A8A8A8")
}, USE.NAMES = FALSE)

  col_js <- paste0(
    'd3.scaleOrdinal().domain([',
    paste0('"', node_names, '"', collapse = ","),
    ']).range([',
    paste0('"', node_cols, '"', collapse = ","),
    '])'
  )

widget <- sankeyNetwork(
    Links       = as.data.frame(links),
    Nodes       = nodes,
    Source      = "source",
    Target      = "target",
    Value       = "value",
    NodeID      = "name",
    fontSize    = 13,
    nodeWidth   = 22,
    nodePadding = 8,
    sinksRight  = TRUE
  )

  # Build a JS object mapping node name → colour
  col_map_js <- paste0(
    '{',
    paste0('"', node_names, '":"', node_cols, '"', collapse = ","),
    '}'
  )

  # Inject JS that directly sets rect fill after D3 renders
  widget <- htmlwidgets::onRender(widget, paste0('
    function(el, x) {
      var colMap = ', col_map_js, ';
      d3.select(el).selectAll(".node rect")
        .style("fill", function(d) { return colMap[d.name] || "#A8A8A8"; })
        .style("stroke", function(d) { return colMap[d.name] || "#A8A8A8"; });
    }
  '))

  htmlwidgets::prependContent(
    widget,
    htmltools::tags$div(
      style = "font-family: sans-serif; font-size: 14px; font-weight: bold; margin-bottom: 4px;",
      paste0(title_label, "  (n = ", n_total, ")")
    )
  )
}

Fig12 PNS-isolat (MIC 0.12 – 1)

pns_df <- PN %>%
  filter(MIC_cat == "PNS", !is.na(BEN_MIC), !is.na(GPSC), !is.na(Serotype), Serotype != "")

make_sankey(pns_df, "PNS-isolat (MIC 0.12 – 1)")

PNS-isolat (MIC 0.12 – 1) (n = 106)

Fig13 PRP-isolat (MIC > 1)

prp_df <- PN %>%
  filter(MIC_cat == "PRP", !is.na(BEN_MIC), !is.na(GPSC), !is.na(Serotype), Serotype != "")

make_sankey(prp_df, "PRP-isolat (MIC > 1)")

PRP-isolat (MIC > 1) (n = 61)

Atypiske infeksjonar og resistens

# Recode sample_type into three categories
PN <- PN %>%
  mutate(
    sample_cat = case_when(
      sample_type == "B"  ~ "Blodkultur",
      sample_type == "SP" ~ "Spinalvæske",
      TRUE                             ~ "Andre"
    ),
    sample_cat = factor(sample_cat, levels = c("Blodkultur", "Spinalvæske", "Andre")),
    MIC_cat = case_when(
    BEN_MIC <= 0.06 ~ "S",
    BEN_MIC <= 1    ~ "PNS",
    TRUE             ~ "PRP"
    ),
    MIC_cat = factor(MIC_cat, levels = c("S", "PNS", "PRP"))
  )

Fig14 Antal tilfelle per år stratifisert etter prøvemateriale

sample_year <- PN %>%
  filter(!is.na(year)) %>%
  count(year, sample_cat)

ggplot(sample_year, aes(x = year, y = n, fill = sample_cat)) +
  geom_col(position = "stack") +
  geom_text(aes(label = n), position = position_stack(vjust = 0.5),
            size = 3.5, color = "white", fontface = "bold") +
  scale_fill_manual(
    values = c("Blodkultur" = "#972D15", "Spinalvæske" = "#D8B70A", "Andre" = "#d3d3d3"),
    name   = "Prøvemateriale"
  ) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +
  labs(x = "År", y = "Antal tilfelle") +
  theme_bw(base_size = 13) +
  theme(
    axis.text.x        = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank()
  )

Fig 15 Prøvemateriale og bakterielle eigenskapar

# --- shared helper: n labels on top of each bar ---
n_label <- function(df, x_var, fill_var, cat_var) {
  df %>%
    group_by({{ cat_var }}, {{ x_var }}) %>%
    summarise(n_total = sum(n), .groups = "drop") %>%
    group_by({{ cat_var }}) %>%
    mutate(y_pos = 1.02)
}

# Panel 1: GPSC (top10 + andre)
gpsc_stype <- PN %>%
  filter(!is.na(sample_cat)) %>%
  mutate(GPSC_label = if_else(GPSC %in% top20_GPSC, GPSC, "Andre")) %>%
  mutate(GPSC_label = factor(GPSC_label, levels = c(top20_GPSC, "Andre"))) %>%
  count(sample_cat, GPSC_label) %>%
  group_by(sample_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

gpsc_n <- gpsc_stype %>%
  group_by(sample_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

gpsc_colors <- setNames(c(wes19[seq_along(top20_GPSC)], "#d3d3d3"), c(top20_GPSC, "Andre"))

p1 <- ggplot(gpsc_stype, aes(x = sample_cat, y = fraction, fill = GPSC_label)) +
  geom_col(position = "stack") +
  geom_text(data = gpsc_n, aes(x = sample_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(values = gpsc_colors, name = "GPSC") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "GPSC", x = "Prøvemateriale", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

# Panel 2: Serotype (top20 + andre)
sero_stype <- PN %>%
  filter(!is.na(sample_cat), !is.na(Serotype), Serotype != "") %>%
  mutate(Sero_label = if_else(Serotype %in% top20_Serotype, Serotype, "Andre")) %>%
  mutate(Sero_label = factor(Sero_label, levels = c(top20_Serotype, "Andre"))) %>%
  count(sample_cat, Sero_label) %>%
  group_by(sample_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

sero_n <- sero_stype %>%
  group_by(sample_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

sero_colors <- setNames(c(wes19[seq_along(top20_Serotype)], "#d3d3d3"), c(top20_Serotype, "Andre"))

p2 <- ggplot(sero_stype, aes(x = sample_cat, y = fraction, fill = Sero_label)) +
  geom_col(position = "stack") +
  geom_text(data = sero_n, aes(x = sample_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(values = sero_colors, name = "Serotype") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "Serotype", x = "Prøvemateriale", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

# Panel 3: Penicillin MIC categories
mic_stype <- PN %>%
  filter(!is.na(sample_cat), !is.na(BEN_MIC)) %>%
  count(sample_cat, MIC_cat) %>%
  group_by(sample_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

mic_n <- mic_stype %>%
  group_by(sample_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

p3 <- ggplot(mic_stype, aes(x = sample_cat, y = fraction, fill = MIC_cat)) +
  geom_col(position = "stack") +
  geom_text(data = mic_n, aes(x = sample_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(
    values = c("S" = "#81A88D", "PNS" = "#FDD262", "PRP" = "#972D15"),
    name   = "Penicillin MIC"
  ) +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "Penicillin MIC", x = "Prøvemateriale", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

library(patchwork)
p1 + p2 + p3 + plot_layout(ncol = 3)

Fig16 Djupdykk i atypiske (“andre”) infeksjonar

# Panel 1: S/PNS/PRP fraction per year within "Andre"
andre_mic_year <- PN %>%
  filter(sample_cat == "Andre", !is.na(year), !is.na(BEN_MIC)) %>%
  count(year, MIC_cat) %>%
  group_by(year) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

andre_year_n <- andre_mic_year %>%
  group_by(year) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

ggplot(andre_mic_year, aes(x = year, y = fraction, fill = MIC_cat)) +
  geom_col(position = "stack") +
  geom_text(data = andre_year_n,
            aes(x = year, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(
    values = c("S" = "#81A88D", "PNS" = "#FDD262", "PRP" = "#972D15"),
    name   = "Penicillin MIC"
  ) +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(
    title = "Penicillin MIC per år – Prøvemateriale: \"Andre\" ",
    x     = "År",
    y     = "Fraksjon"
  ) +
  theme_bw(base_size = 15) +
  theme(
    axis.text.x        = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank()
  )

# Panel 2: GPSC within S/PNS/PRP for "Andre"
andre_gpsc <- PN %>%
  filter(sample_cat == "Andre", !is.na(BEN_MIC)) %>%
  mutate(GPSC_label = if_else(GPSC %in% top20_GPSC, GPSC, "Andre"),
         GPSC_label = factor(GPSC_label, levels = c(top20_GPSC, "Andre"))) %>%
  count(MIC_cat, GPSC_label) %>%
  group_by(MIC_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

andre_gpsc_n <- andre_gpsc %>%
  group_by(MIC_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

gpsc_colors <- setNames(c(wes19[seq_along(top20_GPSC)], "#d3d3d3"), c(top20_GPSC, "Andre"))

pa2 <- ggplot(andre_gpsc, aes(x = MIC_cat, y = fraction, fill = GPSC_label)) +
  geom_col(position = "stack") +
  geom_text(data = andre_gpsc_n,
            aes(x = MIC_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(values = gpsc_colors, name = "GPSC") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "GPSC per MIC-kategori", x = "Penicillin MIC", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

# Panel 3: Serotype within S/PNS/PRP for "Andre"
andre_sero <- PN %>%
  filter(sample_cat == "Andre", !is.na(BEN_MIC), !is.na(Serotype), Serotype != "") %>%
  mutate(Sero_label = if_else(Serotype %in% top20_Serotype, Serotype, "Andre"),
         Sero_label = factor(Sero_label, levels = c(top20_Serotype, "Andre"))) %>%
  count(MIC_cat, Sero_label) %>%
  group_by(MIC_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

andre_sero_n <- andre_sero %>%
  group_by(MIC_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

sero_colors <- setNames(c(wes19[seq_along(top20_Serotype)], "#d3d3d3"), c(top20_Serotype, "Andre"))

pa3 <- ggplot(andre_sero, aes(x = MIC_cat, y = fraction, fill = Sero_label)) +
  geom_col(position = "stack") +
  geom_text(data = andre_sero_n,
            aes(x = MIC_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(values = sero_colors, name = "Serotype") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "Serotype per MIC-kategori", x = "Penicillin MIC", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

# Panel 4: Specimen source within S/PNS/PRP for "Andre"
andre_spec <- PN %>%
  filter(sample_cat == "Andre", !is.na(BEN_MIC)) %>%
  mutate(
    spec_label = if_else(
      specimen_source == "" | is.na(specimen_source),
      "Ukjent",
      specimen_source
    )
  ) %>%
  count(MIC_cat, spec_label) %>%
  group_by(MIC_cat) %>%
  mutate(fraction = n / sum(n)) %>%
  ungroup()

andre_spec_n <- andre_spec %>%
  group_by(MIC_cat) %>%
  summarise(n_total = sum(n), .groups = "drop") %>%
  mutate(y_pos = 1.03)

spec_levels <- sort(unique(andre_spec$spec_label))
spec_colors <- setNames(wes19[seq_along(spec_levels)], spec_levels)

pa4 <- ggplot(andre_spec, aes(x = MIC_cat, y = fraction, fill = spec_label)) +
  geom_col(position = "stack") +
  geom_text(data = andre_spec_n,
            aes(x = MIC_cat, y = y_pos, label = paste0("n=", n_total)),
            inherit.aes = FALSE, size = 3.5, fontface = "bold") +
  scale_fill_manual(values = spec_colors, name = "Prøvemateriale") +
  scale_y_continuous(labels = percent_format(accuracy = 1),
                     expand = expansion(mult = c(0, 0.08))) +
  labs(title = "Infeksjonslokus per MIC-kategori", x = "Penicillin MIC", y = "Fraksjon") +
  theme_bw(base_size = 15) +
  theme(panel.grid.major.x = element_blank())

pa2 + pa3 + pa4 + plot_layout(ncol = 3, widths = c(1, 1, 1))

Pneumokokk NGS-dashboard

04. June 2026

R pakkar og data

Vaksinedekning

Numerisk oversikt over talet på sekvenserte IPD tilfeller med serotypar dekka av utvalde tilgjengelege vaksinar.

GPSC

Oversikt over dei ti vanlegaste GPSC gruppene i perioden fordelt på år.

Topp ti GPSC grupper - rangering over tid (bump-plot)

Serotypar

Oversikt over dei ti vanlegaste serotypane i perioden fordelt på år.

Topp ti serotypar - rangering over tid (bump-plot)

Aldersfordeling per serotype (topp 20)

Serotypar per aldersgruppe, per år

Penicillin resistens

Andel ikkje-følsome (MIC > 0.064 mg/l) “Penicillin non-susceptible” [PNS] isolat fordelt på MIC per år

Antal (n) observasjonar printa over kva søyle.

Sekvenstype-fordeling blant penicillin-resistente pneumokokkar (MIC ≥ 2, “PRP”)

GPSC-fordeling blant PRP-isolat (MIC ≥ 2)

Serotype-fordeling blant PRP-isolat (MIC ≥ 2)

PNS og PRP isolatar: GPSC, Serotype, MIC kombinasjonar

Fig12 PNS-isolat (MIC 0.12 – 1)

Fig13 PRP-isolat (MIC > 1)

Atypiske infeksjonar og resistens

Fig14 Antal tilfelle per år stratifisert etter prøvemateriale

Fig 15 Prøvemateriale og bakterielle eigenskapar

Fig16 Djupdykk i atypiske (“andre”) infeksjonar