inst/doc/Introduction.to.swimplot.R

In swimplot: Tools for Creating Swimmers Plots using 'ggplot2'

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(swimplot)
library(ggplot2)

## ---- echo = TRUE,fig.align='centre'------------------------------------------
knitr::kable(head(ClinicalTrial.Arm,10))
knitr::kable(head(ClinicalTrial.AE,10))
knitr::kable(head(ClinicalTrial.Response,10))

## ---- echo = TRUE,fig.align='centre'------------------------------------------
swimmer_plot(df=ClinicalTrial.Arm,id='id',end='End_trt',fill='lightblue',width=.85)

## ---- echo = TRUE,fig.align='centre'------------------------------------------
arm_plot <- swimmer_plot(df=ClinicalTrial.Arm,id='id',end='End_trt',name_fill='Arm',
                         id_order='Arm',col="black",alpha=0.75,width=.8)

arm_plot

## ---- echo = TRUE,fig.align='centre'------------------------------------------
swim_plot_stratify <-swimmer_plot(df=ClinicalTrial.Arm,id='id',end='End_trt',name_fill='Arm',
col="black",alpha=0.75,width=.8,base_size = 14,stratify= c('Age','Sex'))

swim_plot_stratify

## ---- echo = TRUE,fig.align='centre'------------------------------------------
AE_plot <- arm_plot + swimmer_points(df_points=
 ClinicalTrial.AE,id='id',time='time',name_shape =
 'event',size=2.5,fill='white',col='black')
AE_plot

## ---- echo = TRUE,fig.align='centre'------------------------------------------
arm_plot + swimmer_points(df_points=
 ClinicalTrial.AE,id='id',time='time',name_shape =
 'event',size=2.5,fill='white',name_col = 'Related')


## ---- echo = TRUE,fig.align='centre'------------------------------------------
Response_plot <- arm_plot +
swimmer_lines(df_lines=ClinicalTrial.Response,id='id',start =
'Response_start',end='Response_end',name_col='Response',size=1)

Response_plot

## ---- echo = TRUE,fig.align='centre'------------------------------------------
Response_plot_with_points <- Response_plot+
swimmer_points_from_lines(df_lines=ClinicalTrial.Response,id='id',start =
'Response_start',end = 'Response_end', cont =
'Continued_response',name_col='Response',size=2)

Response_plot_with_points

## ---- echo = TRUE,fig.align='centre'------------------------------------------
AE_plot+
swimmer_arrows(df_arrows=ClinicalTrial.Arm,id='id',arrow_start='End_trt',
cont = 'Continued_treatment',name_col='Arm',type =
 "open",cex=1)

## ---- echo = TRUE,fig.align='centre'------------------------------------------
AE_plot <- AE_plot+
swimmer_arrows(df_arrows=ClinicalTrial.Arm,id='id',arrow_start='End_trt',
cont = 'Continued_treatment',name_col='Arm',show.legend = FALSE,type =
 "open",cex=1) + scale_color_discrete(drop=FALSE)

AE_plot

## ---- echo = TRUE,fig.align='centre'------------------------------------------
Response_plot_with_points <- Response_plot_with_points+
 swimmer_arrows(df_arrows=ClinicalTrial.Response,id='id',arrow_start='Response_end',
 cont = 'Continued_response',name_col='Response',show.legend = FALSE,type =
 "open",cex=1)

Response_plot_with_points

## ----col1 , echo=T,warnings=FALSE,message=FALSE-------------------------------
AE_plot <-  AE_plot +
  scale_fill_manual(name="Treatment",values=c("Arm A" = "#e41a1c", "Arm B"="#377eb8","Off Treatment"='#4daf4a'))+
  scale_color_manual(name="Treatment",values=c("Arm A"="#e41a1c", "Arm B" ="#377eb8","Off Treatment"='#4daf4a')) +
  scale_shape_manual(name="Adverse event",values=c(AE=21,SAE=24,Death=17),breaks=c('AE','SAE','Death'))

AE_plot

## ----col2 , echo=T,warnings=F,warnings=FALSE,warnings=FALSE,message=FALSE-----
Response_plot_with_points <- Response_plot_with_points +
  scale_fill_manual(name="Treatment",values=c("Arm A" ="#e41a1c", "Arm B"="#377eb8","Off Treatment"='#4daf4a'))+
  scale_color_manual(name="Response",values=c("grey20","grey80"))+
  scale_shape_manual(name='',values=c(17,15),breaks=c('Response_start','Response_end'),
                     labels=c('Response start','Response end'))

Response_plot_with_points

## ----legend2 , echo=T,warnings=F,message=F,warning=FALSE----------------------

Response_plot_with_points <- Response_plot_with_points+guides(fill = guide_legend(override.aes = list(shape = NA)))
Response_plot_with_points


## ----legend3 ,echo=T, eval=T,warnings=F,message=F,warning=FALSE---------------

Response_plot_with_points <- Response_plot_with_points+
  annotate("text", x=3.5, y=20.45, label="Continued response",size=3.25)+
  annotate("text",x=2.5, y=20.25, label=sprintf('\u2192'),size=8.25)+
  coord_flip(clip = 'off', ylim = c(0, 17))
Response_plot_with_points


## ----axis2 , echo=T,warnings=FALSE,messgages=FALSE----------------------------

Response_plot_with_points +  scale_y_continuous(name = "Time since enrollment (months)",breaks = seq(0,18,by=3))


## ----Legend with multiple , echo=T,warnings=FALSE,messgages=FALSE-------------

#Overriding legends to have colours for the events and no points in the lines
p1 <- arm_plot + swimmer_points(df_points=ClinicalTrial.AE,id='id',time='time',name_shape =
                                       'event',size=2.5,col='black',name_fill = 'event') +
  scale_shape_manual(values=c(21,22,23),breaks=c('AE','SAE','Death'))
  

p1 +scale_fill_manual(name="Treatment",values=c("AE"='grey90',"SAE" ="grey40","Death" =1,"Arm A"="#e41a1c", "Arm B" ="#377eb8","Off Treatment"="#4daf4a"))

## ----Legend with multiple2 , echo=T,warnings=FALSE,messgages=FALSE------------
#First step is to correct the fill legend 

p2 <- p1 + scale_fill_manual(name="Treatment",values=c("AE"='grey90',"SAE" ="grey40","Death" =1,"Arm A"="#e41a1c", "Arm B" ="#377eb8","Off Treatment"="#4daf4a"),breaks = c("Arm A","Arm B","Off Treatment"))
p2
##Then use guides to add the colours to the 

#Setting the colours of the filled points to match the AE type 
p2 + guides(shape = guide_legend(override.aes = list(fill=c('grey90','grey40',1))),fill = guide_legend(override.aes = list(shape = NA))) 


## ---- echo=T,warnings=FALSE,messgages=FALSE-----------------------------------

Gap_data <- data.frame(patient_ID=c('ID:3','ID:1','ID:1','ID:1','ID:2',
                                    'ID:2','ID:2','ID:3','ID:3'),
                       start=c(10,1,2,7,2,10,14,5,0),
                       end=c(20,2,4,10,7,14,22,7,3),
                       treatment=c("A","B","C","A","A","C","A","B","C"))

knitr::kable(Gap_data)


## ---- echo=T,warnings=FALSE,messgages=FALSE-----------------------------------

swimmer_plot(df=Gap_data,id='patient_ID',name_fill="treatment",col=1,
id_order = c('ID:1','ID:2','ID:3')) +theme_bw()

## ---- echo=T,warnings=FALSE,messgages=FALSE-----------------------------------

Gap_data <- rbind(Gap_data,data.frame(patient_ID='ID:2',start=22,end=26,treatment=NA))
knitr::kable(Gap_data)

## ---- echo=T,warnings=FALSE,messgages=FALSE-----------------------------------
swimmer_plot(df=Gap_data,id='patient_ID',name_fill="treatment",col=1,
id_order = c('ID:1','ID:2','ID:3')) +
ggplot2::theme_bw()+ggplot2::scale_fill_manual(name="Treatment",
 values=c("A"="#e41a1c", "B"="#377eb8","C"="#4daf4a",na.value=NA),breaks=c("A","B","C"))+
  ggplot2::scale_y_continuous(breaks=c(0:26))

## ---- echo=T,warnings=FALSE,messgages=FALSE-----------------------------------

wide_example <- structure(list(ID = c("ID:001", "ID:002", "ID:003"), Date.begin.Treatment = structure(c(14307, 
14126, 15312), class = "Date"), AE = structure(c(16133, 14491, 
NA), class = "Date"), SAE = structure(c(16316, NA, 16042), class = "Date"), 
    Death.date = structure(c(16499, NA, 17869), class = "Date"), 
    Response1 = c("SD", "SD", NA), Response1.Start = structure(c(14745, 
    14345, NA), class = "Date"), Response1.End = structure(c(15111, 
    14418, NA), class = "Date"), Response2 = c("CR", "PR", NA
    ), Response2.Start = structure(c(15768, 14674, NA), class = "Date"), 
    Response2.End = structure(c(16133, 14856, NA), class = "Date"), 
    Response3 = c(NA, "CR", NA), Response3.Start = structure(c(NA, 
    14856, NA), class = "Date"), Response3.End = structure(c(NA, 
    15587, NA), class = "Date"), Last.follow.up = structure(c(16499, 
    17048, 17869), class = "Date")), class = "data.frame", row.names = c(NA, 
-3L))

## ---- echo=F,warnings=FALSE,messgages=FALSE, fig.width = 8, fig.height = 4.5----
knitr::kable(wide_example)

## ---- echo=TRUE,warnings=FALSE,messgages=FALSE, fig.width = 8, fig.height = 4.5----
date_cols <- c("Date.begin.Treatment","AE","SAE",'Death.date','Response1.Start', 'Response1.End','Response2.Start', 'Response2.End',
               'Response3.Start' ,'Response3.End' ,'Last.follow.up') # Getting the columns with dates
wide_example[date_cols] <- lapply(wide_example[date_cols], as.numeric) # Converting to numbers 
wide_example[date_cols] <- round((wide_example[date_cols]-wide_example$Date.begin.Treatment)/365.25,1) #Calcuating the time in years since the start of treatment
knitr::kable(wide_example)

## ----echo=T,warnings=FALSE,messgages=FALSE------------------------------------
plot <- swimmer_plot(df=wide_example,id='ID',end='Last.follow.up',col='black',fill='grey')
plot

## ----echo=T,warning=FALSE,messgage=FALSE, fig.width = 8, fig.height = 4.5-----
library(tidyr)
data_time_points <- wide_example[,c('ID','AE','SAE','Death.date')]
points_long <- gather_(data=data_time_points,"point", "time", 
                       gather_cols=c('AE','SAE','Death.date'),na.rm=T)
knitr::kable(points_long,align='c',row.names = F)

## ----echo=T,warning=FALSE,messgage=FALSE, fig.width = 8, fig.height = 4.5-----
plot+ swimmer_points(df=points_long,id='ID',name_shape = 'point',size=8)

## ----warning=FALSE,messgage=FALSE,echo=T, fig.width = 8, fig.height = 4.5-----
long_start <- gather_(data=wide_example[,c('ID','Response1.Start','Response2.Start','Response3.Start')],
                      "response_number", "start_time", gather_cols=c('Response1.Start','Response2.Start',
                                                                'Response3.Start'),na.rm=T)

long_start$response_number <- substring(long_start$response_number,1,9) # Will be used to match to the end and types

## ----warning=FALSE,messgage=FALSE,echo=FALSE, fig.width = 8, fig.height = 4.5----
knitr::kable(long_start,align='c',row.names = F)

## ----fig.height=4.5,echo=TRUE, fig.width=8, message=FALSE, warning=FALSE------
long_end <- gather_(data=wide_example[,c('ID','Response1.End','Response2.End','Response3.End')],
                    "response_number", "end_time", gather_cols=c('Response1.End','Response2.End',
                                                            'Response3.End'),na.rm=T)
long_end$response_number <- substring(long_end$response_number,1,9)

long_response <- gather_(data=wide_example[,c('ID','Response1','Response2','Response3')],
                         "response_number", "Response", gather_cols=c('Response1','Response2','Response3'),
                         na.rm=T)

long_response_full <- Reduce(function(...) merge(..., all=TRUE,by=c('ID','response_number')), 
                            list(long_start, long_end, long_response))

## ----fig.height=4.5,echo=F, fig.width=8, message=FALSE, warning=FALSE---------
knitr::kable(long_response_full,align='c',row.names = F)

## ----echo=TRUE,warnings=FALSE,messgages=FALSE, fig.width = 8, fig.height = 4.5----
plot+ 
  swimmer_points(df=points_long,id='ID',name_shape = 'point',size=8)+
  swimmer_lines(df_lines = long_response_full,id='ID',start = 'start_time',end='end_time',
                name_col='Response',size=25)