Wonderful Wednesday June 2025 (63)

Improvement Longitudinal data Wonderful Wednesdays

All about improving an existing plot from a recent publication on a hyperkalemia trial.

PSI VIS SIG https://www.psiweb.org/sigs-special-interest-groups/visualisation
06-11-2025

Hyperkalemia Trial

There was a recently publication of a trial on treatment of patients with hyperkalemia. While the trial outcome was very positive the graphical representation left room for improvement.

Data set:

The data was created by reading out the results shown in the plot of the publication.

Variable Name Variable Label
x Original value from the vertical axis
y Original value from the horizontal axis
file File name of data input
class Original group label
treat Treatment group (derived)
stat Statistical measure
mean: mean value
llc: lower limit of confidence
ulc: upper limit of confidence
visit Study visit (derived)
serumK Blood serum level of Potassium (derived)

The Challenge:

Within the publication the below plot was present. This months challenge is to improve the plot or find a better way to visually present the data.

Original plot from publication

Reference:

Sodium zirconium cyclosilicate versus sodium polystyrene sulfonate for treatment of hyperkalemia in hemodialysis patients: a randomized clinical trial The publication is available via NIH or BMC Nephrology.

A description of the challenge can also be found here.
A recording of the session can be found here.

Visualisations

Example 1. Line graph

link to code

Example 2. Bar chart

link to code

Example 3. Confidence bands

pdf file

link to code

Code

Example 1. Line graph

##################################################################################################################
## Program:   WW_ImproveFigure_May2025.R                                                                  
##                                                                             
## Study:     None                                                         
##                                                                             
## Purpose:   Wonderful Wednesday PSI challenge May 2025
##                                                                             
## Inputs:    fig2data.csv
##
## Outputs:   ImproveFigure_V1_LineChart.png
##            ImproveFigure_V2_change.png
##
## Revision                                                                                                     
## History:      Version     Date        Author                  Description                                    
##                -------     ---------   -------------------     -------------------------------------------   
##                    1.0     23MAY2025   Baerbel Maus           Initial version 
##################################################################################################################


## cleanup
rm(list=ls())

library(ggplot2)
# prepare data
projectRoot <- "C:/Temp/"
setwd(projectRoot)

# dat <- read.csv(paste0(projectRoot,"fig2data.csv"))
dat <- read.csv("https://raw.githubusercontent.com/VIS-SIG/Wonderful-Wednesdays/refs/heads/master/data/2025/2025-05-14/fig2data.csv")

dat2 <- dat[,c(-1,-4)] # remove unnecessary columns
names(dat2)[c(1,2)] <- c("visitNum","serumK_exact")


### plot line chart
jitter = 0.1

png(filename ="ImproveFigure_V1_LineChart.png",width = 500, height = 480)

# add results for SZC group
plot(x = c(0,1,2,4,6,8) - jitter, y = dat2$serumK_exact[dat2$treat == "SZC group" & dat2$stat == "mean"],
     xlab = "Week",xaxt = "n",ylab = "Serum K (mEq/l)", type = "l",xlim = c(-0.5,8.5), ylim = c(0,6), col = "orange",lwd = 2)
points(x = c(0,1,2,4,6,8)-jitter, dat2$serumK_exact[dat2$treat == "SZC group" & dat2$stat == "mean"],
      col = "orange",pch = 16)
arrows(c(0,1,2,4,6,8)-jitter, dat2$serumK_exact[dat2$treat == "SZC group" & dat2$stat == "ulc"]
  ,c(0,1,2,4,6,8)-jitter, dat2$serumK_exact[dat2$treat == "SZC group" & dat2$stat == "llc"],
       angle=90, code=3, lwd=2, length=.025, col = "orange")

# add results for SPS group
points(x = c(0,1,2,4,6,8)+jitter, dat2$serumK_exact[dat2$treat == "SPS group" & dat2$stat == "mean"],
     type = "l",col = "blue",lwd = 2)

points(x = c(0,1,2,4,6,8)+jitter, dat2$serumK_exact[dat2$treat == "SPS group" & dat2$stat == "mean"],
       col = "blue",pch = 16)
arrows(c(0,1,2,4,6,8)+jitter, dat2$serumK_exact[dat2$treat == "SPS group" & dat2$stat == "ulc"]
       ,c(0,1,2,4,6,8)+jitter, dat2$serumK_exact[dat2$treat == "SPS group" & dat2$stat == "llc"],
       angle=90, code=3, lwd=2, length=.025, col = "blue")

abline(a = 5, b= 0, col = "black" )
text(2,4,"Normokalemia", col = "black")
text(2,6,"Hyperkalemia", col = "black")

# modify axes
axis(1, at = c(0,1,2,4,6,8),labels = c("Baseline","1","2","4","6","8"),xlim = c(-0.5,8))

# add legend and title

legend(x= 1,y=1,legend = c("SZC group (N = 60) (mean and 95% CI)","SPS group (N = 60) (mean and and 95% CI)"),col = c("orange","blue"),lwd = 2,bty = 'n')
title(expression(bold(paste(phantom("SZC"), " treatment resolves Hyperkalemia faster and more effective"))),line = 3)
title(main = expression(bold(paste("SZC",phantom(" treatment resolves Hyperkalemia faster and more effective")))), col.main = "orange", line = 3)

title(expression(paste("Mean serum potassium levels were significantly lower in the ",phantom("SZC")," compared to ",phantom("SPS"),
" group (p < 0.05)")), line = 2, cex.main = 0.8)
title(expression(paste(phantom("Mean serum potassium levels were significantly lower in the "),"SZC",
                       phantom(" compared to SPS group (p < 0.05)"))), line = 2, cex.main = 0.8,col.main = "orange")
title(expression(paste(phantom("Mean serum potassium levels were significantly lower in the SZC compared to "),"SPS",
                       phantom(" group (p < 0.05)"))), line = 2, cex.main = 0.8,col.main = "blue")

dev.off()

Back to blog

Example 2. Bar chart

##################################################################################################################
## Program:   WW_ImproveFigure_May2025.R                                                                  
##                                                                             
## Study:     None                                                         
##                                                                             
## Purpose:   Wonderful Wednesday PSI challenge May 2025
##                                                                             
## Inputs:    fig2data.csv
##
## Outputs:   ImproveFigure_V1_LineChart.png
##            ImproveFigure_V2_change.png
##
## Revision                                                                                                     
## History:      Version     Date        Author                  Description                                    
##                -------     ---------   -------------------     -------------------------------------------   
##                    1.0     23MAY2025   Baerbel Maus           Initial version 
##################################################################################################################


## cleanup
rm(list=ls())

library(ggplot2)
# prepare data
projectRoot <- "C:/Temp/"
setwd(projectRoot)

# dat <- read.csv(paste0(projectRoot,"fig2data.csv"))
dat <- read.csv("https://raw.githubusercontent.com/VIS-SIG/Wonderful-Wednesdays/refs/heads/master/data/2025/2025-05-14/fig2data.csv")

dat2 <- dat[,c(-1,-4)] # remove unnecessary columns
names(dat2)[c(1,2)] <- c("visitNum","serumK_exact")

### create barchart with changes, add lines for 2 weeks and 6 weeks

datChange <- cbind(dat2,dat2$serumK - 5)
names(datChange) <- c(names(dat2),"change")
datChange$visitNum2 <- c()
datChange$visitNum2[datChange$visit == "Baseline"] <- 0
datChange$visitNum2[datChange$visit == "1st week"] <- 1
datChange$visitNum2[datChange$visit == "2nd week"] <- 2
datChange$visitNum2[datChange$visit == "4th week"] <- 4
datChange$visitNum2[datChange$visit == "6th week"] <- 6
datChange$visitNum2[datChange$visit == "8th week"] <- 8

png(filename ="ImproveFigure_V2_change.png")
ggplot(datChange[datChange$stat == "mean",], aes(x = visitNum2, y = change, fill = treat)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_manual(name = "Group",values = c("SPS group" =  "blue", "SZC group" =  "orange")) +
  labs(title = "SZC treatment resolves Hyperkalemia (> 5 mEq/l) faster and more effective", x = "Week", y = "Serum K (mEq/l)") +
  scale_x_continuous(
    breaks = c(0,1,2,4,6,8),
    labels = c("Baseline","1","2","4","6","8"),
    minor_breaks = NULL,
    limits = c(-0.5,8.5) 
  )  +
  scale_y_continuous(
    breaks = seq(-1,1,0.25),
    labels = seq(4,6,0.25),
    minor_breaks = NULL,
    limits = c(-1, 1) 
  ) +
  geom_hline(yintercept = 0, color = "black", linetype = "solid", linewidth = 1) +
  geom_vline(xintercept = 2, color = "orange", linetype = "dashed", linewidth = 1) +
  annotate("text", x = 2.5, y = -0.5, label = "SZC group reaches Normokalemia at 2 weeks", colour = "orange") +
  geom_vline(xintercept = 6, color = "blue", linetype = "dashed", linewidth = 1) +
  annotate("text", x = 5.5, y = -0.75, label = "SPS group reaches Normokalemia at 6 weeks", colour = "blue") +
  theme_minimal()
  

dev.off()

Back to blog

Example 3. Confidence bands

#############################################################################

#       Wonderful Wednesday Challenge - May 14 - Melisa Castellanos

#############################################################################

# https://github.com/VIS-SIG/Wonderful-Wednesdays/blob/master/data/2025/2025-05-14/fig2data.csv

library(readr)
library(dbplyr)
library(tidyverse)
library(ggplot2)

data <- read_csv(
  "C:/Users/castelme/OneDrive - Boehringer Ingelheim/Documents/R/Hyperkalemia challenge/fig2data.csv")
data

data_wide_summary <- data %>%

  select(visit, treat, stat, serumK) %>%
  pivot_wider(
    id_cols = c(visit, treat),    # Columns that uniquely identify each row in the new wide format
    names_from = stat,            # The column whose values ("llc", "ulc", "mean") will become new column names
    values_from = serumK) 

data_wide_summary

# plot

ggplot(data_wide_summary, aes(x = factor(visit, level = c("Baseline", "1st week","2nd week","4th week","6th week","8th week")), 
   y = mean, 
   group = treat, 
   color = treat)) +
   geom_ribbon(aes(ymin=llc, ymax=ulc, fill = treat), alpha = 0.3, linetype = 0) +
   geom_line(size = 1.5) +
   geom_hline(yintercept = 5, linetype = "dashed", color = "gray", size = 1) +
   labs(
   title = "Serum potassium changes. Comparison of two treatments for hyperkalemia.",
   subtitle = "Data from Elsayed et al. (2025)",
   caption = "Plotted by Melisa Castellanos for ~Wonderful Wednesday Challenge~ by PSI.
              SCZ = sodium zirconium cyclosilicate. SPS = sodium polystyrene sulfonate.
              LLC = lower limit of confidence. ULC = Upper limit of confidence. 
              In this new visualization, the treatment arms are shown within the same plot making comparison easier.",
   x = "Visit",
   y = "Serum K (mEq/L)",
   fill = "LLC - ULC",
   color = "Treatment Arm Mean"
   ) +
  theme_minimal() +
  scale_color_manual(values = c("SZC group" = "darkblue", # Line of treatment 1
                                "SPS group" = "darkgreen")) + # line treatment 2
  scale_fill_manual(values = c("SZC group" = "lightblue", # A lighter shade of blue for SZC group's band
                               "SPS group" = "lightgreen"))  # A lighter shade of red for SPS group's band

Back to blog

Citation

For attribution, please cite this work as

SIG (2025, June 11). VIS-SIG Blog: Wonderful Wednesday June 2025 (63). Retrieved from https://graphicsprinciples.github.io/posts/2025-06-11-wonderful-wednesday-june-2025/

BibTeX citation

@misc{sig2025wonderful,
  author = {SIG, PSI VIS},
  title = {VIS-SIG Blog: Wonderful Wednesday June 2025 (63)},
  url = {https://graphicsprinciples.github.io/posts/2025-06-11-wonderful-wednesday-june-2025/},
  year = {2025}
}