From f3c798e8fa99a86cb0500ce2736e9fabf70daf70 Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Fri, 3 Jan 2025 03:01:54 +0000 Subject: [PATCH] add p value for competing risk and change default setting for pval.testname and also display corresponding test names for p value --- DESCRIPTION | 6 +- NAMESPACE | 1 + NEWS.md | 5 + R/jskm.R | 279 ++++++++++++++++++++++++++++------------------------ jskm.Rproj | 1 - man/jskm.Rd | 2 +- 6 files changed, 162 insertions(+), 132 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8d12f8d..7ef58f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jskm Title: Kaplan-Meier Plot with 'ggplot2' -Version: 0.5.8 -Date: 2024-12-23 +Version: 0.5.9 +Date: 2025-01-03 Authors@R: c(person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), person("yoonkyoung", "Chun", email = "rachel200357@gmail.com", role = "aut"), person("Zarathu", role = c("cph", "fnd")) @@ -10,7 +10,7 @@ Description: The function 'jskm()' creates publication quality Kaplan-Meier plot Depends: R (>= 3.4.0) License: Apache License 2.0 Encoding: UTF-8 -Imports: ggplot2, ggpubr, survival, survey, scales, patchwork +Imports: ggplot2, ggpubr, survival, survey, scales, patchwork, cmprsk RoxygenNote: 7.3.2 URL: https://github.com/jinseob2kim/jskm, https://jinseob2kim.github.io/jskm/ BugReports: https://github.com/jinseob2kim/jstable/issues diff --git a/NAMESPACE b/NAMESPACE index 0aa1049..74f9cb2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(jskm) export(svyjskm) import(ggplot2) +importFrom(cmprsk,cuminc) importFrom(ggplot2,aes) importFrom(ggplot2,annotate) importFrom(ggplot2,element_blank) diff --git a/NEWS.md b/NEWS.md index a8e9938..eb35cd9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# jskm 0.5.9 + +* Update: Display p value for competing risk using Gray's test and also reorganize pval.testname option to display corresponding test names. + + # jskm 0.5.8 * Update: Add `table.censor` option to show censored number in `jskm`. diff --git a/R/jskm.R b/R/jskm.R index e6f2d4a..27d9976 100644 --- a/R/jskm.R +++ b/R/jskm.R @@ -82,6 +82,7 @@ #' @importFrom stats pchisq time as.formula #' @importFrom patchwork inset_element #' @importFrom survival survfit survdiff coxph Surv cluster frailty +#' @importFrom cmprsk cuminc #' @export @@ -100,7 +101,7 @@ jskm <- function(sfit, pval = FALSE, pval.size = 5, pval.coord = c(NULL, NULL), - pval.testname = F, + pval.testname = T, marks = TRUE, shape = 3, med = FALSE, @@ -129,9 +130,9 @@ jskm <- function(sfit, ################################# # sorting the use of subsetting # ################################# - - n.risk <- n.censor <- surv <- strata <- lower <- upper <- NULL - + + test_type<- n.risk <- n.censor <- surv <- strata <- lower <- upper <- NULL + times <- seq(0, max(sfit$time), by = timeby) if (!is.null(theme) && theme == "nejm") legendposition <- legendposition if (is.null(subs)) { @@ -163,13 +164,13 @@ jskm <- function(sfit, subs2 <- which(regexpr(ssvar, summary(sfit, censored = T)$strata, perl = T) != -1) subs3 <- which(regexpr(ssvar, summary(sfit, times = times, extend = TRUE)$strata, perl = T) != -1) } - - if (!is.null(subs) | !is.null(sfit$states)) pval <- FALSE - + + if ((!is.null(subs) | !is.null(sfit$states)) & is.null(status.cmprsk)) pval <- FALSE + ################################## # data manipulation pre-plotting # ################################## - + if (is.null(ylabs)) { if (cumhaz | !is.null(sfit$states)) { ylabs <- "Cumulative incidence" @@ -177,7 +178,7 @@ jskm <- function(sfit, ylabs <- "Survival probability" } } - + if (!is.null(status.cmprsk)) { if (length(levels(summary(sfit)$strata)) == 0) { # [subs1] @@ -215,16 +216,16 @@ jskm <- function(sfit, if (is.null(ystrataname)) ystrataname <- "Strata" m <- max(nchar(ystratalabs)) times <- seq(0, max(sfit$time), by = timeby) - + if (length(levels(summary(sfit)$strata)) == 0) { Factor <- factor(rep("All", length(subs2))) } else { Factor <- factor(summary(sfit, censored = T)$strata[subs2], levels = names(sfit$strata)) } - + # Data to be used in the survival plot - - + + if (is.null(sfit$state)) { # no cmprsk df <- data.frame( time = sfit$time[subs2], @@ -252,9 +253,12 @@ jskm <- function(sfit, lower = sfit$lower[, col.cmprsk][subs2] ) } - + form <- sfit$call$formula - + time_var <- all.vars(form[[2]])[1] + event_var <- all.vars(form[[2]])[2] + group_var <- all.vars(form)[3] + if (!is.null(cut.landmark)) { if (is.null(data)) { data <- tryCatch(eval(sfit$call$data), error = function(e) e) @@ -262,7 +266,7 @@ jskm <- function(sfit, stop("Landmark analysis requires data object. please input 'data' option") } } - + var.time <- as.character(form[[2]][[2]]) var.event <- as.character(form[[2]][[3]]) if (length(var.event) > 1) { @@ -274,23 +278,23 @@ jskm <- function(sfit, data1 <- data data1[[var.event]][data1[[var.time]] >= cut.landmark] <- 0 data1[[var.time]][data1[[var.time]] >= cut.landmark] <- cut.landmark - + sfit1 <- survfit(as.formula(form), data1) sfit2 <- survfit(as.formula(form), data[data[[var.time]] >= cut.landmark, ]) - + if (is.null(sfit$states)) { if (length(levels(Factor)) == 1) { df2 <- merge(subset(df, time >= cut.landmark)[, c("time", "n.risk", "n.event", "n.censor", "strata")], - data.frame(time = sfit2$time, surv = sfit2$surv, strata = "All", upper = sfit2$upper, lower = sfit2$lower), - by = c("time", "strata") + data.frame(time = sfit2$time, surv = sfit2$surv, strata = "All", upper = sfit2$upper, lower = sfit2$lower), + by = c("time", "strata") ) } else { df2 <- merge(subset(df, time >= cut.landmark)[, c("time", "n.risk", "n.event", "n.censor", "strata")], - data.frame(time = sfit2$time, surv = sfit2$surv, strata = rep(names(sfit2$strata), sfit2$strata), upper = sfit2$upper, lower = sfit2$lower), - by = c("time", "strata") + data.frame(time = sfit2$time, surv = sfit2$surv, strata = rep(names(sfit2$strata), sfit2$strata), upper = sfit2$upper, lower = sfit2$lower), + by = c("time", "strata") ) } - + df11 <- rbind(subset(df, time < cut.landmark), df2[, names(df)]) df <- rbind(df11, data.frame(time = cut.landmark, n.risk = summary(sfit, times = cut.landmark)$n.risk[[1]], n.event = 0, n.censor = 0, surv = 1, strata = levels(df$strata), upper = 1, lower = 1)) } else { @@ -298,24 +302,24 @@ jskm <- function(sfit, status.cmprsk <- sfit$states[2] } col.cmprsk <- which(sfit$state == status.cmprsk) - + if (length(levels(Factor)) == 1) { df2 <- merge(subset(df, time >= cut.landmark)[, c("time", "n.risk", "n.event", "n.censor", "strata")], - data.frame(time = sfit2$time, surv = sfit2$pstate[, col.cmprsk], strata = "All", upper = sfit2$upper[, col.cmprsk], lower = sfit2$lower[, col.cmprsk]), - by = c("time", "strata") + data.frame(time = sfit2$time, surv = sfit2$pstate[, col.cmprsk], strata = "All", upper = sfit2$upper[, col.cmprsk], lower = sfit2$lower[, col.cmprsk]), + by = c("time", "strata") ) } else { df2 <- merge(subset(df, time >= cut.landmark)[, c("time", "n.risk", "n.event", "n.censor", "strata")], - data.frame(time = sfit2$time, surv = sfit2$pstate[, col.cmprsk], strata = rep(names(sfit2$strata), sfit2$strata), upper = sfit2$upper[, col.cmprsk], lower = sfit2$lower[, col.cmprsk]), - by = c("time", "strata") + data.frame(time = sfit2$time, surv = sfit2$pstate[, col.cmprsk], strata = rep(names(sfit2$strata), sfit2$strata), upper = sfit2$upper[, col.cmprsk], lower = sfit2$lower[, col.cmprsk]), + by = c("time", "strata") ) } df11 <- rbind(subset(df, time < cut.landmark), df2[, names(df)]) df <- rbind(df11, data.frame(time = cut.landmark, n.risk = summary(sfit, times = cut.landmark)$n.risk[[1]], n.event = 0, n.censor = 0, surv = 0, strata = levels(df$strata), upper = 0, lower = 0)) } } - - + + if (cumhaz & is.null(sfit$states)) { upper.new <- 1 - df$lower lower.new <- 1 - df$upper @@ -323,7 +327,7 @@ jskm <- function(sfit, df$lower <- lower.new df$upper <- upper.new } - + # Final changes to data for survival plot levels(df$strata) <- ystratalabs zeros <- data.frame( @@ -336,37 +340,37 @@ jskm <- function(sfit, zeros$lower <- 0 zeros$upper <- 0 } - + df <- rbind(zeros, df) d <- length(levels(df$strata)) - + ################################### # specifying axis parameteres etc # ################################### - + if (dashed == TRUE | all(linecols == "black")) { linetype <- c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash", "1F", "F1", "4C88C488", "12345678") } else { linetype <- c("solid", "solid", "solid", "solid", "solid", "solid", "solid", "solid", "solid", "solid", "solid") } - + # Scale transformation # :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: surv.scale <- match.arg(surv.scale) scale_labels <- ggplot2::waiver() if (surv.scale == "percent") scale_labels <- scales::percent - + p <- ggplot2::ggplot(df, aes(x = time, y = surv, colour = strata, linetype = strata)) + ggtitle(main) - - + + linecols2 <- linecols if (all(linecols == "black")) { linecols <- "Set1" p <- ggplot2::ggplot(df, aes(x = time, y = surv, linetype = strata)) + ggtitle(main) } - + # Set up theme elements p <- p + theme_bw() + theme( @@ -383,17 +387,17 @@ jskm <- function(sfit, axis.line.y = element_line(linewidth = 0.5, linetype = "solid", colour = "black") ) + scale_x_continuous(xlabs, breaks = times, limits = xlims) - + if (!is.null(surv.by)) { p <- p + scale_y_continuous(ylabs, limits = ylims, labels = scale_labels, breaks = seq(ylims[1], ylims[2], by = surv.by)) } else { p <- p + scale_y_continuous(ylabs, limits = ylims, labels = scale_labels) } - - - - - + + + + + if (!is.null(theme) && theme == "jama") { p <- p + theme( panel.grid.major.x = element_blank() @@ -403,13 +407,13 @@ jskm <- function(sfit, panel.grid.major = element_blank() ) } - - + + # Removes the legend: if (legend == FALSE) { p <- p + guides(colour = "none", linetype = "none") } - + # Add lines too plot if (is.null(cut.landmark)) { if (med == T & is.null(status.cmprsk)) { @@ -430,13 +434,13 @@ jskm <- function(sfit, geom_step(data = subset(df, time >= cut.landmark), linewidth = linewidth) + geom_step(data = subset(df, time < cut.landmark), linewidth = linewidth) } } - + brewer.palette <- c( "BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu", "RdYlGn", "Spectral", "Accent", "Dark2", "Paired", "Pastel1", "Pastel2", "Set1", "Set2", "Set3", "Blues", "BuGn", "BuPu", "GnBu", "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn", "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu", "YlOrBr", "YlOrRd" ) - + if (!is.null(theme) && theme == "jama") { col.pal <- c("#00AFBB", "#E7B800", "#FC4E07") col.pal <- rep(col.pal, ceiling(length(ystratalabs) / 3)) @@ -446,8 +450,8 @@ jskm <- function(sfit, col.pal <- linecols col.pal <- rep(col.pal, ceiling(length(ystratalabs) / length(linecols))) } - - + + if (is.null(cut.landmark)) { if (med == T & is.null(status.cmprsk)) { if (is.null(col.pal)) { @@ -477,15 +481,15 @@ jskm <- function(sfit, } } } - + # Add censoring marks to the line: if (marks == TRUE) { p <- p + geom_point(data = subset(df, n.censor >= 1), aes(x = time, y = surv, colour = strata), shape = shape) } - + # Add median value - - + + if (med == TRUE & is.null(cut.landmark) & is.null(status.cmprsk)) { if (length(levels(summary(sfit)$strata)) == 0) { median_time <- summary(sfit)$table["median"][[1]] @@ -504,7 +508,7 @@ jskm <- function(sfit, } } } - + if (med == TRUE & !is.null(cut.landmark) & is.null(status.cmprsk)) { if (length(levels(summary(sfit)$strata)) == 0) { median_time <- summary(sfit1)$table[, "median"][[1]] @@ -528,9 +532,9 @@ jskm <- function(sfit, } } } - - - + + + # Add 95% CI to plot if (ci == TRUE) { if (med == FALSE | !is.null(status.cmprsk) | (!is.null(theme) && theme == "nejm")) { @@ -551,11 +555,11 @@ jskm <- function(sfit, } } } - - - - - + + + + + if (!is.null(cut.landmark)) { p <- p + geom_vline(xintercept = cut.landmark, lty = 2) } @@ -590,8 +594,8 @@ jskm <- function(sfit, } } } - - + + ## Create a blank plot for place-holding blank.pic <- ggplot(df, aes(time, surv)) + geom_blank() + @@ -602,14 +606,13 @@ jskm <- function(sfit, axis.ticks = element_blank(), panel.grid.major = element_blank(), panel.border = element_blank() ) - + ##################### # p-value placement # ##################### a - if (length(levels(summary(sfit)$strata)) == 0) pval <- F # if(!is.null(cut.landmark)) pval <- F - + if (pval == TRUE) { if (is.null(data)) { data <- tryCatch(eval(sfit$call$data), error = function(e) e) @@ -617,27 +620,36 @@ jskm <- function(sfit, stop("'pval' option requires data object. please input 'data' option") } } - if (is.null(cut.landmark)) { - sdiff <- survival::survdiff(as.formula(form), data = data) - pvalue <- pchisq(sdiff$chisq, length(sdiff$n) - 1, lower.tail = FALSE) - - ## cluster option - if (cluster.option == "cluster" & !is.null(cluster.var)) { - form.old <- as.character(form) - form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + cluster(", cluster.var, ")", sep = "") - sdiff <- survival::coxph(as.formula(form.new), data = data, model = T, robust = T) - pvalue <- summary(sdiff)$robscore["pvalue"] - } else if (cluster.option == "frailty" & !is.null(cluster.var)) { - form.old <- as.character(form) - form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + frailty(", cluster.var, ")", sep = "") - sdiff <- survival::coxph(as.formula(form.new), data = data, model = T) - pvalue <- summary(sdiff)$logtest["pvalue"] + if (!is.null(status.cmprsk)){ + ci_obj <- cmprsk::cuminc(ftime = data[[time_var]],fstatus = data[[event_var]],group = data[[group_var]]) + pvalue<- ci_obj$Tests[, "pv"][2] + test_type <- "Gray's Test" + } + else{ + sdiff <- survival::survdiff(as.formula(form), data = data) + pvalue <- pchisq(sdiff$chisq, length(sdiff$n) - 1, lower.tail = FALSE) + test_type <- "Log-rank Test" + ## cluster option + if (cluster.option == "cluster" & !is.null(cluster.var)) { + form.old <- as.character(form) + form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + cluster(", cluster.var, ")", sep = "") + sdiff <- survival::coxph(as.formula(form.new), data = data, model = T, robust = T) + pvalue <- summary(sdiff)$robscore["pvalue"] + test_type <- "Cox (Cluster Robust)" + } else if (cluster.option == "frailty" & !is.null(cluster.var)) { + form.old <- as.character(form) + form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + frailty(", cluster.var, ")", sep = "") + sdiff <- survival::coxph(as.formula(form.new), data = data, model = T) + pvalue <- summary(sdiff)$logtest["pvalue"] + test_type <- "Cox (Frailty)" + } } - pvaltxt <- ifelse(pvalue < 0.001, "p < 0.001", paste("p =", round(pvalue, 3))) - if (pval.testname) pvaltxt <- paste0(pvaltxt, " (Log-rank)") - + if (pval.testname & !is.null(test_type)) { + pvaltxt <- paste0(pvaltxt, " (", test_type, ")") + } + # MOVE P-VALUE LEGEND HERE BELOW [set x and y] if (is.null(pval.coord)) { p <- p + annotate("text", x = (as.integer(max(sfit$time) / 5)), y = 0.1 + ylims[1], label = pvaltxt, size = pval.size) @@ -645,35 +657,49 @@ jskm <- function(sfit, p <- p + annotate("text", x = pval.coord[1], y = pval.coord[2], label = pvaltxt, size = pval.size) } } else { - sdiff1 <- survival::survdiff(as.formula(form), data1) - sdiff2 <- survival::survdiff(as.formula(form), data[data[[var.time]] >= cut.landmark, ]) - pvalue <- sapply(list(sdiff1, sdiff2), function(x) { - pchisq(x$chisq, length(x$n) - 1, lower.tail = FALSE) - }) - - ## cluster option - if (cluster.option == "cluster" & !is.null(cluster.var)) { - form.old <- as.character(form) - form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], sep = "") - sdiff1 <- survival::coxph(as.formula(form.new), data = data1, model = T, cluster = get(cluster.var)) - sdiff2 <- survival::coxph(as.formula(form.new), data = data[data[[var.time]] >= cut.landmark, ], model = T, cluster = get(cluster.var)) - pvalue <- sapply(list(sdiff1, sdiff2), function(x) { - summary(x)$robscore["pvalue"] - }) - } else if (cluster.option == "frailty" & !is.null(cluster.var)) { - form.old <- as.character(form) - form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + frailty(", cluster.var, ")", sep = "") - sdiff1 <- survival::coxph(as.formula(form.new), data = data1, model = T) - sdiff2 <- survival::coxph(as.formula(form.new), data = data[data[[var.time]] >= cut.landmark, ], model = T) + if (!is.null(status.cmprsk)){ + ci_obj1 <- cmprsk::cuminc(ftime = data1[[time_var]],fstatus = data1[[event_var]],group = data1[[group_var]]) + data2<-data[data[[var.time]] >= cut.landmark, ] + ci_obj2<- cmprsk::cuminc(ftime = data2[[time_var]],fstatus = data2[[event_var]],group = data2[[group_var]]) + pvalue1 <- ci_obj1$Tests[, "pv"][2] + pvalue2 <- ci_obj2$Tests[, "pv"][2] + pvalue <- c(pvalue1, pvalue2) + test_type <- "Gray's Test" + } + else{ + sdiff1 <- survival::survdiff(as.formula(form), data1) + sdiff2 <- survival::survdiff(as.formula(form), data[data[[var.time]] >= cut.landmark, ]) pvalue <- sapply(list(sdiff1, sdiff2), function(x) { - summary(x)$logtest["pvalue"] + pchisq(x$chisq, length(x$n) - 1, lower.tail = FALSE) }) + test_type <-"Log-rank Test" + ## cluster option + if (cluster.option == "cluster" & !is.null(cluster.var)) { + form.old <- as.character(form) + form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], sep = "") + sdiff1 <- survival::coxph(as.formula(form.new), data = data1, model = T, cluster = get(cluster.var)) + sdiff2 <- survival::coxph(as.formula(form.new), data = data[data[[var.time]] >= cut.landmark, ], model = T, cluster = get(cluster.var)) + pvalue <- sapply(list(sdiff1, sdiff2), function(x) { + summary(x)$robscore["pvalue"] + }) + test_type <- "Cox (Cluster Robust)" + } else if (cluster.option == "frailty" & !is.null(cluster.var)) { + form.old <- as.character(form) + form.new <- paste(form.old[2], form.old[1], " + ", form.old[3], " + frailty(", cluster.var, ")", sep = "") + sdiff1 <- survival::coxph(as.formula(form.new), data = data1, model = T) + sdiff2 <- survival::coxph(as.formula(form.new), data = data[data[[var.time]] >= cut.landmark, ], model = T) + pvalue <- sapply(list(sdiff1, sdiff2), function(x) { + summary(x)$logtest["pvalue"] + }) + test_type <- "Cox (Frailty)" + } } - pvaltxt <- ifelse(pvalue < 0.001, "p < 0.001", paste("p =", round(pvalue, 3))) - - if (pval.testname) pvaltxt <- paste0(pvaltxt, " (Log-rank)") - + + if (pval.testname & !is.null(test_type)) { + pvaltxt <- paste0(pvaltxt, " (", test_type, ")") + } + if (is.null(pval.coord)) { p <- p + annotate("text", x = c(as.integer(max(sfit$time) / 10), as.integer(max(sfit$time) / 10) + cut.landmark), y = 0.1 + ylims[1], label = pvaltxt, size = pval.size) } else { @@ -681,18 +707,18 @@ jskm <- function(sfit, } } } - + ################################################### # Create table graphic to include at-risk numbers # ################################################### - + n.risk <- NULL if (length(levels(summary(sfit)$strata)) == 0) { Factor <- factor(rep("All", length(subs3))) } else { Factor <- factor(summary(sfit, times = times, extend = TRUE)$strata[subs3]) } - + if (table == TRUE) { risk.data <- data.frame( strata = Factor, @@ -709,9 +735,8 @@ jskm <- function(sfit, risk.data$n.risk <- paste0(risk.data$n.risk, " (", risk.data$n.censor, ")") risk.data$n.censor <- NULL } - print(risk.data) risk.data$strata <- factor(risk.data$strata, levels = rev(levels(risk.data$strata))) - + data.table <- ggplot(risk.data, aes(x = time, y = strata, label = format(n.risk, nsmall = 0))) + geom_text(size = 3.5) + theme_bw() + @@ -728,18 +753,18 @@ jskm <- function(sfit, ) data.table <- data.table + guides(colour = "none", linetype = "none") + xlab(NULL) + ylab(NULL) - - + + # ADJUST POSITION OF TABLE FOR AT RISK data.table <- data.table + theme(plot.margin = unit(c(-1.5, 1, 0.1, ifelse(m < 10, 3.1, 4.3) - 0.38 * m), "lines")) } - - + + ####################### # Plotting the graphs # ####################### - + if (!is.null(theme) && theme == "nejm") { p2 <- p1 + coord_cartesian(ylim = nejm.infigure.ylim) + theme( axis.title.x = element_blank(), axis.title.y = element_blank(), @@ -747,12 +772,12 @@ jskm <- function(sfit, ) + guides(colour = "none", linetype = "none") + scale_y_continuous(limits = nejm.infigure.ylim, breaks = waiver(), labels = scale_labels) p <- p + patchwork::inset_element(p2, 1 - nejm.infigure.ratiow, 1 - nejm.infigure.ratioh, 1, 1, align_to = "panel") } - + if (table == TRUE) { ggpubr::ggarrange(p, blank.pic, data.table, - nrow = 3, - # align = "v", - heights = c(2, .1, .25) + nrow = 3, + # align = "v", + heights = c(2, .1, .25) ) } else { p diff --git a/jskm.Rproj b/jskm.Rproj index 597ad9d..1788e68 100644 --- a/jskm.Rproj +++ b/jskm.Rproj @@ -1,5 +1,4 @@ Version: 1.0 -ProjectId: 82f88801-dd54-4ff2-afb1-928b0ff5a081 RestoreWorkspace: Default SaveWorkspace: Default diff --git a/man/jskm.Rd b/man/jskm.Rd index 9554ab0..11b8dd6 100644 --- a/man/jskm.Rd +++ b/man/jskm.Rd @@ -20,7 +20,7 @@ jskm( pval = FALSE, pval.size = 5, pval.coord = c(NULL, NULL), - pval.testname = F, + pval.testname = T, marks = TRUE, shape = 3, med = FALSE,