All about improving an existing plot from a recent publication on a 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.
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.
##################################################################################################################
## 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()
##################################################################################################################
## 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()
#############################################################################
# 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
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} }