jsauer/secmalasct
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'plot-functions'

Browse Source 
* plot-functions:
  Add plot_survival.R
  survival: Create functions for plots
This commit is contained in:
Jens Sauer 2020-11-16 22:49:52 +01:00
commit e1c6279119
3 changed files with 52 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
plot_survival.R Normal file
View File

@ -0,0 +1,10 @@
# secMalASCT survival plots
#
# License: GPL version 3
# Jens Mathis Sauer (c) 2020
source("survival.R")
#
# Make all plots and save to file
sma_plot_file_surv()

84
survival.R
View File

@ -13,53 +13,49 @@ surv_dx <- Surv(time = secmal$event_time_dx, event = secmal$event_status)
surv_asct <- Surv(time = secmal$event_time_asct, event = secmal$event_status)
# plot survival after diagnosis
# scaled to years
sma_plot_surv_dx <- function() {
plot(survfit(surv_dx ~ 1), mark.time = TRUE, xscale = 365.25,
xlab = "Years", ylab = "Survival")
title("Kaplan-Meier estimate for\nsecMalASCT study",
"Survival after diagnosis")
}
sma_plot_file("survival_dx.png", png,
list(main = "Kaplan-Meier estimate for\nsecMalASCT study",
sub = "Survival after diagnosis"),
NULL,
plot, survfit(surv_dx ~ 1),
mark.time = TRUE,
xscale = 365.25,
xlab = "Years",
ylab = "Survival")
# plot survival after diagnosis per sex
sma_plot_surv_dx_sex <- function() {
plot(survfit(surv_dx ~ sex, data = secmal), mark.time = TRUE,
xscale = 365.25, xlab = "Years", ylab = "Survival",
lty = 2:3)
title("Kaplan-Meier estimate for\nsecMalASCT study",
"Survival after diagnosis")
legend(100, .9, c("Female", "Male"), lty = 2:3)
}
# One graph per sex
sma_plot_file("survival_dx_sex.png", png,
list(main = "Kaplan-Meier estimate for\nsecMalASCT study",
sub = "Survival after diagnosis"),
list(100, .9, c("Female", "Male"), lty = 2:3),
plot, survfit(surv_dx ~ sex, data = secmal),
mark.time = TRUE,
xscale = 365.25,
xlab = "Years",
ylab = "Survival",
lty = 2:3)
# plot survival after transplantation
sma_plot_surv_asct <- function() {
plot(survfit(surv_asct ~ 1), mark.time = TRUE, xscale = 365.25,
xlab = "Years", ylab = "Survival")
title("Kaplan-Meier estimate for\nsecMalASCT study",
"Survival after transplantation")
}
# plot survival after diagnosis
# scaled to years
sma_plot_file("survival_asct.png", png,
list(main = "Kaplan-Meier estimate for\nsecMalASCT study",
sub = "Survival after transplantation"),
NULL,
plot, survfit(surv_asct ~ 1),
mark.time = TRUE,
xscale = 365.25,
xlab = "Years",
ylab = "Survival")
# plot survival after transplantation per sex
sma_plot_surv_asct_sex <- function() {
plot(survfit(surv_asct ~ sex, data = secmal), mark.time = TRUE,
xscale = 365.25, xlab = "Years", ylab = "Survival",
lty = 2:3)
title("Kaplan-Meier estimate for\nsecMalASCT study",
"Survival after transplantation")
legend(100, .9, c("Female", "Male"), lty = 2:3)
}
# One graph per sex
sma_plot_file("survival_asct_sex.png", png,
list(main = "Kaplan-Meier estimate for\nsecMalASCT study",
sub = "Survival after transplantation"),
list(100, .9, c("Female", "Male"), lty = 2:3),
plot, survfit(surv_asct ~ sex, data = secmal),
mark.time = TRUE,
xscale = 365.25,
xlab = "Years",
ylab = "Survival",
lty = 2:3)
#
# Write survival plots to files
#
sma_plot_file_surv <- function() {
sma_plot_file("survival_dx.png", png, sma_plot_surv_dx)
sma_plot_file("survival_dx_sex.png", png, sma_plot_surv_dx_sex)
sma_plot_file("survival_asct.png", png, sma_plot_surv_asct)
sma_plot_file("survival_asct_sex.png", png, sma_plot_surv_asct_sex)
}

11
utils.R
View File

@ -13,19 +13,12 @@ library(tidyverse)
# or NULL if not needed.
# Default filesize is 3000x3000 px and 300 dpi resolution.
#
sma_plot_file <- function(fname, ftype, title_list, legend_list, fun, ...) {
sma_plot_file <- function(fname, ftype, fun) {
# Open file for writing
ftype(filename = fname, width = 3000, height = 3000, res = 300)
# run "fun" with passed arguments
do.call(fun, list(...))
fun()
if (!is.null(title_list)) {
do.call(title, title_list)
}
if(!is.null(legend_list)) {
do.call(legend, legend_list)
}
# hide "null device 1" in garbage
garbage <- dev.off()
}