Objective 1 - Step 6: Clinical and Pathological Characterization (Table 1 & Table 2)

Overview

This script produces the two clinical characterization tables for the thesis Results section, built on the corrected clinical_clean.rds checkpoint (post pathology-mismatch correction, see 03_Crosswalk_ID_Harmonization.Rmd):

Table 1 - PDAC (RPC+LAPC+MPC combined) vs. BBP, full recruited clinical cohort (excludes HC and CP, which are neither PDAC nor BBP).
Table 2 - within the PDAC group only, RPC vs. LAPC vs. MPC, with Dunn’s post-hoc pairwise comparisons for any significant omnibus result, and a Spearman rank trend test against ordinal disease category (RPC < LAPC < MPC) to distinguish a true progression trend from an unordered group difference.

dunn.test and FSA were not available in this environment, so Dunn’s test is implemented manually below (rank-sum z-test with tie correction, Bonferroni-adjusted), following Dunn (1964).

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(knitr)

clinical_clean <- readRDS("clinical_clean.rds")
dim(clinical_clean)

## [1] 233  54

fmt_iqr <- function(x) {
  x <- x[!is.na(x)]
  if (length(x) == 0) return(NA_character_)
  q <- quantile(x, c(0.25, 0.5, 0.75))
  sprintf("%.1f [%.1f, %.1f]", q[2], q[1], q[3])
}

fmt_p <- function(p) {
  if (is.na(p)) return(NA_character_)
  if (p < 0.001) return("<0.001")
  sprintf("%.3f", p)
}

# Manual Dunn's test (1964): pairwise rank-sum z-tests with tie
# correction, following a significant Kruskal-Wallis omnibus test.
# p-values are two-sided and Bonferroni-adjusted across all pairs.
dunn_test <- function(x, g) {
  ok <- !is.na(x) & !is.na(g)
  x <- x[ok]; g <- factor(g[ok])
  N <- length(x)
  r <- rank(x)
  groups <- levels(g)
  k <- length(groups)
  tie_table <- table(x)
  tie_term <- sum(tie_table^3 - tie_table) / (12 * (N - 1))
  meanranks <- tapply(r, g, mean)
  ns <- tapply(r, g, length)
  res <- data.frame()
  for (i in 1:(k - 1)) for (j in (i + 1):k) {
    se <- sqrt((N * (N + 1) / 12 - tie_term) * (1 / ns[i] + 1 / ns[j]))
    z <- (meanranks[i] - meanranks[j]) / se
    p <- 2 * (1 - pnorm(abs(z)))
    res <- rbind(res, data.frame(group1 = groups[i], group2 = groups[j],
                                  z = z, p_raw = p))
  }
  res$p_bonf <- pmin(res$p_raw * nrow(res), 1)
  res
}

# Variables shared by both tables' lab panel
cont_vars <- c(Age = "age", WCC = "white_cell_count", Haemoglobin = "haemaglobin",
               Creatinine = "creatinine_umol_l", CRP = "c_reactive_protein_mg_l",
               `Total protein` = "total_protein_g_l", Albumin = "albumin_g_l",
               `Total bilirubin` = "total_bilirubin_tbil_umol_l",
               `Conjugated bilirubin` = "conjugated_bilirubin_dbil_umol_l",
               ALT = "alanine_transaminase_alt_u_l", AST = "aspartate_transaminase_ast_u_l",
               ALP = "alkaline_phosphatase_alp_u_l", GGT = "gamma_glutamyl_transferase_ggt_u_l")

Table 1: PDAC vs. BBP (full recruited clinical cohort)

cc1 <- clinical_clean %>%
  mutate(group2 = case_when(
    pathology == "BBP" ~ "BBP",
    pathology %in% c("RPC", "LAPC", "MPC") ~ "PDAC",
    TRUE ~ NA_character_
  )) %>%
  filter(!is.na(group2))

cat("Excluded from this comparison (neither PDAC nor BBP):\n")

## Excluded from this comparison (neither PDAC nor BBP):

clinical_clean %>% filter(!pathology %in% c("BBP","RPC","LAPC","MPC")) %>% count(pathology)

## # A tibble: 2 × 2
##   pathology     n
##   <chr>     <int>
## 1 CP            6
## 2 HC           42

cat("\nTable 1 cohort sizes:\n")

## 
## Table 1 cohort sizes:

table(cc1$group2)

## 
##  BBP PDAC 
##   83  102

table1_cont <- lapply(names(cont_vars), function(nm) {
  v <- cont_vars[[nm]]
  bbp <- cc1[[v]][cc1$group2 == "BBP"]
  pdac <- cc1[[v]][cc1$group2 == "PDAC"]
  p <- tryCatch(wilcox.test(bbp, pdac)$p.value, error = function(e) NA)
  data.frame(Variable = nm, BBP = fmt_iqr(bbp), PDAC = fmt_iqr(pdac), p = fmt_p(p))
}) %>% bind_rows()

kable(table1_cont, caption = "Table 1 continuous variables (Wilcoxon rank-sum test)")

Table 1 continuous variables (Wilcoxon rank-sum test)
Variable	BBP	PDAC	p
Age	39.0 [32.0, 56.0]	62.0 [52.0, 67.2]	<0.001
WCC	8.1 [6.5, 9.8]	9.4 [7.1, 13.4]	0.040
Haemoglobin	11.9 [10.7, 13.7]	10.4 [9.0, 12.2]	<0.001
Creatinine	69.5 [61.0, 82.8]	71.0 [57.2, 91.8]	0.960
CRP	20.0 [8.0, 73.0]	69.5 [24.8, 141.2]	<0.001
Total protein	72.5 [67.2, 78.8]	66.0 [58.0, 69.0]	<0.001
Albumin	39.5 [35.2, 42.8]	31.0 [27.0, 36.0]	<0.001
Total bilirubin	30.0 [10.0, 92.0]	154.0 [52.5, 269.5]	<0.001
Conjugated bilirubin	23.0 [4.0, 73.5]	135.0 [36.0, 242.0]	<0.001
ALT	47.5 [17.0, 107.5]	72.0 [34.0, 151.5]	0.052
AST	53.0 [28.0, 90.0]	108.0 [55.0, 171.0]	<0.001
ALP	200.0 [111.0, 403.5]	543.0 [286.5, 1144.0]	<0.001
GGT	171.0 [80.5, 500.5]	502.0 [231.0, 1088.0]	<0.001

sex_known <- cc1 %>% filter(!is.na(gender))
sex_tab <- sex_known %>% count(group2, gender) %>%
  group_by(group2) %>% mutate(pct = round(100 * n / sum(n), 1))
sex_tab

## # A tibble: 4 × 4
## # Groups:   group2 [2]
##   group2 gender     n   pct
##   <chr>  <chr>  <int> <dbl>
## 1 BBP    female    67  80.7
## 2 BBP    male      16  19.3
## 3 PDAC   female    37  39.4
## 4 PDAC   male      57  60.6

fisher_sex <- fisher.test(table(sex_known$group2, sex_known$gender))
fisher_sex$p.value

## [1] 2.276409e-08

cat("Excluded from sex percentages (missing gender):\n")

## Excluded from sex percentages (missing gender):

cc1 %>% filter(is.na(gender)) %>% count(group2)

## # A tibble: 1 × 2
##   group2     n
##   <chr>  <int>
## 1 PDAC       8

cc1 %>% filter(group2 == "PDAC") %>% count(pathology) %>%
  mutate(pct = round(100 * n / sum(n), 1))

## # A tibble: 3 × 3
##   pathology     n   pct
##   <chr>     <int> <dbl>
## 1 LAPC         13  12.7
## 2 MPC          10   9.8
## 3 RPC          79  77.5

pdac_only <- cc1 %>% filter(group2 == "PDAC")

cat("Vital status known:", sum(!is.na(pdac_only$dead_alive)), "of", nrow(pdac_only), "\n")

## Vital status known: 58 of 102

table(pdac_only$dead_alive, useNA = "ifany")  # 0 = Dead, 1 = Alive (verified against date_of_death)

## 
##    0    1 <NA> 
##   36   22   44

cat("\nFollow-up time known:", sum(!is.na(pdac_only$followup)), "of", nrow(pdac_only), "\n")

## 
## Follow-up time known: 33 of 102

fmt_iqr(pdac_only$followup)

## [1] "154.0 [82.0, 356.0]"

Table 2: PDAC disease category (RPC vs. LAPC vs. MPC)

cc2 <- clinical_clean %>% filter(pathology %in% c("RPC", "LAPC", "MPC"))
table(cc2$pathology)

## 
## LAPC  MPC  RPC 
##   13   10   79

table2_cont <- lapply(names(cont_vars), function(nm) {
  v <- cont_vars[[nm]]
  rpc <- cc2[[v]][cc2$pathology == "RPC"]
  lapc <- cc2[[v]][cc2$pathology == "LAPC"]
  mpc <- cc2[[v]][cc2$pathology == "MPC"]
  p <- tryCatch(kruskal.test(list(rpc, lapc, mpc))$p.value, error = function(e) NA)
  data.frame(Variable = nm, RPC = fmt_iqr(rpc), LAPC = fmt_iqr(lapc),
             MPC = fmt_iqr(mpc), p = fmt_p(p))
}) %>% bind_rows()

kable(table2_cont, caption = "Table 2 continuous variables (Kruskal-Wallis test)")

Table 2 continuous variables (Kruskal-Wallis test)
Variable	RPC	LAPC	MPC	p
Age	64.0 [55.0, 69.0]	56.0 [51.0, 60.0]	55.5 [49.0, 66.0]	0.065
WCC	8.9 [7.0, 13.2]	10.8 [7.1, 11.4]	13.4 [9.1, 15.5]	0.488
Haemoglobin	10.4 [9.2, 12.2]	9.9 [7.9, 11.6]	11.1 [9.7, 12.2]	0.339
Creatinine	72.0 [58.0, 97.2]	63.0 [56.0, 82.0]	71.0 [57.0, 78.0]	0.523
CRP	56.0 [19.0, 135.0]	94.0 [39.0, 136.0]	113.0 [50.8, 222.8]	0.291
Total protein	64.0 [57.5, 68.0]	65.0 [55.5, 67.5]	72.0 [69.0, 74.2]	0.010
Albumin	31.0 [27.0, 35.0]	27.0 [25.0, 30.0]	36.0 [31.0, 38.0]	0.098
Total bilirubin	160.0 [65.0, 268.0]	100.0 [43.0, 185.0]	60.0 [40.0, 335.0]	0.519
Conjugated bilirubin	141.0 [37.0, 246.0]	90.0 [31.0, 151.0]	51.0 [38.0, 315.0]	0.471
ALT	92.0 [41.0, 151.0]	64.0 [17.0, 101.0]	48.0 [30.0, 362.0]	0.603
AST	104.0 [59.0, 162.0]	106.0 [51.0, 118.0]	123.0 [57.0, 268.0]	0.356
ALP	615.0 [302.0, 1045.0]	386.0 [237.0, 789.0]	397.0 [302.0, 1645.0]	0.433
GGT	502.0 [198.0, 1155.0]	313.0 [151.0, 683.0]	839.0 [400.0, 1021.0]	0.404

sex_known2 <- cc2 %>% filter(!is.na(gender))
sex_known2 %>% count(pathology, gender) %>%
  group_by(pathology) %>% mutate(pct = round(100 * n / sum(n), 1))

## # A tibble: 6 × 4
## # Groups:   pathology [3]
##   pathology gender     n   pct
##   <chr>     <chr>  <int> <dbl>
## 1 LAPC      female     2  15.4
## 2 LAPC      male      11  84.6
## 3 MPC       female     5  50  
## 4 MPC       male       5  50  
## 5 RPC       female    30  42.3
## 6 RPC       male      41  57.7

fisher.test(table(sex_known2$pathology, sex_known2$gender))$p.value

## [1] 0.1569645

# Total protein is the only variable with a significant omnibus result --
# run Dunn's post-hoc to localize which pairs differ
kruskal.test(total_protein_g_l ~ pathology, data = cc2)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  total_protein_g_l by pathology
## Kruskal-Wallis chi-squared = 9.2697, df = 2, p-value = 0.009707

dunn_test(cc2$total_protein_g_l, cc2$pathology)

##       group1 group2          z       p_raw      p_bonf
## LAPC    LAPC    MPC -2.5811724 0.009846540 0.029539620
## LAPC1   LAPC    RPC -0.2407474 0.809750869 1.000000000
## MPC      MPC    RPC  2.9735061 0.002944186 0.008832558

cc2 %>% group_by(pathology) %>%
  summarise(median = median(total_protein_g_l, na.rm = TRUE), n = sum(!is.na(total_protein_g_l)))

## # A tibble: 3 × 3
##   pathology median     n
##   <chr>      <dbl> <int>
## 1 LAPC          65    11
## 2 MPC           72     8
## 3 RPC           64    59

Total protein was the only lab variable with a significant omnibus Kruskal-Wallis result (see table above). Dunn’s post-hoc (Bonferroni- adjusted) localizes this to MPC vs. RPC and MPC vs. LAPC; RPC vs. LAPC does not differ.

bili <- cc2 %>% filter(!is.na(bilirubin_index_clean)) %>%
  mutate(bili_grp = ifelse(bilirubin_index_clean %in% c("1+","2+","3+"),
                            "Positive (1+ to 3+)", bilirubin_index_clean))

bili %>% count(pathology, bili_grp) %>% group_by(pathology) %>%
  mutate(pct = round(100 * n / sum(n), 1))

## # A tibble: 9 × 4
## # Groups:   pathology [3]
##   pathology bili_grp                n   pct
##   <chr>     <chr>               <int> <dbl>
## 1 LAPC      Positive (1+ to 3+)    10  76.9
## 2 LAPC      none                    2  15.4
## 3 LAPC      trace                   1   7.7
## 4 MPC       Positive (1+ to 3+)     6  75  
## 5 MPC       none                    1  12.5
## 6 MPC       trace                   1  12.5
## 7 RPC       Positive (1+ to 3+)    48  77.4
## 8 RPC       none                    4   6.5
## 9 RPC       trace                  10  16.1

fisher.test(table(bili$pathology, bili$bili_grp))$p.value

## [1] 0.6800571

cc2_ord <- cc2 %>% mutate(stage_ord = case_when(
  pathology == "RPC" ~ 1, pathology == "LAPC" ~ 2, pathology == "MPC" ~ 3
))

trend_results <- lapply(names(cont_vars), function(nm) {
  v <- cont_vars[[nm]]
  x <- cc2_ord$stage_ord; y <- cc2_ord[[v]]
  ok <- complete.cases(x, y)
  ct <- tryCatch(cor.test(x[ok], y[ok], method = "spearman"), error = function(e) NULL)
  if (is.null(ct)) return(NULL)
  data.frame(Variable = nm, rho = round(unname(ct$estimate), 3),
             p = fmt_p(ct$p.value), n = sum(ok))
}) %>% bind_rows()

## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties
## Warning in cor.test.default(x[ok], y[ok], method = "spearman"): cannot compute
## exact p-value with ties

kable(trend_results, caption = "Spearman rank correlation vs. ordinal disease category (RPC=1 < LAPC=2 < MPC=3)")

Spearman rank correlation vs. ordinal disease category (RPC=1 < LAPC=2 < MPC=3)
Variable	rho	p	n
Age	-0.212	0.042	92
WCC	0.096	0.372	88
Haemoglobin	-0.037	0.731	89
Creatinine	-0.122	0.262	86
CRP	0.168	0.141	78
Total protein	0.223	0.050	78
Albumin	-0.057	0.599	87
Total bilirubin	-0.081	0.457	87
Conjugated bilirubin	-0.078	0.474	87
ALT	-0.067	0.538	87
AST	-0.004	0.972	87
ALP	-0.073	0.503	87
GGT	-0.011	0.923	87

Age is the only variable showing a significant monotonic trend with disease category (progression-consistent); total protein’s significant omnibus result above is therefore an MPC-specific subgroup effect rather than a graded progression pattern.

Session info

sessionInfo()

## R version 4.6.1 (2026-06-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=English_United States.utf8 
## [2] LC_CTYPE=English_United States.utf8   
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.utf8    
## 
## time zone: Africa/Johannesburg
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] knitr_1.51  dplyr_1.2.1
## 
## loaded via a namespace (and not attached):
##  [1] vctrs_0.7.3       cli_3.6.6         rlang_1.2.0       xfun_0.59        
##  [5] otel_0.2.0        generics_0.1.4    jsonlite_2.0.0    glue_1.8.1       
##  [9] htmltools_0.5.9   sass_0.4.10       rmarkdown_2.31    evaluate_1.0.5   
## [13] jquerylib_0.1.4   tibble_3.3.1      fastmap_1.2.0     yaml_2.3.12      
## [17] lifecycle_1.0.5   compiler_4.6.1    pkgconfig_2.0.3   rstudioapi_0.19.0
## [21] digest_0.6.39     R6_2.6.1          utf8_1.2.6        tidyselect_1.2.1 
## [25] pillar_1.11.1     magrittr_2.0.5    bslib_0.11.0      tools_4.6.1      
## [29] cachem_1.1.0

Objective 1 - Step 6: Clinical and Pathological Characterization (Table 1 & Table 2)

Judy Ngobeni

2026-09-17

Overview

Table 1: PDAC vs. BBP (full recruited clinical cohort)

Table 2: PDAC disease category (RPC vs. LAPC vs. MPC)

Session info