From bbebf0228fb552bb589980ab47e91e387da9cbfd Mon Sep 17 00:00:00 2001 From: FBartos Date: Sun, 14 Apr 2024 15:32:31 +0200 Subject: [PATCH 01/24] add parameter name recoding --- R/commonsurvivalanalysis.R | 26 ++++++++++++++++++++++++++ R/semiparametricsurvivalanalysis.R | 17 +++++++++-------- inst/Description.qml | 6 +++--- 3 files changed, 38 insertions(+), 11 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 7961dd9..2678be5 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -197,3 +197,29 @@ return(unique(timeSteps)) } +.saTermNames <- function(varName, variables) { + # based on jaspMixedModels::.mmVariableNames + + if (varName == "(Intercept)") + return("Intercept") + + for (vn in variables) { + inf <- regexpr(vn, varName, fixed = TRUE) + + if (inf[1] != -1) { + varName <- paste0( + substr(varName, 0, inf[1] - 1), + substr(varName, inf[1], inf[1] + attr(inf, "match.length") - 1), + " (", + substr(varName, inf[1] + attr(inf, "match.length"), nchar(varName)) + ) + } + + } + + varName <- gsub(":", paste0(")", jaspBase::interactionSymbol), varName, fixed = TRUE) + varName <- paste0(varName, ")") + varName <- gsub(" ()", "", varName, fixed = TRUE) + + return(varName) +} diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 83a79ca..89b531c 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -167,18 +167,19 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesTable$addFootnote(gettextf("Null model contains nuisance parameters: %s", paste(nullPredictors, collapse = ", "))) estimates <- NULL } else - estimates <- .saspCoxFitSummary(fitNull, "H\u2080") + estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080") if (jaspBase::isTryError(fit)) { estimatesTable$setError(fit, symbol = gettextf("The model failed with the following message:")) return() } else - estimates <- rbind(estimates, .saspCoxFitSummary(fit, "H\u2081")) + estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081")) if (!is.null(estimates) && options[["vovkSellke"]]) estimates$vsmpr <- VovkSellkeMPR(estimates$pval) + estimatesTable$setData(estimates) return() @@ -212,13 +213,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state hazardRatioTable$addFootnote(gettextf("Null model contains nuisance parameters: %s", paste(nullPredictors, collapse = ", "))) estimates <- NULL } else - estimates <- .saspCoxFitSummary(fitNull, "H\u2080", HR = TRUE, CI = options[["coefficientCiLevel"]]) + estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080", HR = TRUE, CI = options[["coefficientCiLevel"]]) if (jaspBase::isTryError(fit)) { hazardRatioTable$setError(fit, symbol = gettextf("The model failed with the following message:")) return() } else - estimates <- rbind(estimates, .saspCoxFitSummary(fit, "H\u2081", HR = TRUE, CI = options[["coefficientCiLevel"]])) + estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE, CI = options[["coefficientCiLevel"]])) if (!is.null(estimates) && options[["vovkSellke"]]) @@ -230,16 +231,16 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state } -.saspCoxFitSummary <- function(fit, model, HR = FALSE, CI = 0.95) { +.saspCoxFitSummary <- function(fit, options, model, HR = FALSE, CI = 0.95) { if (HR) estimatesFit <- summary(fit, conf.int = CI)$conf.int[,-2,drop=FALSE] else estimatesFit <- summary(fit)$coefficients[,c("coef", "se(coef)", "z", "Pr(>|z|)"),drop=FALSE] - if (is.null(estimatesFit)) { + if (is.null(estimatesFit)) return() - }else if (is.null(dim(estimatesFit))) + else if (is.null(dim(estimatesFit))) estimatesFit <- data.frame(t(estimatesFit)) else estimatesFit <- data.frame(estimatesFit) @@ -251,7 +252,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesFit <- cbind( "model" = "", - "param" = rownames(estimatesFit), + "param" = sapply(rownames(estimatesFit), function(x) .saTermNames(x, c(options[["covariates"]], options[["factors"]]))), estimatesFit) estimatesFit[1, "model"] <- model diff --git a/inst/Description.qml b/inst/Description.qml index 1fbbde2..364f9a6 100644 --- a/inst/Description.qml +++ b/inst/Description.qml @@ -27,15 +27,15 @@ Description func: "NonParametricSurvivalAnalysis" requiresData: true } -/* + Analysis { menu: qsTr("Semi-parametric") title: qsTr("Semi-parametric Survival Analysis") func: "SemiParametricSurvivalAnalysis" - requiresData: true + requiresData: true } - +/* Analysis { menu: qsTr("Parametric") From 96a4f733fac0d9c429807aa63682c511208ac575 Mon Sep 17 00:00:00 2001 From: FBartos Date: Thu, 5 Sep 2024 11:49:11 +0200 Subject: [PATCH 02/24] add basics of semiparametric model add basics of semiparametric model --- R/commonsurvivalanalysis.R | 36 ++-- R/semiparametricsurvivalanalysis.R | 208 ++++++++++++++++---- inst/qml/SemiParametricSurvivalAnalysis.qml | 154 +++++++++------ 3 files changed, 267 insertions(+), 131 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 2678be5..677ae1e 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -14,7 +14,7 @@ ready <- switch( options[["censoringType"]], - "interval" = options[["eventStatus"]] != "" && options[["intervalStart"]] != "" && options[["intervalEnd"]] != "", + "counting" = options[["eventStatus"]] != "" && options[["intervalStart"]] != "" && options[["intervalEnd"]] != "", "right" = options[["eventStatus"]] != "" && options[["timeToEvent"]] != "" ) @@ -29,7 +29,7 @@ eventVariable <- options[["eventStatus"]] timeVariable <- switch( options[["censoringType"]], - "interval" = c(options[["intervalStart"]], options[["intervalEnd"]]), + "counting" = c(options[["intervalStart"]], options[["intervalEnd"]]), "right" = options[["timeToEvent"]] ) @@ -56,7 +56,7 @@ ) # check that interval start < end - if (options[["censoringType"]] == "interval") { + if (options[["censoringType"]] == "counting") { if (any(dataset[[options[["intervalStart"]]]] > dataset[[options[["intervalEnd"]]]])) .quitAnalysis(gettextf("The end time must be larger than start time.")) } @@ -85,25 +85,11 @@ if (options[["censoringType"]] == "right") { - # 0 = right censored, 1 = event at time - event <- as.numeric(dataset[[options[["eventStatus"]]]] == options[["eventIndicator"]]) + event <- dataset[[options[["eventStatus"]]]] == options[["eventIndicator"]] - } else if (options[["censoringType"]] == "interval") { + } else if (options[["censoringType"]] == "counting") { - if (anyDuplicated(c( - options[["rightCensored"]], - options[["eventIndicator"]], - options[["leftCensored"]], - options[["intervalCensored"]] - ))) - .quitAnalysis(gettextf("Duplicated level mapping for interval censoring.")) - - # 0 = right censored, 1 = event at time, 2 = left censored, 3 = interval censored - event <- rep(NA, nrow(dataset)) - event[dataset[[options[["eventStatus"]]]] == options[["rightCensored"]]] <- 0 - event[dataset[[options[["eventStatus"]]]] == options[["eventIndicator"]]] <- 1 - event[dataset[[options[["eventStatus"]]]] == options[["leftCensored"]]] <- 2 - event[dataset[[options[["eventStatus"]]]] == options[["intervalCensored"]]] <- 3 + event <- dataset[[options[["eventStatus"]]]] == options[["eventIndicator"]] } @@ -112,17 +98,19 @@ .saGetSurv <- function(options) { return(switch( options[["censoringType"]], - "interval" = sprintf("survival::Surv( + "counting" = sprintf("survival::Surv( time = %1$s, time2 = %2$s, - event = %3$s)", + event = %3$s, + type = 'counting')", options[["intervalStart"]], options[["intervalEnd"]], options[["eventStatus"]] ), "right" = sprintf("survival::Surv( time = %1$s, - event = %2$s)", + event = %2$s, + type = 'right')", options[["timeToEvent"]], options[["eventStatus"]] ) @@ -142,7 +130,7 @@ survival <- .saGetSurv(options) - if (length(predictors) == 0 && interceptTerm == FALSE) + if (length(predictors) == 0 && !interceptTerm) stop(gettext("We need at least one predictor, or an intercept to make a formula")) if (length(predictors) == 0) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 89b531c..36e4253 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -17,27 +17,36 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = NULL) { - # semi-parametric allows only for right censored data -- set the options for generic functions downstream - options[["censoringType"]] <- "right" - if (.saSurvivalReady(options)) dataset <- .saReadDataset(dataset, options) - if (.saSurvivalReady(options)) { + saveRDS(options, file = "C:/JASP/options.RDS") + saveRDS(dataset, file = "C:/JASP/dataset.RDS") + + if (.saSurvivalReady(options)) .saspFitCox(jaspResults, dataset, options) - } + + saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") .saspSummaryTable(jaspResults, dataset, options) - .saspEstimatesTable(jaspResults, dataset, options) - .saspHazardRatioTable(jaspResults, dataset, options) + .saspTestsTable(jaspResults, dataset, options) + + if (options[["modelFit"]]) + .saspModelFitTable(jaspResults, dataset, options) + + if (options[["coefficientEstimate"]]) + .saspEstimatesTable(jaspResults, dataset, options) + + if (options[["coefficientHazardRatioEstimates"]]) + .saspHazardRatioTable(jaspResults, dataset, options) return() } -.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", "modelTerms") +.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", "modelTerms", "method") -.saspFitCox <- function(jaspResults, dataset, options) { +.saspFitCox <- function(jaspResults, dataset, options) { if (is.null(jaspResults[["fit"]])) { @@ -47,7 +56,8 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fit <- try(survival::coxph( formula = .saGetFormula(options, type = "Cox", null = FALSE), - data = dataset + data = dataset, + method = options[["method"]] )) # fix scoping in ggsurvplot fit$call$formula <- eval(fit$call$formula) @@ -63,7 +73,8 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitNull <- try(survival::coxph( formula = .saGetFormula(options, type = "Cox", null = TRUE), - data = dataset + data = dataset, + method = options[["method"]] )) # fix scoping in ggsurvplot fitNull$call$formula <- eval(fitNull$call$formula) @@ -73,7 +84,64 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } -.saspSummaryTable <- function(jaspResults, dataset, options) { +.saspTestsTable <- function(jaspResults, dataset, options) { + + if (!is.null(jaspResults[["testsTable"]])) + return() + + if (!(options[["testsLikelihoodRatio"]] || options[["testsWald"]] || options[["testsScore"]])) + return() + + testsTable <- createJaspTable(title = gettext("Model Tests Table")) + testsTable$dependOn(c(.saspDependencies, "testsLikelihoodRatio", "testsWald", "testsScore")) + testsTable$position <- 2 + jaspResults[["testsTable"]] <- testsTable + + testsTable$addColumnInfo(name = "test", title = gettext("Test"), type = "string") + testsTable$addColumnInfo(name = "chiSqr", title = gettext("Chi Square"), type = "number") + testsTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") + testsTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") + + if (length(options[["factors"]]) == 0 && length(options[["covariates"]]) == 0) { + testsTable$addFootnote(gettext("At least one factor or covariate needs to be specified")) + return() + } + + fit <- jaspResults[["fit"]][["object"]] + fitSummary <- summary(fit) + + if (options[["testsLikelihoodRatio"]]) { + testsTable$addRows(list( + "test" = gettext("Likelihood ratio"), + "chiSqr" = fitSummary[["logtest"]][["test"]], + "df" = fitSummary[["logtest"]][["df"]], + "p" = fitSummary[["logtest"]][["pvalue"]] + )) + } + + if (options[["testsWald"]]) { + testsTable$addRows(list( + "test" = gettext("Wald"), + "chiSqr" = fitSummary[["waldtest"]][["test"]], + "df" = fitSummary[["waldtest"]][["df"]], + "p" = fitSummary[["waldtest"]][["pvalue"]] + )) + } + + if (options[["testsScore"]]) { + testsTable$addRows(list( + "test" = gettext("Score"), + "chiSqr" = fitSummary[["sctest"]][["test"]], + "df" = fitSummary[["sctest"]][["df"]], + "p" = fitSummary[["sctest"]][["pvalue"]] + )) + } + + testsTable$addFootnote(gettext("Test are based on the H\u2081 model.")) + + return() +} +.saspSummaryTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["summaryTable"]])) return() @@ -85,9 +153,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state # create empty table summaryTable$addColumnInfo(name = "mod", title = gettext("Model"), type = "string") - summaryTable$addColumnInfo(name = "loglik", title = gettext("log Lik."), type = "number") + summaryTable$addColumnInfo(name = "loglik", title = gettext("Log Lik."), type = "number") summaryTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") - summaryTable$addColumnInfo(name = "pvl", title = gettext("p"), type = "pvalue") +# summaryTable$addColumnInfo(name = "pvl", title = gettext("p"), type = "pvalue") summaryTable$addColumnInfo(name = "aic", title = gettext("AIC"), type = "number", format="dp:3") summaryTable$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number", format="dp:3") @@ -104,7 +172,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "mod" = "H\u2080", "loglik" = as.numeric(logLik(fitNull)), "df" = attr(logLik(fitNull), "df"), - "pvl" = pchisq(2 * (fitNull$loglik[2] - fitNull$loglik[1]), df = attr(logLik(fitNull), "df"), lower.tail = FALSE), +# "pvl" = pchisq(2 * (fitNull$loglik[2] - fitNull$loglik[1]), df = attr(logLik(fitNull), "df"), lower.tail = FALSE), "aic" = AIC(fitNull), "bic" = BIC(fitNull) )) @@ -116,11 +184,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "mod" = "H\u2081", "loglik" = as.numeric(logLik(fit)), "df" = attr(logLik(fit), "df"), - "pvl" = pchisq(2 * (fit$loglik[2] - fit$loglik[1]), df = attr(logLik(fit), "df"), lower.tail = FALSE), +# "pvl" = pchisq(2 * (fit$loglik[2] - fit$loglik[1]), df = attr(logLik(fit), "df"), lower.tail = FALSE), "aic" = AIC(fit), "bic" = BIC(fit) )) + summaryTable$addFootnote(gettextf("%1$i observations with %2$i events.", fit[["n"]], fit[["nevent"]])) + if (!is.null(attr(dataset, "na.action"))) summaryTable$addFootnote(gettextf("%1$i observations ommited due to missing values.", length(attr(dataset, "na.action")))) @@ -130,14 +200,55 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } -.saspEstimatesTable <- function(jaspResults, dataset, options) { +.saspModelFitTable <- function(jaspResults, dataset, options) { + + if (!is.null(jaspResults[["modelFitTable"]])) + return() + + modelFitTable <- createJaspTable(title = gettext("Model Fit Summary Table")) + modelFitTable$dependOn(c(.saspDependencies, "modelFit")) + modelFitTable$position <- 3 + jaspResults[["modelFitTable"]] <- modelFitTable + + # create empty table + modelFitTable$addColumnInfo(name = "mod", title = gettext("Model"), type = "string") + modelFitTable$addColumnInfo(name = "concordanceEstimate", title = gettext("Estimate"), type = "number", overtitle = gettext("Concordance")) + modelFitTable$addColumnInfo(name = "concordanceSe", title = gettext("Standard Error"), type = "number", overtitle = gettext("Concordance")) + + if (!.saSurvivalReady(options)) + return() + + fit <- jaspResults[["fit"]][["object"]] + fitNull <- jaspResults[["fitNull"]][["object"]] + + if (jaspBase::isTryError(fitNull)) + modelFitTable$addFootnote(fitNull, symbol = gettextf("The null model failed with the following message:")) + else + modelFitTable$addRows(list( + "mod" = "H\u2080", + "concordanceEstimate" = fitNull[["concordance"]][["concordance"]], + "concordanceSe" = fitNull[["concordance"]][["std"]] + )) + + if (jaspBase::isTryError(fit)) + modelFitTable$setError(fit, symbol = gettextf("The model failed with the following message:")) + else + modelFitTable$addRows(list( + "mod" = "H\u2081", + "concordanceEstimate" = fit[["concordance"]][["concordance"]], + "concordanceSe" = fit[["concordance"]][["std"]] + )) + + return() +} +.saspEstimatesTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["estimatesTable"]])) return() estimatesTable <- createJaspTable(title = gettext("Cox Proportional Hazards Estimates Table")) - estimatesTable$dependOn(c(.saspDependencies, "coefficientEstimate", "vovkSellke")) - estimatesTable$position <- 2 + estimatesTable$dependOn(c(.saspDependencies, "coefficientEstimate", "vovkSellke", "coefficientsConfidenceIntervals", "coefficientsConfidenceIntervalsLevel")) + estimatesTable$position <- 4 jaspResults[["estimatesTable"]] <- estimatesTable # create empty table @@ -145,6 +256,11 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesTable$addColumnInfo(name = "param", title = "", type = "string") estimatesTable$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number") estimatesTable$addColumnInfo(name = "se", title = gettext("Standard Error"), type = "number") + if (options[["coefficientsConfidenceIntervals"]]) { + overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientsConfidenceIntervalsLevel"]]) + estimatesTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overtitle) + estimatesTable$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = overtitle) + } estimatesTable$addColumnInfo(name = "zval", title = gettext("z"), type = "number") estimatesTable$addColumnInfo(name = "pval", title = gettext("p"), type = "pvalue") @@ -184,23 +300,25 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } -.saspHazardRatioTable <- function(jaspResults, dataset, options) { +.saspHazardRatioTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["hazardRatioTable"]])) return() hazardRatioTable <- createJaspTable(title = gettext("Hazard Ratios Estimates Table")) - hazardRatioTable$dependOn(c(.saspDependencies, "coefficientHazardRatioEstimates", "coefficientCiLevel")) - hazardRatioTable$position <- 3 + hazardRatioTable$dependOn(c(.saspDependencies, "coefficientHazardRatioEstimates", "coefficientsConfidenceIntervals", "coefficientsConfidenceIntervalsLevel")) + hazardRatioTable$position <- 5 jaspResults[["hazardRatioTable"]] <- hazardRatioTable # create empty table - overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientCiLevel"]]) hazardRatioTable$addColumnInfo(name = "model", title = gettext("Model"), type = "string") hazardRatioTable$addColumnInfo(name = "param", title = "", type = "string") hazardRatioTable$addColumnInfo(name = "est", title = gettext("Hazard Ratio"), type = "number") - hazardRatioTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overtitle) - hazardRatioTable$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = overtitle) + if (options[["coefficientsConfidenceIntervals"]]) { + overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientsConfidenceIntervalsLevel"]]) + hazardRatioTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overtitle) + hazardRatioTable$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = overtitle) + } if (!.saSurvivalReady(options)) return() @@ -213,13 +331,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state hazardRatioTable$addFootnote(gettextf("Null model contains nuisance parameters: %s", paste(nullPredictors, collapse = ", "))) estimates <- NULL } else - estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080", HR = TRUE, CI = options[["coefficientCiLevel"]]) + estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080", HR = TRUE) if (jaspBase::isTryError(fit)) { hazardRatioTable$setError(fit, symbol = gettextf("The model failed with the following message:")) return() } else - estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE, CI = options[["coefficientCiLevel"]])) + estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE)) if (!is.null(estimates) && options[["vovkSellke"]]) @@ -231,24 +349,30 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state } -.saspCoxFitSummary <- function(fit, options, model, HR = FALSE, CI = 0.95) { +.saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { - if (HR) - estimatesFit <- summary(fit, conf.int = CI)$conf.int[,-2,drop=FALSE] - else - estimatesFit <- summary(fit)$coefficients[,c("coef", "se(coef)", "z", "Pr(>|z|)"),drop=FALSE] + # extract coefficients + estimatesFit <- summary(fit)$coefficients[,c("coef", "se(coef)", "z", "Pr(>|z|)"), drop = FALSE] - if (is.null(estimatesFit)) - return() - else if (is.null(dim(estimatesFit))) - estimatesFit <- data.frame(t(estimatesFit)) - else - estimatesFit <- data.frame(estimatesFit) + # make into a data.frame + if (is.null(estimatesFit)) return() + else if (is.null(dim(estimatesFit))) estimatesFit <- data.frame(t(estimatesFit)) + else estimatesFit <- data.frame(estimatesFit) - if (HR) - colnames(estimatesFit) <- c("est", "lower", "upper") - else - colnames(estimatesFit) <- c("est", "se", "zval", "pval") + # fix column names + colnames(estimatesFit) <- c("est", "se", "zval", "pval") + + # add confidence intervals + if (options[["coefficientsConfidenceIntervals"]]) { + estimatesFit$lower <- estimatesFit$est + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit$se + estimatesFit$upper <- estimatesFit$est - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit$se + } + + # transform to HR if needed + if (HR) { + estimatesFit <- estimatesFit[,!colnames(estimatesFit) %in% c("se", "zval", "pval"), drop = FALSE] + estimatesFit <- exp(estimatesFit) + } estimatesFit <- cbind( "model" = "", diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 3d6d1dc..8e3584c 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -25,53 +25,31 @@ Form { VariablesForm { + removeInvisibles: true + AvailableVariablesList { name: "allVariablesList" } - RadioButtonGroup - { - id: censoringType - Layout.columnSpan: 2 - name: "censoringType" - title: qsTr("Censoring Type") - radioButtonsOnSameRow: true - columns: 2 - - RadioButton - { - label: qsTr("Right") - value: "right" - id: censoringTypeRight - } - - RadioButton - { - label: qsTr("Interval") - value: "interval" - id: censoringTypeInterval - } - } -/* AssignedVariablesList { name: "intervalStart" title: qsTr("Interval Start") allowedColumns: ["scale"] singleVariable: true - visible: censoringTypeInterval.checked + visible: censoringTypeCounting.checked } AssignedVariablesList { name: "intervalEnd" - title: qsTr("intervalEnd") + title: qsTr("Interval End") allowedColumns: ["scale"] singleVariable: true - visible: censoringTypeInterval.checked + visible: censoringTypeCounting.checked } -*/ + AssignedVariablesList { name: "timeToEvent" @@ -83,43 +61,21 @@ Form AssignedVariablesList { + id: eventStatusId name: "eventStatus" title: qsTr("Event Status") allowedColumns: ["nominal"] singleVariable: true } -/* - DropDown - { - name: "rightCensored" - label: qsTr("Right Censored") - source: [{name: "eventStatus", use: "levels"}] - visible: censoringTypeInterval.checked - } -*/ + DropDown { name: "eventIndicator" label: qsTr("Event Indicator") source: [{name: "eventStatus", use: "levels"}] - } -/* - DropDown - { - name: "leftCensored" - label: qsTr("Left Censored") - source: [{name: "eventStatus", use: "levels"}] - visible: censoringTypeInterval.checked + onCountChanged: currentIndex = 1 } - DropDown - { - name: "intervalCensored" - label: qsTr("Interval Censored") - source: [{name: "eventStatus", use: "levels"}] - visible: censoringTypeInterval.checked - } -*/ AssignedVariablesList { name: "covariates" @@ -135,6 +91,43 @@ Form } } + DropDown + { + name: "method" + label: qsTr("Method") + values: + [ + { label: qsTr("Efron"), value: "efron"}, + { label: qsTr("Breslow"), value: "breslow"}, + { label: qsTr("Exact"), value: "exact"} + ] + } + + RadioButtonGroup + { + id: censoringType + Layout.columnSpan: 1 + name: "censoringType" + title: qsTr("Censoring Type") + radioButtonsOnSameRow: true + columns: 2 + + RadioButton + { + label: qsTr("Right") + value: "right" + id: censoringTypeRight + checked: true + } + + RadioButton + { + label: qsTr("Counting") + value: "counting" + id: censoringTypeCounting + } + } + Section { title: qsTr("Model") @@ -156,19 +149,45 @@ Form width: parent.width * 5 / 9 } } - - CheckBox - { - name: "interceptTerm" - label: qsTr("Include intercept") - checked: true - } } Section { title: qsTr("Statistics") + Group + { + + CheckBox + { + name: "modelFit" + label: qsTr("Model fit") + } + + Group + { + title: qsTr("Tests") + + CheckBox + { + name: "testsLikelihoodRatio" + label: qsTr("Likelihood ratio") + } + + CheckBox + { + name: "testsWald" + label: qsTr("Wald") + } + + CheckBox + { + name: "testsScore" + label: qsTr("Score (log-rank)") + } + } + } + Group { title: qsTr("Coefficients") @@ -195,16 +214,21 @@ Form name: "coefficientHazardRatioEstimates" label: qsTr("Hazard ratio estimates") checked: true + } + CheckBox + { + name: "coefficientsConfidenceIntervals" + label: qsTr("Confidence intervals") + checked: true + childrenOnSameRow: true + CIField { - name: "coefficientCiLevel" - label: qsTr("Confidence intervals") + name: "coefficientsConfidenceIntervalsLevel" } - } - + } } } - } } From 61f2b94710bbee9beb5305deb7b647b06ac5c642 Mon Sep 17 00:00:00 2001 From: FBartos Date: Tue, 24 Sep 2024 17:52:04 +0200 Subject: [PATCH 03/24] update plot menu --- R/nonparametricsurvivalanalysis.R | 143 +++++---------------- inst/qml/NonParametricSurvivalAnalysis.qml | 77 +++++++---- 2 files changed, 87 insertions(+), 133 deletions(-) diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 3f84ab8..bbdbe48 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -23,15 +23,20 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = if (.saSurvivalReady(options)) dataset <- .saReadDataset(dataset, options) + saveRDS(options, file = "C:/JASP/options.RDS") + saveRDS(dataset, file = "C:/JASP/dataset.RDS") + if (.saSurvivalReady(options)) { .sanpFitKaplanMeier(jaspResults, dataset, options) .sanpFitTests(jaspResults, dataset, options) } + saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") + .sanpSummaryTable(jaspResults, dataset, options) .sanpTestsTable(jaspResults, dataset, options) - if (options[["survivalCurvePlot"]]) + if (options[["plot"]]) .sanpSurvivalPlot(jaspResults, dataset, options) if (options[["lifeTable"]]) @@ -208,19 +213,25 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = } .sanpSurvivalPlot <- function(jaspResults, dataset, options) { - if (!is.null(jaspResults[["surivalPlots"]])) - surivalPlots <- jaspResults[["surivalPlots"]] + if (!is.null(jaspResults[["surivalPlot"]])) + surivalPlot <- jaspResults[["surivalPlot"]] else { - surivalPlots <- createJaspContainer(gettext("Kaplan-Meier Survival Plots")) - surivalPlots$dependOn(c(.sanpDependencies, "survivalCurvePlot", "colorPalette", "survivalCurvePlotLegend")) + surivalPlot <- createJaspPlot(switch( + options[["plotType"]], + "survival" = gettext("Kaplan-Meier Survival Plot"), + "risk" = gettext("Kaplan-Meier Risk Plot"), + "cumulativeHazard" = gettext("Kaplan-Meier Cumulative Hazard Plot"), + "complementaryLogLog" = gettext("Kaplan-Meier Complementary Log-Log Plot") + )) + surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotConfidenceInterval", "plotRiskTable", + "plotRiskTableValue", "plotAddQuantile", "plotAddQuantileValue", + "colorPalette", "plotLegend", "plotTheme")) - surivalPlots$position <- 3 - jaspResults[["surivalPlots"]] <- surivalPlots + surivalPlot$position <- 3 + jaspResults[["surivalPlot"]] <- surivalPlot } if (is.null(jaspResults[["fit"]])) { - waitingPlot <- createJaspPlot() - jaspResults[["waitingPlot"]] <- waitingPlot return() } @@ -228,8 +239,6 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = fit <- jaspResults[["fit"]][["object"]] if (jaspBase::isTryError(fit)) { - waitingPlot <- createJaspPlot() - jaspResults[["waitingPlot"]] <- waitingPlot return() } @@ -244,109 +253,27 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = #tempPlot <- try(.sanpPlotLifeTable(fitLifeTable, options)) - tempPlot <- try(survminer::ggsurvplot( - fit, - data = dataset, - - palette = jaspGraphs::JASPcolors(palette = options[["colorPalette"]]), - conf.int = options[["survivalCurvePlotConfidenceInterval"]], - - title = gettext("Survival curves"), - - risk.table = options[["survivalCurvePlotRiskTable"]], - cumevents = options[["survivalCurvePlotCumulativeEventsTable"]], - ncensor.plot = options[["survivalCurveCensoringPlot"]], - cumcensor = options[["survivalCurveCensoringPlotCumulative"]] - )) + ## old code: using survminer + # tempPlot <- try(survminer::ggsurvplot( + # fit, + # data = dataset, + # + # palette = jaspGraphs::JASPcolors(palette = options[["colorPalette"]]), + # conf.int = options[["survivalCurvePlotConfidenceInterval"]], + # + # title = gettext("Survival curves"), + # + # risk.table = options[["survivalCurvePlotRiskTable"]], + # cumevents = options[["survivalCurvePlotCumulativeEventsTable"]], + # ncensor.plot = options[["survivalCurveCensoringPlot"]], + # cumcensor = options[["survivalCurveCensoringPlotCumulative"]] + # )) if (jaspBase::isTryError(tempPlot)) { surivalCurvePlot$setError(tempPlot) return() } - # translate names - translatedNames <- jaspBase::decodeColNames(names(fit$strata)) - names(translatedNames) <- names(fit$strata) - - # add survival curve - if (is.null(surivalPlots[["surivalCurvePlot"]])) { - surivalCurvePlot <- createJaspPlot(title = gettext("Survival Curve"), width = 450, height = 320) - surivalCurvePlot$dependOn(c("survivalCurvePlotConfidenceInterval")) - surivalCurvePlot$position <- 1 - surivalPlots[["surivalCurvePlot"]] <- surivalCurvePlot - - surivalCurvePlot$plotObject <- tempPlot[["plot"]] + - ggplot2::scale_fill_discrete(labels = translatedNames, type = jaspGraphs::JASPcolors(palette = options[["colorPalette"]])) + - ggplot2::scale_color_discrete(labels = translatedNames, type = jaspGraphs::JASPcolors(palette = options[["colorPalette"]])) + - jaspGraphs::themeJaspRaw(legend.position = options[["survivalCurvePlotLegend"]]) + jaspGraphs::geom_rangeframe() - } - - - if (options[["survivalCurvePlotRiskTable"]] && is.null(surivalPlots[["riskTable"]])) { - riskTable <- createJaspPlot( - title = gettext("Risk Table"), - width = 450, height = 320) - riskTable$dependOn("survivalCurvePlotRiskTable") - riskTable$position <- 2 - surivalPlots[["riskTable"]] <- riskTable - - riskTable$plotObject <- tempPlot[["table"]] + ggplot2::scale_y_discrete(labels = translatedNames) - } - - - if (options[["survivalCurvePlotCumulativeEventsTable"]] && is.null(surivalPlots[["cumulativeEventsTable"]])) { - cumulativeEventsTable <- createJaspPlot( - title = gettext("Cumulative Events Table") , - width = 450, height = 320) - cumulativeEventsTable$dependOn("survivalCurvePlotCumulativeEventsTable") - cumulativeEventsTable$position <- 3 - surivalPlots[["cumulativeEventsTable"]] <- cumulativeEventsTable - - cumulativeEventsTable$plotObject <- tempPlot[["cumevents"]] + ggplot2::scale_y_discrete(labels = translatedNames) - } - - - if (options[["survivalCurveCensoringPlot"]] && is.null(surivalPlots[["censoringPlot"]])) { - censoringPlot <- createJaspPlot( - title = if (!options[["survivalCurveCensoringPlotCumulative"]]) gettext("Censoring Plot") else gettext("Cumulative Censoring Plot"), - width = 450, height = 320) - censoringPlot$dependOn(c("survivalCurveCensoringPlot", "survivalCurveCensoringPlotCumulative")) - censoringPlot$position <- 4 - surivalPlots[["censoringPlot"]] <- censoringPlot - - # TODO: seems to be a problem in the plotting R package - if (length(options[["factors"]]) == 0 && !options[["survivalCurveCensoringPlotCumulative"]]) - censoringPlot$setError("Simple censoring plot is currently broken in the absence of factors.") - else - censoringPlot$plotObject <- tempPlot[["ncensor.plot"]] + ggplot2::scale_y_discrete(labels = translatedNames) - } - - # - # TODO: legend label names are too long and when translated within JASP, there is too much empty space - - # TODO: This would add theme JASP to the figures, but the "table" figure throws an error - # for(i in seq_along(tempPlot)) { - # if (ggplot2::is.ggplot(tempPlot[[i]])) - # tempPlot[[i]] <- tempPlot[[i]] + jaspGraphs::themeJaspRaw() + jaspGraphs::geom_rangeframe() - # } - - # TODO: This can create the grid but losses the x-axis correspondence across all figures - # re-construct plot array - # tempPlot <- tempPlot[names(tempPlot) %in% c("plot", "table", "ncensor.plot")] - # tempPlot <- jaspGraphs:::jaspGraphsPlot$new(subplots = tempPlot, layout = matrix(seq_along(tempPlot), nrow = length(tempPlot))) - - # TODO: We tried this to use their original grid set-up, but the validator keeps throwing errors - # class(tempPlot) <- c(class(tempPlot), "ggplot") - # obj <- list(tempPlot) - # class(obj) <- "ggplot" - # tempPlot <- jaspGraphs:::jaspGraphsPlot$new(subplots = obj, plotFunction = \(x) survminer:::print.ggsurvplot(x[[1]])) - - # if (jaspBase::isTryError(tempPlot)) { - # surivalPlot$setError(tempPlot) - # return() - # } - - # surivalPlot$plotObject <- tempPlot return() } diff --git a/inst/qml/NonParametricSurvivalAnalysis.qml b/inst/qml/NonParametricSurvivalAnalysis.qml index dc4d3f4..465f8cf 100644 --- a/inst/qml/NonParametricSurvivalAnalysis.qml +++ b/inst/qml/NonParametricSurvivalAnalysis.qml @@ -165,47 +165,69 @@ Form CheckBox { - name: "survivalCurvePlot" - label: qsTr("Survival curve plot") + name: "plot" + label: qsTr("Plot") + + DropDown + { + name: "plotType" + label: qsTr("Type") + values: + [ + { label: qsTr("Survival"), value: "survival"}, + { label: qsTr("Risk"), value: "risk"}, + { label: qsTr("Cumulative hazard"), value: "cumulativeHazard"}, + { label: qsTr("Complementary log-log"), value: "complementaryLogLog"} + ] + } CheckBox { - name: "survivalCurvePlotConfidenceInterval" + name: "plotConfidenceInterval" label: qsTr("Confidence interval") checked: true } CheckBox { - name: "survivalCurvePlotRiskTable" + name: "plotRiskTable" label: qsTr("Risk table") - checked: false - } + checked: true + childrenOnSameRow: true - CheckBox - { - name: "survivalCurvePlotCumulativeEventsTable" - label: qsTr("Cumulative events table") - checked: false + DropDown + { + name: "plotRiskTableValue" + values: + [ + { label: qsTr("Number at risk"), value: "numberAtRisk"}, + { label: qsTr("Cumulative events"), value: "cumulativeEvents"}, + { label: qsTr("Both"), value: "both"}, + { label: qsTr("Both (brackets)"), value: "bothBrackets"} + ] + } } CheckBox { - name: "survivalCurveCensoringPlot" - label: qsTr("Censoring plot") + name: "plotAddQuantile" + label: qsTr("Add quantile") checked: false - - CheckBox + childrenOnSameRow: true + + DoubleField { - name: "survivalCurveCensoringPlotCumulative" - label: qsTr("Cumulative") - checked: false + name: "plotAddQuantileValue" + defaultValue: 0.5 + min: 0 + max: 1 } } + DropDown { - name: "survivalCurvePlotLegend" + name: "plotLegend" label: qsTr("Legend") values: [ @@ -216,13 +238,18 @@ Form { label: qsTr("None"), value: "none"} ] } - - //CheckBox - //{ - // name: "survivalCurvePlotDataRug" - // label: qsTr("Data rug") - //} ColorPalette{} + + DropDown + { + name: "plotTheme" + label: qsTr("Theme") + values: + [ + { label: qsTr("JASP"), value: "jasp"}, + { label: qsTr("ggsurvfit"), value: "ggsurvfit"} + ] + } } } From 8f66de0151c55bad854edc8ced0e8e390088dfa8 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 30 Sep 2024 16:57:22 +0200 Subject: [PATCH 04/24] improve plot --- DESCRIPTION | 2 +- R/nonparametricsurvivalanalysis.R | 53 ++++++++++++++++++++-- inst/qml/NonParametricSurvivalAnalysis.qml | 47 ++++++++++++++----- 3 files changed, 87 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e17bd17..1677296 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,7 @@ License: GPL (>= 2) Encoding: UTF-8 Imports: survival, - survminer, + ggsurvfit, jaspBase, jaspGraphs Suggests: diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index bbdbe48..7fbb629 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -216,7 +216,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = if (!is.null(jaspResults[["surivalPlot"]])) surivalPlot <- jaspResults[["surivalPlot"]] else { - surivalPlot <- createJaspPlot(switch( + surivalPlot <- createJaspPlot(title = switch( options[["plotType"]], "survival" = gettext("Kaplan-Meier Survival Plot"), "risk" = gettext("Kaplan-Meier Risk Plot"), @@ -224,9 +224,11 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = "complementaryLogLog" = gettext("Kaplan-Meier Complementary Log-Log Plot") )) surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotConfidenceInterval", "plotRiskTable", - "plotRiskTableValue", "plotAddQuantile", "plotAddQuantileValue", + "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", + "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", + "plotRiskTableNumberOfCensoredObservationsInTimeInterval", "plotRiskTableAsASingleLine", + "plotAddQuantile", "plotAddQuantileValue", "colorPalette", "plotLegend", "plotTheme")) - surivalPlot$position <- 3 jaspResults[["surivalPlot"]] <- surivalPlot } @@ -269,11 +271,56 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = # cumcensor = options[["survivalCurveCensoringPlotCumulative"]] # )) + tempPlot <- ggsurvfit::survfit2(.saGetFormula(options, type = "KM"), data = dataset) |> + ggsurvfit::ggsurvfit( + type = switch( + options[["plotType"]], + "survival" = "survival", + "risk" = "risk", + "cumulativeHazard" = "cumhaz", + "complementaryLogLog" = "cloglog" + ), + linewidth = 1 + ) + + if (options[["plotConfidenceInterval"]]) + tempPlot <- tempPlot + ggsurvfit::add_confidence_interval() + + if (options[["plotRiskTable"]]) { + riskTableStatistics <- c( + if (options[["plotRiskTableNumberAtRisk"]]) "n.risk", + if (options[["plotRiskTableCumulativeNumberOfObservedEvents"]]) "cum.event", + if (options[["plotRiskTableCumulativeNumberOfCensoredObservations"]]) "cum.censor", + if (options[["plotRiskTableNumberOfEventsInTimeInterval"]]) "n.event", + if (options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]]) "n.censor" + ) + + if (length(riskTableStatistics) > 0) { + if (options[["plotRiskTableAsASingleLine"]]) + riskTableStatistics <- paste0("{", riskTableStatistics, "}", collapse = ", ") + + tempPlot <- tempPlot + ggsurvfit::add_risktable(risktable_stats = riskTableStatistics) + } + } + + if (options[["plotAddQuantile"]]) + tempPlot <- tempPlot + ggsurvfit::add_quantile(y_value = options[["plotAddQuantileValue"]], color = "gray50", linewidth = 0.75) + + if (options[["plotTheme"]] == "jasp") + tempPlot <- tempPlot + + jaspGraphs::geom_rangeframe(sides = "bl") + + jaspGraphs::themeJaspRaw(legend.position = options[["plotLegend"]]) + + # scaling and formatting + tempPlot <- tempPlot + ggsurvfit::scale_ggsurvfit() + + jaspGraphs::scale_JASPcolor_discrete(options[["colorPalette"]]) + if (jaspBase::isTryError(tempPlot)) { surivalCurvePlot$setError(tempPlot) return() } + surivalPlot$plotObject <- tempPlot return() } diff --git a/inst/qml/NonParametricSurvivalAnalysis.qml b/inst/qml/NonParametricSurvivalAnalysis.qml index 465f8cf..1407bac 100644 --- a/inst/qml/NonParametricSurvivalAnalysis.qml +++ b/inst/qml/NonParametricSurvivalAnalysis.qml @@ -192,19 +192,44 @@ Form { name: "plotRiskTable" label: qsTr("Risk table") - checked: true - childrenOnSameRow: true + checked: false - DropDown + CheckBox { - name: "plotRiskTableValue" - values: - [ - { label: qsTr("Number at risk"), value: "numberAtRisk"}, - { label: qsTr("Cumulative events"), value: "cumulativeEvents"}, - { label: qsTr("Both"), value: "both"}, - { label: qsTr("Both (brackets)"), value: "bothBrackets"} - ] + name: "plotRiskTableNumberAtRisk" + label: qsTr("Number at risk") + checked: true + } + + CheckBox + { + name: "plotRiskTableCumulativeNumberOfObservedEvents" + label: qsTr("Cum. number of observed events") + checked: true + } + + CheckBox + { + name: "plotRiskTableCumulativeNumberOfCensoredObservations" + label: qsTr("Cum. number of censored obs.") + } + + CheckBox + { + name: "plotRiskTableNumberOfEventsInTimeInterval" + label: qsTr("Number of events in time interval") + } + + CheckBox + { + name: "plotRiskTableNumberOfCensoredObservationsInTimeInterval" + label: qsTr("Number of censored obs. in time interval") + } + + CheckBox + { + name: "plotRiskTableAsASingleLine" + label: qsTr("As a single line") } } From f068b01417b8c3e935b9809bcd06354f3ad65363 Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 2 Oct 2024 10:06:36 +0200 Subject: [PATCH 05/24] fix survival plot --- R/nonparametricsurvivalanalysis.R | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 7fbb629..8bd54f2 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -222,7 +222,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = "risk" = gettext("Kaplan-Meier Risk Plot"), "cumulativeHazard" = gettext("Kaplan-Meier Cumulative Hazard Plot"), "complementaryLogLog" = gettext("Kaplan-Meier Complementary Log-Log Plot") - )) + ), width = 450, height = if (options[["plotRiskTable"]]) 700 else 400) surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotConfidenceInterval", "plotRiskTable", "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", @@ -271,6 +271,16 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = # cumcensor = options[["survivalCurveCensoringPlotCumulative"]] # )) + .ggsurvfit2JaspPlot <- function(x) { + grDevices::png(f <- tempfile()) + on.exit({ + grDevices::dev.off() + if (file.exists(f)) + file.remove(f) + }) + return(ggsurvfit:::ggsurvfit_build(tempPlot)) + } + tempPlot <- ggsurvfit::survfit2(.saGetFormula(options, type = "KM"), data = dataset) |> ggsurvfit::ggsurvfit( type = switch( @@ -310,6 +320,8 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempPlot <- tempPlot + jaspGraphs::geom_rangeframe(sides = "bl") + jaspGraphs::themeJaspRaw(legend.position = options[["plotLegend"]]) + else + tempPlot <- tempPlot + ggplot2::theme(legend.position = options[["plotLegend"]]) # scaling and formatting tempPlot <- tempPlot + ggsurvfit::scale_ggsurvfit() + @@ -320,7 +332,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = return() } - surivalPlot$plotObject <- tempPlot + surivalPlot$plotObject <- .ggsurvfit2JaspPlot(tempPlot) return() } From 47e0e0ce4d6c37e0484bcd4322e3b2d9e3b3fcda Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 2 Oct 2024 10:11:55 +0200 Subject: [PATCH 06/24] fix scaling --- R/nonparametricsurvivalanalysis.R | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 8bd54f2..372567f 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -211,6 +211,20 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = return() } +.sanpGetSurvivalPlotHeight <- function(options) { + if (!options[["plotRiskTable"]]) + return(400) + else if (!options[["plotRiskTableAsASingleLine"]]) + return(450) + else + return(400 + 50 * sum(c( + options[["plotRiskTableNumberAtRisk"]], + options[["plotRiskTableCumulativeNumberOfObservedEvents"]], + options[["plotRiskTableCumulativeNumberOfCensoredObservations"]], + options[["plotRiskTableNumberOfEventsInTimeInterval"]], + options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]] + ))) +} .sanpSurvivalPlot <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["surivalPlot"]])) @@ -222,7 +236,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = "risk" = gettext("Kaplan-Meier Risk Plot"), "cumulativeHazard" = gettext("Kaplan-Meier Cumulative Hazard Plot"), "complementaryLogLog" = gettext("Kaplan-Meier Complementary Log-Log Plot") - ), width = 450, height = if (options[["plotRiskTable"]]) 700 else 400) + ), width = 450, height = .sanpGetSurvivalPlotHeight(options)) surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotConfidenceInterval", "plotRiskTable", "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", From 6130ced48dab8fbf0763b30cc387d786f7eab7e7 Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 2 Oct 2024 10:13:58 +0200 Subject: [PATCH 07/24] fix plot fill --- R/nonparametricsurvivalanalysis.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 372567f..f951452 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -339,7 +339,8 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = # scaling and formatting tempPlot <- tempPlot + ggsurvfit::scale_ggsurvfit() + - jaspGraphs::scale_JASPcolor_discrete(options[["colorPalette"]]) + jaspGraphs::scale_JASPcolor_discrete(options[["colorPalette"]]) + + jaspGraphs::scale_JASPfill_discrete(options[["colorPalette"]]) if (jaspBase::isTryError(tempPlot)) { surivalCurvePlot$setError(tempPlot) From a59225252ad81ab09294b4824796b7ec77d63512 Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 2 Oct 2024 17:37:39 +0200 Subject: [PATCH 08/24] extend semiparametric --- NAMESPACE | 1 + R/commonsurvivalanalysis.R | 163 ++++++++++++++++++-- R/nonparametricsurvivalanalysis.R | 151 +----------------- R/semiparametricsurvivalanalysis.R | 51 ++++-- inst/qml/NonParametricSurvivalAnalysis.qml | 118 +------------- inst/qml/SemiParametricSurvivalAnalysis.qml | 43 +++++- inst/qml/qml_components/.gitkeep | 0 inst/qml/qml_components/SurvivalPlot.qml | 136 ++++++++++++++++ 8 files changed, 380 insertions(+), 283 deletions(-) delete mode 100644 inst/qml/qml_components/.gitkeep create mode 100644 inst/qml/qml_components/SurvivalPlot.qml diff --git a/NAMESPACE b/NAMESPACE index 75d3b58..02c4df7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,5 @@ import(jaspBase) +import(survival) export(NonParametricSurvivalAnalysis) export(SemiParametricSurvivalAnalysis) export(ParametricSurvivalAnalysis) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 677ae1e..3cab7c6 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -5,10 +5,7 @@ # - make "lifeTableStepsSize" correspond to the maxiumum time/10 # R: # - convenient function for making factor level parameter names nice (in regression tables)? -# - why legend names are so wide? Encoding/decoding problems? -# (smth along the lines of: `levels(tempPlot$data.survplot$strata) <- jaspBase::decodeColNames(levels(tempPlot$data.survplot$strata), strict = FALSE)` -# - make sure x-axis are aligned in the survival plot -# - jaspTheme the plot +# - add frailty to coxph .saSurvivalReady <- function(options) { @@ -34,11 +31,16 @@ ) factorsVariable <- Filter(function(s) s != "", options[["factors"]]) - covariatesVariable <- Filter(function(s) s != "", options[["covariates"]]) # only for (semi)parametric + # only for (semi)parametric + covariatesVariable <- Filter(function(s) s != "", options[["covariates"]]) + strataVariable <- Filter(function(s) s != "", options[["strata"]]) + idVariable <- Filter(function(s) s != "", options[["id"]]) + clusterVariable <- Filter(function(s) s != "", options[["cluster"]]) + weightsVariable <- Filter(function(s) s != "", options[["weights"]]) dataset <- .readDataSetToEnd( - columns.as.numeric = c(timeVariable, covariatesVariable), - columns.as.factor = c(eventVariable, factorsVariable) + columns.as.numeric = c(timeVariable, covariatesVariable, weightsVariable), + columns.as.factor = c(eventVariable, factorsVariable, strataVariable, idVariable, clusterVariable), ) # clean from NAs @@ -51,7 +53,7 @@ .hasErrors( dataset = dataset, type = c("negativeValues"), - negativeValues.target = timeVariable, + negativeValues.target = c(timeVariable, weightsVariable), exitAnalysisIfErrors = TRUE ) @@ -98,7 +100,7 @@ .saGetSurv <- function(options) { return(switch( options[["censoringType"]], - "counting" = sprintf("survival::Surv( + "counting" = sprintf("Surv( time = %1$s, time2 = %2$s, event = %3$s, @@ -107,7 +109,7 @@ options[["intervalEnd"]], options[["eventStatus"]] ), - "right" = sprintf("survival::Surv( + "right" = sprintf("Surv( time = %1$s, event = %2$s, type = 'right')", @@ -147,6 +149,17 @@ # this function outputs a formula name with base64 values as varnames modelTerms <- options[["modelTerms"]] + # add "strata" calls + for (i in seq_along(options[["strata"]])) { + for (j in seq_along(modelTerms)) { + modelTerms[[j]]$components <- gsub( + options[["strata"]][[i]], + paste0("strata(", options[["strata"]][[i]], ")"), + modelTerms[[j]]$components + ) + } + } + t <- NULL for (i in seq_along(modelTerms)) { @@ -211,3 +224,133 @@ return(varName) } + +.saGetSurvivalPlotHeight <- function(options) { + if (!options[["plotRiskTable"]]) + return(400) + else if (!options[["plotRiskTableAsASingleLine"]]) + return(450) + else + return(400 + 50 * sum(c( + options[["plotRiskTableNumberAtRisk"]], + options[["plotRiskTableCumulativeNumberOfObservedEvents"]], + options[["plotRiskTableCumulativeNumberOfCensoredObservations"]], + options[["plotRiskTableNumberOfEventsInTimeInterval"]], + options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]] + ))) +} +.saSurvivalPlot <- function(jaspResults, dataset, options, type) { + + if (!is.null(jaspResults[["surivalPlot"]])) + surivalPlot <- jaspResults[["surivalPlot"]] + else { + surivalPlot <- createJaspPlot(title = switch( + options[["plotType"]], + "survival" = gettext("Survival Plot"), + "risk" = gettext("Risk Plot"), + "cumulativeHazard" = gettext("Cumulative Hazard Plot"), + "complementaryLogLog" = gettext("Complementary Log-Log Plot") + ), width = 450, height = .saGetSurvivalPlotHeight(options)) + surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotStrata", "plotConfidenceInterval", "plotRiskTable", + "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", + "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", + "plotRiskTableNumberOfCensoredObservationsInTimeInterval", "plotRiskTableAsASingleLine", + "plotAddQuantile", "plotAddQuantileValue", + "colorPalette", "plotLegend", "plotTheme")) + surivalPlot$position <- 3 + jaspResults[["surivalPlot"]] <- surivalPlot + } + + if (is.null(jaspResults[["fit"]])) + return() + + fit <- jaspResults[["fit"]][["object"]] + + if (jaspBase::isTryError(fit)) + return() + + .ggsurvfit2JaspPlot <- function(x) { + grDevices::png(f <- tempfile()) + on.exit({ + grDevices::dev.off() + if (file.exists(f)) + file.remove(f) + }) + return(ggsurvfit:::ggsurvfit_build(tempPlot)) + } + + if (type == "KM") + tempPlot <- ggsurvfit::survfit2(.saGetFormula(options, type = type), data = dataset) |> + ggsurvfit::ggsurvfit( + type = switch( + options[["plotType"]], + "survival" = "survival", + "risk" = "risk", + "cumulativeHazard" = "cumhaz", + "complementaryLogLog" = "cloglog" + ), + linewidth = 1 + ) + else if (type == "Cox") + tempPlot <- ggsurvfit::survfit2(fit) |> + ggsurvfit::ggsurvfit( + type = switch( + options[["plotType"]], + "survival" = "survival", + "risk" = "risk", + "cumulativeHazard" = "cumhaz", + "complementaryLogLog" = "cloglog" + ), + linewidth = 1 + ) + + + if (options[["plotConfidenceInterval"]]) + tempPlot <- tempPlot + ggsurvfit::add_confidence_interval() + + if (options[["plotRiskTable"]]) { + riskTableStatistics <- c( + if (options[["plotRiskTableNumberAtRisk"]]) "n.risk", + if (options[["plotRiskTableCumulativeNumberOfObservedEvents"]]) "cum.event", + if (options[["plotRiskTableCumulativeNumberOfCensoredObservations"]]) "cum.censor", + if (options[["plotRiskTableNumberOfEventsInTimeInterval"]]) "n.event", + if (options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]]) "n.censor" + ) + + if (length(riskTableStatistics) > 0) { + if (options[["plotRiskTableAsASingleLine"]]) + riskTableStatistics <- paste0("{", riskTableStatistics, "}", collapse = ", ") + + tempPlot <- tempPlot + ggsurvfit::add_risktable(risktable_stats = riskTableStatistics) + } + } + + if (options[["plotAddQuantile"]]) + tempPlot <- tempPlot + ggsurvfit::add_quantile(y_value = options[["plotAddQuantileValue"]], color = "gray50", linewidth = 0.75) + + if (options[["plotTheme"]] == "jasp") + tempPlot <- tempPlot + + jaspGraphs::geom_rangeframe(sides = "bl") + + jaspGraphs::themeJaspRaw(legend.position = options[["plotLegend"]]) + else + tempPlot <- tempPlot + ggplot2::theme(legend.position = options[["plotLegend"]]) + + # scaling and formatting + tempPlot <- tempPlot + + jaspGraphs::scale_JASPcolor_discrete(options[["colorPalette"]]) + + jaspGraphs::scale_JASPfill_discrete(options[["colorPalette"]]) + + if (options[["plotType"]] == "complementaryLogLog") + tempPlot <- tempPlot + ggplot2::scale_x_continuous(transform = "log") + ggplot2::xlab(gettext("log(Time)")) + else + tempPlot <- tempPlot + ggsurvfit::scale_ggsurvfit() + + if (jaspBase::isTryError(tempPlot)) { + surivalCurvePlot$setError(tempPlot) + return() + } + + surivalPlot$plotObject <- .ggsurvfit2JaspPlot(tempPlot) + + return() +} diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index f951452..73059e3 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -37,7 +37,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = .sanpTestsTable(jaspResults, dataset, options) if (options[["plot"]]) - .sanpSurvivalPlot(jaspResults, dataset, options) + .saSurvivalPlot(jaspResults, dataset, options, type = "KM") if (options[["lifeTable"]]) .sanpLifeTable(jaspResults, dataset, options) @@ -56,7 +56,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = fitContainer$dependOn(.sanpDependencies) jaspResults[["fit"]] <- fitContainer - fit <- try(survival::survfit( + fit <- try(survfit( formula = .saGetFormula(options, type = "KM"), type = "kaplan-meier", data = dataset @@ -80,7 +80,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempContainer$dependOn(c(.sanpDependencies, "testsLogRank")) jaspResults[["testLogRank"]] <- tempContainer - fit <- try(survival::survdiff( + fit <- try(survdiff( formula = .saGetFormula(options, type = "KM"), data = dataset )) @@ -94,7 +94,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempContainer$dependOn(c(.sanpDependencies, "testsPetoAndPeto")) jaspResults[["testPetoAndPeto"]] <- tempContainer - fit <- try(survival::survdiff( + fit <- try(survdiff( formula = .saGetFormula(options, type = "KM"), data = dataset, rho = 1 @@ -109,7 +109,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempContainer$dependOn(c(.sanpDependencies, "testsFlemmingHarrington", "testsFlemmingHarringtonRho")) jaspResults[["testFlemmingHarrington"]] <- tempContainer - fit <- try(survival::survdiff( + fit <- try(survdiff( formula = .saGetFormula(options, type = "KM"), data = dataset, rho = options[["testsFlemmingHarringtonRho"]] @@ -211,146 +211,6 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = return() } -.sanpGetSurvivalPlotHeight <- function(options) { - if (!options[["plotRiskTable"]]) - return(400) - else if (!options[["plotRiskTableAsASingleLine"]]) - return(450) - else - return(400 + 50 * sum(c( - options[["plotRiskTableNumberAtRisk"]], - options[["plotRiskTableCumulativeNumberOfObservedEvents"]], - options[["plotRiskTableCumulativeNumberOfCensoredObservations"]], - options[["plotRiskTableNumberOfEventsInTimeInterval"]], - options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]] - ))) -} -.sanpSurvivalPlot <- function(jaspResults, dataset, options) { - - if (!is.null(jaspResults[["surivalPlot"]])) - surivalPlot <- jaspResults[["surivalPlot"]] - else { - surivalPlot <- createJaspPlot(title = switch( - options[["plotType"]], - "survival" = gettext("Kaplan-Meier Survival Plot"), - "risk" = gettext("Kaplan-Meier Risk Plot"), - "cumulativeHazard" = gettext("Kaplan-Meier Cumulative Hazard Plot"), - "complementaryLogLog" = gettext("Kaplan-Meier Complementary Log-Log Plot") - ), width = 450, height = .sanpGetSurvivalPlotHeight(options)) - surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotConfidenceInterval", "plotRiskTable", - "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", - "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", - "plotRiskTableNumberOfCensoredObservationsInTimeInterval", "plotRiskTableAsASingleLine", - "plotAddQuantile", "plotAddQuantileValue", - "colorPalette", "plotLegend", "plotTheme")) - surivalPlot$position <- 3 - jaspResults[["surivalPlot"]] <- surivalPlot - } - - if (is.null(jaspResults[["fit"]])) { - return() - } - - - fit <- jaspResults[["fit"]][["object"]] - - if (jaspBase::isTryError(fit)) { - return() - } - - ## old code: manually creating survival plot - #fitLifeTable <- try(.sanpKaplanMeierFitLifeTable(fit, dataset, options, plot = TRUE)) - # - #if (jaspBase::isTryError(fitLifeTable)) { - # surivalPlot$setError(fitLifeTable) - # return() - #} - # - #tempPlot <- try(.sanpPlotLifeTable(fitLifeTable, options)) - - - ## old code: using survminer - # tempPlot <- try(survminer::ggsurvplot( - # fit, - # data = dataset, - # - # palette = jaspGraphs::JASPcolors(palette = options[["colorPalette"]]), - # conf.int = options[["survivalCurvePlotConfidenceInterval"]], - # - # title = gettext("Survival curves"), - # - # risk.table = options[["survivalCurvePlotRiskTable"]], - # cumevents = options[["survivalCurvePlotCumulativeEventsTable"]], - # ncensor.plot = options[["survivalCurveCensoringPlot"]], - # cumcensor = options[["survivalCurveCensoringPlotCumulative"]] - # )) - - .ggsurvfit2JaspPlot <- function(x) { - grDevices::png(f <- tempfile()) - on.exit({ - grDevices::dev.off() - if (file.exists(f)) - file.remove(f) - }) - return(ggsurvfit:::ggsurvfit_build(tempPlot)) - } - - tempPlot <- ggsurvfit::survfit2(.saGetFormula(options, type = "KM"), data = dataset) |> - ggsurvfit::ggsurvfit( - type = switch( - options[["plotType"]], - "survival" = "survival", - "risk" = "risk", - "cumulativeHazard" = "cumhaz", - "complementaryLogLog" = "cloglog" - ), - linewidth = 1 - ) - - if (options[["plotConfidenceInterval"]]) - tempPlot <- tempPlot + ggsurvfit::add_confidence_interval() - - if (options[["plotRiskTable"]]) { - riskTableStatistics <- c( - if (options[["plotRiskTableNumberAtRisk"]]) "n.risk", - if (options[["plotRiskTableCumulativeNumberOfObservedEvents"]]) "cum.event", - if (options[["plotRiskTableCumulativeNumberOfCensoredObservations"]]) "cum.censor", - if (options[["plotRiskTableNumberOfEventsInTimeInterval"]]) "n.event", - if (options[["plotRiskTableNumberOfCensoredObservationsInTimeInterval"]]) "n.censor" - ) - - if (length(riskTableStatistics) > 0) { - if (options[["plotRiskTableAsASingleLine"]]) - riskTableStatistics <- paste0("{", riskTableStatistics, "}", collapse = ", ") - - tempPlot <- tempPlot + ggsurvfit::add_risktable(risktable_stats = riskTableStatistics) - } - } - - if (options[["plotAddQuantile"]]) - tempPlot <- tempPlot + ggsurvfit::add_quantile(y_value = options[["plotAddQuantileValue"]], color = "gray50", linewidth = 0.75) - - if (options[["plotTheme"]] == "jasp") - tempPlot <- tempPlot + - jaspGraphs::geom_rangeframe(sides = "bl") + - jaspGraphs::themeJaspRaw(legend.position = options[["plotLegend"]]) - else - tempPlot <- tempPlot + ggplot2::theme(legend.position = options[["plotLegend"]]) - - # scaling and formatting - tempPlot <- tempPlot + ggsurvfit::scale_ggsurvfit() + - jaspGraphs::scale_JASPcolor_discrete(options[["colorPalette"]]) + - jaspGraphs::scale_JASPfill_discrete(options[["colorPalette"]]) - - if (jaspBase::isTryError(tempPlot)) { - surivalCurvePlot$setError(tempPlot) - return() - } - - surivalPlot$plotObject <- .ggsurvfit2JaspPlot(tempPlot) - - return() -} .sanpLifeTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["LifeTableContainer"]])) @@ -407,7 +267,6 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = return() } - .sanpKaplanMeierFitSummary <- function(fit) { fitSummary <- summary(fit)$table diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 36e4253..3e03a3b 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -40,11 +40,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (options[["coefficientHazardRatioEstimates"]]) .saspHazardRatioTable(jaspResults, dataset, options) + if (options[["plot"]]) + .saSurvivalPlot(jaspResults, dataset, options, type = "Cox") return() } -.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", "modelTerms", "method") +.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", "strata", "id", "cluster", "modelTerms", "method") .saspFitCox <- function(jaspResults, dataset, options) { @@ -54,10 +56,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitContainer$dependOn(.saspDependencies) jaspResults[["fit"]] <- fitContainer - fit <- try(survival::coxph( + fit <- try(coxph( formula = .saGetFormula(options, type = "Cox", null = FALSE), data = dataset, - method = options[["method"]] + method = options[["method"]], + id = if (options[["id"]] != "") dataset[[options[["id"]]]], + cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], + weights = if (options[["weights"]] != "") options[["weights"]] )) # fix scoping in ggsurvplot fit$call$formula <- eval(fit$call$formula) @@ -70,11 +75,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitNullContainer <- createJaspState() fitNullContainer$dependOn(.saspDependencies) jaspResults[["fitNull"]] <- fitNullContainer - - fitNull <- try(survival::coxph( + fitNull <- try(coxph( formula = .saGetFormula(options, type = "Cox", null = TRUE), data = dataset, - method = options[["method"]] + method = options[["method"]], + id = if (options[["id"]] != "") dataset[[options[["id"]]]], + cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], + weights = if (options[["weights"]] != "") options[["weights"]] )) # fix scoping in ggsurvplot fitNull$call$formula <- eval(fitNull$call$formula) @@ -196,7 +203,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state nullPredictors <- .saGetPredictors(options, null = TRUE) if (length(nullPredictors) != 0) - summaryTable$addFootnote(gettextf("Null model contains nuisance parameters: %s", paste(nullPredictors, collapse = ", "))) + summaryTable$addFootnote(gettextf("Null model contains nuisance parameters: %1$s", paste(nullPredictors, collapse = ", "))) + + if (options[["cluster"]] != "") + summaryTable$addFootnote(gettextf("Robust variance estimation based on %1$s.", options[["cluster"]])) + + if (options[["id"]] != "") + summaryTable$addFootnote(gettextf("Subject identification based on %1$s.", options[["id"]])) return() } @@ -256,6 +269,8 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesTable$addColumnInfo(name = "param", title = "", type = "string") estimatesTable$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number") estimatesTable$addColumnInfo(name = "se", title = gettext("Standard Error"), type = "number") + if (options[["cluster"]] != "" || options[["id"]] != "") + estimatesTable$addColumnInfo(name = "rse", title = gettext("Robust Standard Error"), type = "number") if (options[["coefficientsConfidenceIntervals"]]) { overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientsConfidenceIntervalsLevel"]]) estimatesTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overtitle) @@ -295,6 +310,8 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (!is.null(estimates) && options[["vovkSellke"]]) estimates$vsmpr <- VovkSellkeMPR(estimates$pval) + if (length(options[["strata"]]) > 0) + estimatesTable$addFootnote(gettextf("Results are stratified via: %1$s.", paste0(options[["strata"]], collapse = ", "))) estimatesTable$setData(estimates) @@ -352,7 +369,17 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state .saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { # extract coefficients - estimatesFit <- summary(fit)$coefficients[,c("coef", "se(coef)", "z", "Pr(>|z|)"), drop = FALSE] + estimatesFit <- summary(fit)$coefficients + toExtract <- c( + "est" = "coef", + "se" = "se(coef)", + "rse" = "robust se", + "zval" = "z", + "pval" = "Pr(>|z|)" + ) + namesEstimatesFit <- colnames(estimatesFit) + estimatesFit <- estimatesFit[,namesEstimatesFit %in% toExtract, drop = FALSE] + # make into a data.frame if (is.null(estimatesFit)) return() @@ -360,17 +387,17 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state else estimatesFit <- data.frame(estimatesFit) # fix column names - colnames(estimatesFit) <- c("est", "se", "zval", "pval") + colnames(estimatesFit) <- names(toExtract)[toExtract %in% namesEstimatesFit] # add confidence intervals if (options[["coefficientsConfidenceIntervals"]]) { - estimatesFit$lower <- estimatesFit$est + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit$se - estimatesFit$upper <- estimatesFit$est - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit$se + estimatesFit$lower <- estimatesFit[,"est"] + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] + estimatesFit$upper <- estimatesFit[,"est"] - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] } # transform to HR if needed if (HR) { - estimatesFit <- estimatesFit[,!colnames(estimatesFit) %in% c("se", "zval", "pval"), drop = FALSE] + estimatesFit <- estimatesFit[,!colnames(estimatesFit) %in% c("se", "rse", "zval", "pval"), drop = FALSE] estimatesFit <- exp(estimatesFit) } diff --git a/inst/qml/NonParametricSurvivalAnalysis.qml b/inst/qml/NonParametricSurvivalAnalysis.qml index 1407bac..8301ca9 100644 --- a/inst/qml/NonParametricSurvivalAnalysis.qml +++ b/inst/qml/NonParametricSurvivalAnalysis.qml @@ -21,6 +21,8 @@ import JASP.Controls 1.0 import JASP.Widgets 1.0 import JASP 1.0 +import "./qml_components" as SA + Form { VariablesForm @@ -58,6 +60,7 @@ Form AssignedVariablesList { name: "factors" + id: factors title: qsTr("Factors") allowedColumns: ["nominal"] } @@ -163,118 +166,5 @@ Form } } - CheckBox - { - name: "plot" - label: qsTr("Plot") - - DropDown - { - name: "plotType" - label: qsTr("Type") - values: - [ - { label: qsTr("Survival"), value: "survival"}, - { label: qsTr("Risk"), value: "risk"}, - { label: qsTr("Cumulative hazard"), value: "cumulativeHazard"}, - { label: qsTr("Complementary log-log"), value: "complementaryLogLog"} - ] - } - - CheckBox - { - name: "plotConfidenceInterval" - label: qsTr("Confidence interval") - checked: true - } - - CheckBox - { - name: "plotRiskTable" - label: qsTr("Risk table") - checked: false - - CheckBox - { - name: "plotRiskTableNumberAtRisk" - label: qsTr("Number at risk") - checked: true - } - - CheckBox - { - name: "plotRiskTableCumulativeNumberOfObservedEvents" - label: qsTr("Cum. number of observed events") - checked: true - } - - CheckBox - { - name: "plotRiskTableCumulativeNumberOfCensoredObservations" - label: qsTr("Cum. number of censored obs.") - } - - CheckBox - { - name: "plotRiskTableNumberOfEventsInTimeInterval" - label: qsTr("Number of events in time interval") - } - - CheckBox - { - name: "plotRiskTableNumberOfCensoredObservationsInTimeInterval" - label: qsTr("Number of censored obs. in time interval") - } - - CheckBox - { - name: "plotRiskTableAsASingleLine" - label: qsTr("As a single line") - } - } - - CheckBox - { - name: "plotAddQuantile" - label: qsTr("Add quantile") - checked: false - childrenOnSameRow: true - - DoubleField - { - name: "plotAddQuantileValue" - defaultValue: 0.5 - min: 0 - max: 1 - } - } - - - DropDown - { - name: "plotLegend" - label: qsTr("Legend") - values: - [ - { label: qsTr("Bottom"), value: "bottom"}, - { label: qsTr("Right"), value: "right"}, - { label: qsTr("Left"), value: "left"}, - { label: qsTr("Top"), value: "top"}, - { label: qsTr("None"), value: "none"} - ] - } - - ColorPalette{} - - DropDown - { - name: "plotTheme" - label: qsTr("Theme") - values: - [ - { label: qsTr("JASP"), value: "jasp"}, - { label: qsTr("ggsurvfit"), value: "ggsurvfit"} - ] - } - } + SA.SurvivalPlot{} } diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 8e3584c..2ca827f 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -21,11 +21,14 @@ import JASP.Controls 1.0 import JASP.Widgets 1.0 import JASP 1.0 +import "./qml_components" as SA + Form { VariablesForm { removeInvisibles: true + height: 1000 AvailableVariablesList { @@ -89,6 +92,37 @@ Form title: qsTr("Factors") allowedColumns: ["nominal"] } + + AssignedVariablesList + { + name: "strata" + title: qsTr("Strata") + allowedColumns: ["nominal"] + } + + AssignedVariablesList + { + name: "id" + title: qsTr("Id") + allowedColumns: ["nominal"] + singleVariable: true + } + + AssignedVariablesList + { + name: "cluster" + title: qsTr("Cluster") + allowedColumns: ["nominal"] + singleVariable: true + } + + AssignedVariablesList + { + name: "weights" + title: qsTr("Weights") + allowedColumns: ["scale"] + singleVariable: true + } } DropDown @@ -141,7 +175,7 @@ Form name: "availableTerms" title: qsTr("Components") width: parent.width / 4 - source: ['covariates', 'factors'] + source: ['covariates', 'factors', 'strata'] } ModelTermsList @@ -231,4 +265,11 @@ Form } } } + + Section + { + title: qsTr("Plot") + + SA.SurvivalPlot{} + } } diff --git a/inst/qml/qml_components/.gitkeep b/inst/qml/qml_components/.gitkeep deleted file mode 100644 index e69de29..0000000 diff --git a/inst/qml/qml_components/SurvivalPlot.qml b/inst/qml/qml_components/SurvivalPlot.qml new file mode 100644 index 0000000..85f13c4 --- /dev/null +++ b/inst/qml/qml_components/SurvivalPlot.qml @@ -0,0 +1,136 @@ +// +// Copyright (C) 2013-2018 University of Amsterdam +// +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public +// License along with this program. If not, see +// . +// + + +import QtQuick 2.8 +import JASP.Controls 1.0 + +CheckBox +{ + name: "plot" + label: qsTr("Plot") + + DropDown + { + name: "plotType" + label: qsTr("Type") + values: + [ + { label: qsTr("Survival"), value: "survival"}, + { label: qsTr("Risk"), value: "risk"}, + { label: qsTr("Cumulative hazard"), value: "cumulativeHazard"}, + { label: qsTr("Complementary log-log"), value: "complementaryLogLog"} + ] + } + + CheckBox + { + name: "plotConfidenceInterval" + label: qsTr("Confidence interval") + checked: true + } + + CheckBox + { + name: "plotRiskTable" + label: qsTr("Risk table") + checked: false + + CheckBox + { + name: "plotRiskTableNumberAtRisk" + label: qsTr("Number at risk") + checked: true + } + + CheckBox + { + name: "plotRiskTableCumulativeNumberOfObservedEvents" + label: qsTr("Cum. number of observed events") + checked: true + } + + CheckBox + { + name: "plotRiskTableCumulativeNumberOfCensoredObservations" + label: qsTr("Cum. number of censored obs.") + } + + CheckBox + { + name: "plotRiskTableNumberOfEventsInTimeInterval" + label: qsTr("Number of events in time interval") + } + + CheckBox + { + name: "plotRiskTableNumberOfCensoredObservationsInTimeInterval" + label: qsTr("Number of censored obs. in time interval") + } + + CheckBox + { + name: "plotRiskTableAsASingleLine" + label: qsTr("As a single line") + } + } + + CheckBox + { + name: "plotAddQuantile" + label: qsTr("Add quantile") + checked: false + childrenOnSameRow: true + + DoubleField + { + name: "plotAddQuantileValue" + defaultValue: 0.5 + min: 0 + max: 1 + } + } + + + DropDown + { + name: "plotLegend" + label: qsTr("Legend") + values: + [ + { label: qsTr("Bottom"), value: "bottom"}, + { label: qsTr("Right"), value: "right"}, + { label: qsTr("Left"), value: "left"}, + { label: qsTr("Top"), value: "top"}, + { label: qsTr("None"), value: "none"} + ] + } + + ColorPalette{} + + DropDown + { + name: "plotTheme" + label: qsTr("Theme") + values: + [ + { label: qsTr("JASP"), value: "jasp"}, + { label: qsTr("ggsurvfit"), value: "ggsurvfit"} + ] + } +} \ No newline at end of file From a86da567f7f3e19104cb4b6e22ecaced8b040b2b Mon Sep 17 00:00:00 2001 From: FBartos Date: Thu, 3 Oct 2024 15:44:29 +0200 Subject: [PATCH 09/24] add diagnostics --- R/commonsurvivalanalysis.R | 8 +- R/semiparametricsurvivalanalysis.R | 163 +++++++++++++++++++- inst/qml/SemiParametricSurvivalAnalysis.qml | 46 ++++++ 3 files changed, 214 insertions(+), 3 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 3cab7c6..d2c0a0d 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -203,6 +203,8 @@ if (varName == "(Intercept)") return("Intercept") + if (varName == "Global") + return("Global") for (vn in variables) { inf <- regexpr(vn, varName, fixed = TRUE) @@ -257,7 +259,11 @@ "plotRiskTableNumberOfCensoredObservationsInTimeInterval", "plotRiskTableAsASingleLine", "plotAddQuantile", "plotAddQuantileValue", "colorPalette", "plotLegend", "plotTheme")) - surivalPlot$position <- 3 + surivalPlot$position <- switch( + type, + "KM" = 3, + "Cox" = 7 + ) jaspResults[["surivalPlot"]] <- surivalPlot } diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 3e03a3b..5b1bbaf 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -23,8 +23,8 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state saveRDS(options, file = "C:/JASP/options.RDS") saveRDS(dataset, file = "C:/JASP/dataset.RDS") - if (.saSurvivalReady(options)) - .saspFitCox(jaspResults, dataset, options) + .saspFitCox(jaspResults, dataset, options) + .saspFitCoxAssumptionTest(jaspResults, dataset, options) saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") @@ -43,6 +43,12 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (options[["plot"]]) .saSurvivalPlot(jaspResults, dataset, options, type = "Cox") + if (options[["proportionalHazardsTable"]]) + .saspProportionalHazardsTable(jaspResults, dataset, options) + + if (options[["proportionalHazardsPlot"]]) + .saspProportionalHazardsPlots(jaspResults, dataset, options) + return() } @@ -50,6 +56,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state .saspFitCox <- function(jaspResults, dataset, options) { + if (!.saSurvivalReady(options)) + return() + if (is.null(jaspResults[["fit"]])) { fitContainer <- createJaspState() @@ -91,6 +100,40 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } +.saspFitCoxAssumptionTest <- function(jaspResults, dataset, options) { + + if (!.saSurvivalReady(options)) + return() + + # fit only if diagnostics table/plot requested + if (!options[["proportionalHazardsTable"]] && !options[["proportionalHazardsPlot"]]) + return() + + if (!is.null(jaspResults[["fitTest"]])) + return() + + fitTestContainer <- createJaspState() + fitTestContainer$dependOn(c(.saspDependencies, "proportionalHazardsTransformation", "proportionalHazardsTestTerms")) + jaspResults[["fitTest"]] <- fitTestContainer + + if (is.null(jaspResults[["fit"]])) + return() + + fit <- jaspResults[["fit"]][["object"]] + + if (jaspBase::isTryError(fit)) + return() + + fitTest <- cox.zph( + fit = fit, + transform = options[["proportionalHazardsTransformation"]], + terms = options[["proportionalHazardsTestTerms"]] + ) + + jaspResults[["fitTest"]]$object <- fitTest + + return() +} .saspTestsTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["testsTable"]])) @@ -364,6 +407,122 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } +.saspProportionalHazardsTable <- function(jaspResults, dataset, options) { + + if (!is.null(jaspResults[["proportionalHazardsTable"]])) + return() + + proportionalHazardsTable <- createJaspTable(title = gettext("Proporational Hazards Assumption Test Table")) + proportionalHazardsTable$dependOn(c(.saspDependencies, "proportionalHazardsTable", "proportionalHazardsTransformation", "proportionalHazardsTestTerms")) + proportionalHazardsTable$position <- 7 + jaspResults[["proportionalHazardsTable"]] <- proportionalHazardsTable + + # create empty table + proportionalHazardsTable$addColumnInfo(name = "param", title = "", type = "string") + proportionalHazardsTable$addColumnInfo(name = "chisq", title = gettext("Chi Square"), type = "number") + proportionalHazardsTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") + proportionalHazardsTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") + + if (!.saSurvivalReady(options)) + return() + + fitTest <- jaspResults[["fitTest"]][["object"]] + + if (jaspBase::isTryError(fitTest)) { + proportionalHazardsTable$setError(gettextf("The model test failed with the following message: %1$s", fitTest)) + return() + } + + fitTestSummary <- cbind.data.frame(param = rownames(fitTest[["table"]]), fitTest[["table"]]) + fitTestSummary$param[fitTestSummary$param == "GLOBAL"] <- gettext("Global") + fitTestSummary$param <- sapply(fitTestSummary$param, function(x) .saTermNames(x, c(options[["covariates"]], options[["factors"]]))) + + proportionalHazardsTable$setData(fitTestSummary) + proportionalHazardsTable$addFootnote(gettextf("Tests are performed using the %1$s survival times transformation.", options[["proportionalHazardsTransformation"]])) + + return() +} +.saspProportionalHazardsPlots <- function(jaspResults, dataset, options) { + + if (!is.null(jaspResults[["proportionalHazardsPlots"]])) + return() + + proportionalHazardsPlots <- createJaspContainer(title = gettext("Proporational Hazards Assumption Test Plots")) + proportionalHazardsPlots$dependOn(c(.saspDependencies, "proportionalHazardsPlot", "proportionalHazardsTransformation", "proportionalHazardsTestTerms")) + proportionalHazardsPlots$position <- 8 + jaspResults[["proportionalHazardsPlots"]] <- proportionalHazardsPlots + + if (!.saSurvivalReady(options)) { + surivalPlot <- createJaspPlot() + proportionalHazardsPlots[["waitingPlot"]] <- surivalPlot + return() + } + + fitTest <- jaspResults[["fitTest"]][["object"]] + + if (jaspBase::isTryError(fitTest)) { + surivalPlot <- createJaspPlot() + surivalPlot$setError(gettextf("The model test failed with the following message: %1$s", fitTest)) + proportionalHazardsPlots[["waitingPlot"]] <- surivalPlot + return() + } + + for(i in 1:(nrow(fitTest$table) - 1)) { + + tempVariable <- rownames(fitTest$table)[i] + tempFitTestPlot <- plot(fitTest, plot = FALSE, var = tempVariable) + + # adapted from the survival:::plot.cox.zph + tempDfPoints <- data.frame( + x = fitTest$x, + y = fitTest$y[,i] + ) + tempDfPrediction <- data.frame( + x = tempFitTestPlot$x, + y = tempFitTestPlot$y[,1] + ) + tempDfCiBand <- data.frame( + x = c(tempFitTestPlot$x, rev(tempFitTestPlot$x)), + y = c(tempFitTestPlot$y[,2], rev(tempFitTestPlot$y[,3])) + ) + + if (fitTest$transform == "log") { + tempDfPoints$x <- exp(tempDfPoints$x) + } + + # x-ticks + xTime <- fitTest$time + indx <- !duplicated(tempDfPoints$x) + aprX <- approx(tempDfPoints$x[indx], xTime[indx], seq(min(tempDfPoints$x), max(tempDfPoints$x), length = 5)) + + # y-ticks + yTicks <- jaspGraphs::getPrettyAxisBreaks(range(c(tempDfPoints$y, tempDfCiBand$y))) + + tempPlot <- ggplot2::ggplot() + + ggplot2::geom_polygon(data = tempDfCiBand, mapping = ggplot2::aes(x = x, y = y), fill = "grey", alpha = 0.5) + + jaspGraphs::geom_line(data = tempDfPrediction, mapping = ggplot2::aes(x = x, y = y)) + + jaspGraphs::geom_point(data = tempDfPoints, mapping = ggplot2::aes(x = x, y = y)) + + ggplot2::labs( + x = gettext("Time"), + y = gettext("Beta(t)") + ) + tempPlot <- tempPlot + + jaspGraphs::scale_x_continuous(breaks = aprX$x, labels = signif(aprX$y, 2)) + + jaspGraphs::scale_y_continuous(limits = range(yTicks), breaks = yTicks) + + tempPlot <- tempPlot + jaspGraphs::geom_rangeframe(sides = "bl") + jaspGraphs::themeJaspRaw() + + tempJaspPlot <- createJaspPlot( + plot = tempPlot, + title = .saTermNames(tempVariable, c(options[["covariates"]], options[["factors"]])), + width = 450, + height = 320 + ) + proportionalHazardsPlots[[paste0("plot", i)]] <- tempJaspPlot + } + + return() +} .saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 2ca827f..de548ad 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -272,4 +272,50 @@ Form SA.SurvivalPlot{} } + + Section + { + title: qsTr("Diagnostics") + + Group + { + title: qsTr("Proportional Hazards") + + DropDown + { + name: "proportionalHazardsTransformation" + label: qsTr("Transformation") + values: + [ + { label: qsTr("KM"), value: "km"}, + { label: qsTr("Rank"), value: "rank"}, + { label: qsTr("Identity"), value: "identity"} + ] + } + + CheckBox + { + name: "proportionalHazardsTestTerms" + label: qsTr("Test terms") + } + + CheckBox + { + name: "proportionalHazardsTable" + label: qsTr("Table") + } + + CheckBox + { + name: "proportionalHazardsPlot" + label: qsTr("Plot") + } + } + + CheckBox + { + name: "influentialObservationsTable" + label: qsTr("Influential observations table") + } + } } From 0e519ef2dff4a14bc898cfd3d9048f870b607a8c Mon Sep 17 00:00:00 2001 From: FBartos Date: Fri, 4 Oct 2024 16:55:56 +0200 Subject: [PATCH 10/24] add residuals and frailties --- R/commonsurvivalanalysis.R | 25 ++- R/semiparametricsurvivalanalysis.R | 168 +++++++++++++- inst/qml/SemiParametricSurvivalAnalysis.qml | 230 ++++++++++++++++---- 3 files changed, 376 insertions(+), 47 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index d2c0a0d..f8746e2 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -34,13 +34,14 @@ # only for (semi)parametric covariatesVariable <- Filter(function(s) s != "", options[["covariates"]]) strataVariable <- Filter(function(s) s != "", options[["strata"]]) - idVariable <- Filter(function(s) s != "", options[["id"]]) + # idVariable <- Filter(function(s) s != "", options[["id"]]) clusterVariable <- Filter(function(s) s != "", options[["cluster"]]) weightsVariable <- Filter(function(s) s != "", options[["weights"]]) + frailtyVariable <- Filter(function(s) s != "", options[["frailty"]]) dataset <- .readDataSetToEnd( columns.as.numeric = c(timeVariable, covariatesVariable, weightsVariable), - columns.as.factor = c(eventVariable, factorsVariable, strataVariable, idVariable, clusterVariable), + columns.as.factor = c(eventVariable, factorsVariable, strataVariable, clusterVariable, frailtyVariable), ) # clean from NAs @@ -126,7 +127,7 @@ interceptTerm <- TRUE } else if (type == "Cox") { # Cox proportional hazards always includes intercept - predictors <- .saGetPredictors(options, null = null) + predictors <- c(.saGetPredictors(options, null = null), .saGetFrailty(options)) interceptTerm <- TRUE } @@ -179,6 +180,24 @@ return(t) } +.saGetFrailty <- function(options) { + + if (options[["frailty"]] == "") + return() + + frailty <- sprintf( + "frailty(%1$s, distribution = '%2$s', method = '%3$s'%4$s%5$s)", + options[["frailty"]], + options[["frailtyDistribution"]], + options[["frailtyMethod"]], + if (options[["frailtyMethod"]] != "fixed") "" + else if (options[["frailtyMethodFixed"]] == "df") paste0("df = ", options[["frailtyMethodFixedDf"]]) + else if (options[["frailtyMethodFixed"]] == "theta") paste0("theta = ", options[["frailtyMethodFixedTheta"]]), + if (options[["frailtyMethod"]] == "t") paste0("tdf = ", options[["frailtyMethodTDf"]]) else "" + ) + + return(frailty) +} .saLifeTableTimes <- function(dataset, options) { times <- dataset[[switch( diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 5b1bbaf..b77401f 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -49,10 +49,15 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (options[["proportionalHazardsPlot"]]) .saspProportionalHazardsPlots(jaspResults, dataset, options) + .saspResidualsPlots(jaspResults, dataset, options) + return() } -.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", "strata", "id", "cluster", "modelTerms", "method") +.saspDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors", "covariates", + "strata", "id", "cluster", + "frailty", "frailtyDistribution", "frailtyMethod", "frailtyMethodTDf", "frailtyMethodFixed", "frailtyMethodFixedTheta", "frailtyMethodFixedDf", + "modelTerms", "method") .saspFitCox <- function(jaspResults, dataset, options) { @@ -69,7 +74,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state formula = .saGetFormula(options, type = "Cox", null = FALSE), data = dataset, method = options[["method"]], - id = if (options[["id"]] != "") dataset[[options[["id"]]]], + # id = if (options[["id"]] != "") dataset[[options[["id"]]]], cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], weights = if (options[["weights"]] != "") options[["weights"]] )) @@ -88,7 +93,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state formula = .saGetFormula(options, type = "Cox", null = TRUE), data = dataset, method = options[["method"]], - id = if (options[["id"]] != "") dataset[[options[["id"]]]], + # id = if (options[["id"]] != "") dataset[[options[["id"]]]], cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], weights = if (options[["weights"]] != "") options[["weights"]] )) @@ -251,8 +256,11 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (options[["cluster"]] != "") summaryTable$addFootnote(gettextf("Robust variance estimation based on %1$s.", options[["cluster"]])) - if (options[["id"]] != "") - summaryTable$addFootnote(gettextf("Subject identification based on %1$s.", options[["id"]])) + if (options[["frailty"]] != "") + summaryTable$addFootnote(gettextf("Frailty based on %1$s.", options[["frailty"]])) + + # if (options[["id"]] != "") + # summaryTable$addFootnote(gettextf("Subject identification based on %1$s.", options[["id"]])) return() } @@ -312,7 +320,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesTable$addColumnInfo(name = "param", title = "", type = "string") estimatesTable$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number") estimatesTable$addColumnInfo(name = "se", title = gettext("Standard Error"), type = "number") - if (options[["cluster"]] != "" || options[["id"]] != "") + if (options[["cluster"]] != "") # || options[["id"]] != "" estimatesTable$addColumnInfo(name = "rse", title = gettext("Robust Standard Error"), type = "number") if (options[["coefficientsConfidenceIntervals"]]) { overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientsConfidenceIntervalsLevel"]]) @@ -523,8 +531,156 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } +.saspResidualsPlots <- function(jaspResults, dataset, options) { + + residualPlotOptionTypes <- c("residualPlotResidualVsTime", "residualPlotResidualVsPredictors", + "residualPlotResidualVsPredicted", "residualPlotResidualHistogram") + + if (!any(unlist(options[residualPlotOptionTypes]))) + return() + + if (is.null(jaspResults[["residualsPlots"]])) { + + residualsPlots <- createJaspContainer(title = gettext("Residual Plots")) + residualsPlots$dependOn(c(.saspDependencies, residualPlotOptionTypes, "residualPlotResidualType")) + residualsPlots$position <- 9 + jaspResults[["residualsPlots"]] <- residualsPlots + + } else { + residualsPlots <- jaspResults[["residualsPlots"]] + } + + if (!.saSurvivalReady(options)) + return() + + fit <- jaspResults[["fit"]][["object"]] + + if (jaspBase::isTryError(fit)) + return() + + # compute the residuals + residuals <- try(residuals(fit, type = switch(options[["residualPlotResidualType"]], "scaledSchoenfeld" = "scaledsch", options[["residualPlotResidualType"]]))) + predictorsFit <- model.matrix(fit) + if (options[["residualPlotResidualType"]] %in% c("schoenfeld", "scaledSchoenfeld")) { + varIndx <- dataset[[options[["eventStatus"]]]] + } else { + varIndx <- rep(TRUE, nrow(dataset)) + } + + + ### create all requested plots + # residuals vs time + if (options[["residualPlotResidualVsTime"]] && is.null(residualsPlots[["residualPlotResidualVsTime"]])) { + + residualPlotResidualVsTime <- createJaspPlot(title = gettext("Residuals vs. Time"), dependencies = "residualPlotResidualVsTime", position = 1, width = 450, height = 320) + residualsPlots[["residualPlotResidualVsTime"]] <- residualPlotResidualVsTime + + if (jaspBase::isTryError(residuals)) + residualPlotResidualVsTime$setError(residuals) + + tempPlot <- try(.saspResidualsPlot(x = dataset[[options[["timeToEvent"]]]][varIndx], y = residuals, xlab = gettext("Time"), ylab = .saspResidualsPlotName(options))) + + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualVsTime$plotObject <- tempPlot + } + + # residuals vs predictors + if (options[["residualPlotResidualVsPredictors"]] && is.null(residualsPlots[["residualPlotResidualVsPredictors"]])) { + + residualPlotResidualVsPredictors <- createJaspContainer(title = gettext("Residual Plots")) + residualPlotResidualVsPredictors$dependOn("residualPlotResidualVsPredictors") + residualPlotResidualVsPredictors$position <- 2 + residualsPlots[["residualPlotResidualVsPredictors"]] <- residualPlotResidualVsPredictors + + if (dim(predictorsFit)[2] == 0) { + tempPlot <- createJaspPlot() + tempPlot$setError(gettext("No predictors in the model.")) + residualPlotResidualVsPredictors[["waitingPlot"]] <- tempPlot + } else if (jaspBase::isTryError(residuals)) { + tempPlot <- createJaspPlot() + tempPlot$setError(residuals) + residualPlotResidualVsPredictors[["waitingPlot"]] <- tempPlot + residualPlotResidualVsTime$setError(residuals) + } else { + for(i in 1:ncol(predictorsFit)) { + tempPredictorName <- .saTermNames(colnames(predictorsFit)[i], c(options[["covariates"]], options[["factors"]])) + residualsPlots[[paste0("residualPlotResidualVsPredictors", i)]] <- createJaspPlot( + plot = .saspResidualsPlot(x = predictorsFit[varIndx,i], y = residuals, xlab = tempPredictorName, ylab = .saspResidualsPlotName(options)), + title = gettextf("Residuals vs. %1$s", tempPredictorName), + position = i, + width = 450, + height = 320 + ) + } + } + } + + # residuals vs predicted + if (options[["residualPlotResidualVsPredicted"]] && is.null(residualsPlots[["residualPlotResidualVsPredicted"]])) { + + residualPlotResidualVsPredicted <- createJaspPlot(title = gettext("Residuals vs. Predicted"), dependencies = "residualPlotResidualVsPredicted", position = 3, width = 450, height = 320) + residualsPlots[["residualPlotResidualVsPredicted"]] <- residualPlotResidualVsPredicted + + if (jaspBase::isTryError(residuals)) + residualPlotResidualVsPredicted$setError(residuals) + + tempPlot <- try(.saspResidualsPlot(x = predict(fit)[varIndx], y = residuals, xlab = gettext("Predicted"), ylab = .saspResidualsPlotName(options))) + + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualVsPredicted$plotObject <- tempPlot + } + + # residuals histogram + if (options[["residualPlotResidualHistogram"]] && is.null(residualsPlots[["residualPlotResidualHistogram"]])) { + + residualPlotResidualHistogram <- createJaspPlot(title = gettext("Residuals Histogram"), dependencies = "residualPlotResidualHistogram", position = 4, width = 450, height = 320) + residualsPlots[["residualPlotResidualHistogram"]] <- residualPlotResidualHistogram + + if (jaspBase::isTryError(residuals)) + residualPlotResidualHistogram$setError(residuals) + + tempPlot <- try(jaspGraphs::jaspHistogram(residuals, xName = .saspResidualsPlotName(options))) + + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualHistogram$plotObject <- tempPlot + } + + return() +} +.saspResidualsPlot <- function(x, y, xlab, ylab) { + xTicks <- jaspGraphs::getPrettyAxisBreaks(x) + yTicks <- jaspGraphs::getPrettyAxisBreaks(y) + tempPlot <- ggplot2::ggplot() + + jaspGraphs::geom_point(mapping = ggplot2::aes(x = x, y = y)) + + ggplot2::labs( + x = xlab, + y = ylab + ) + tempPlot <- tempPlot + + jaspGraphs::scale_x_continuous(limits = range(xTicks), breaks = xTicks) + + jaspGraphs::scale_y_continuous(limits = range(yTicks), breaks = yTicks) + + tempPlot <- tempPlot + jaspGraphs::geom_rangeframe(sides = "bl") + jaspGraphs::themeJaspRaw() + + return(tempPlot) +} +.saspResidualsPlotName <- function(options) { + switch( + options[["residualPlotResidualType"]], + "martingale" = gettext("Martingale Residuals"), + "score" = gettext("Score Residuals"), + "schoenfeld" = gettext("Schoenfeld Residuals"), + "scaledSchoenfeld" = gettext("Scaled Schoenfeld Residuals") + ) +} .saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { # extract coefficients diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index de548ad..88ab14e 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -27,14 +27,14 @@ Form { VariablesForm { - removeInvisibles: true +// removeInvisibles: true height: 1000 AvailableVariablesList { name: "allVariablesList" } - +/* AssignedVariablesList { name: "intervalStart" @@ -52,7 +52,7 @@ Form singleVariable: true visible: censoringTypeCounting.checked } - +*/ AssignedVariablesList { name: "timeToEvent" @@ -93,28 +93,6 @@ Form allowedColumns: ["nominal"] } - AssignedVariablesList - { - name: "strata" - title: qsTr("Strata") - allowedColumns: ["nominal"] - } - - AssignedVariablesList - { - name: "id" - title: qsTr("Id") - allowedColumns: ["nominal"] - singleVariable: true - } - - AssignedVariablesList - { - name: "cluster" - title: qsTr("Cluster") - allowedColumns: ["nominal"] - singleVariable: true - } AssignedVariablesList { @@ -164,7 +142,144 @@ Form Section { - title: qsTr("Model") + title: qsTr("Strata, Clustering, and Frailty") + + VariablesForm + { + height: 400 + + AvailableVariablesList + { + name: "allVariablesList2" + } + + AssignedVariablesList + { + name: "strata" + title: qsTr("Strata") + allowedColumns: ["nominal"] + } + + // TODO: allow only if multiple outcomes are possible + /* + AssignedVariablesList + { + name: "id" + title: qsTr("Id") + allowedColumns: ["nominal"] + singleVariable: true + } + */ + + // TODO: allow either cluster/id or frailty + AssignedVariablesList + { + name: "cluster" + title: qsTr("Cluster") + allowedColumns: ["nominal"] + singleVariable: true + } + + AssignedVariablesList + { + name: "frailty" + title: qsTr("Frailty") + allowedColumns: ["nominal"] + singleVariable: true + } + } + + Group + { + title: qsTr("Frailty") + // enable if frailty selected + + DropDown + { + name: "frailtyDistribution" + id: frailtyDistribution + label: qsTr("Distribution") + values: + [ + { label: qsTr("Gamma"), value: "gamma"}, + { label: qsTr("Gaussian"), value: "gaussian"}, + { label: qsTr("T"), value: "t"} + ] + } + + DropDown + { + name: "frailtyMethod" + id: frailtyMethod + label: qsTr("Method") + values: (function() { + if (frailtyDistribution.value == "gamma") { + return [ + { label: qsTr("EM"), value: "em"}, + { label: qsTr("AIC"), value: "aic"}, + { label: qsTr("Fixed"), value: "fixed"} + ]; + } else if (design.value == "gaussian") { + return [ + { label: qsTr("REML"), value: "reml"}, + { label: qsTr("AIC"), value: "aic"}, + { label: qsTr("Fixed"), value: "fixed"} + ]; + } else if (design.value == "t") { + return [ + { label: qsTr("AIC"), value: "aic"}, + { label: qsTr("Fixed"), value: "fixed"} + ]; + } + })() + } + + DoubleField + { + label: qsTr("Df") + visible: frailtyDistribution.value == "t" + name: "frailtyMethodTDf" + defaultValue: 5 + } + + Group + { + visible: frailtyMethod.value == "fixed" + + DropDown + { + name: "frailtyMethodFixed" + id: frailtyMethodFixed + label: qsTr("Fix") + values: + [ + { label: qsTr("Theta"), value: "theta"}, + { label: qsTr("Df"), value: "df"} + ] + } + + DoubleField + { + label: qsTr("Theta") + visible: frailtyMethodFixed.value == "theta" + name: "frailtyMethodFixedTheta" + defaultValue: 0 + } + + DoubleField + { + label: qsTr("Df") + visible: frailtyMethodFixed.value == "df" + name: "frailtyMethodFixedDf" + defaultValue: 0 + } + } + } + } + + Section + { + title: qsTr("Model") VariablesForm { @@ -181,13 +296,14 @@ Form ModelTermsList { width: parent.width * 5 / 9 + id: selectedModelTerms } } } Section { - title: qsTr("Statistics") + title: qsTr("Statistics") Group { @@ -225,8 +341,6 @@ Form Group { title: qsTr("Coefficients") - columns: 2 - Layout.columnSpan: 2 Group { @@ -281,6 +395,18 @@ Form { title: qsTr("Proportional Hazards") + CheckBox + { + name: "proportionalHazardsTable" + label: qsTr("Table") + } + + CheckBox + { + name: "proportionalHazardsPlot" + label: qsTr("Plot") + } + DropDown { name: "proportionalHazardsTransformation" @@ -299,23 +425,51 @@ Form label: qsTr("Test terms") } + } + + Group + { + title: qsTr("Residuals Plots") + CheckBox { - name: "proportionalHazardsTable" - label: qsTr("Table") + name: "residualPlotResidualVsTime" + label: qsTr("Residuals vs. time") +// TODO: +// enabled: residualPlotResidualType.value == "martingale" || censoringTypeCounting.length > 0 } CheckBox { - name: "proportionalHazardsPlot" - label: qsTr("Plot") + name: "residualPlotResidualVsPredictors" + label: qsTr("Residuals vs. predictors") } - } - CheckBox - { - name: "influentialObservationsTable" - label: qsTr("Influential observations table") + CheckBox + { + name: "residualPlotResidualVsPredicted" + label: qsTr("Residuals vs. predicted") + } + + CheckBox + { + name: "residualPlotResidualHistogram" + label: qsTr("Residuals histogram") + } + + DropDown + { + name: "residualPlotResidualType" + id: residualPlotResidualType + label: qsTr("Type") + values: + [ + { label: qsTr("Martingale"), value: "martingale"}, + { label: qsTr("Score"), value: "score"}, + { label: qsTr("Schoenfeld"), value: "schoenfeld"}, + { label: qsTr("Scaled Schoenfeld"), value: "scaledSchoenfeld"} + ] + } } } } From 22ab5bde5ed8fb62bac894eafa757af26d56deae Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 7 Oct 2024 17:54:42 +0200 Subject: [PATCH 11/24] add frailty handling vol1 --- DESCRIPTION | 3 +- R/semiparametricsurvivalanalysis.R | 73 ++++++++++++++++----- inst/qml/SemiParametricSurvivalAnalysis.qml | 8 ++- 3 files changed, 65 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1677296..290ea60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,8 +9,9 @@ Maintainer: JASP Team Description: Perform analyses of censored time to event data. License: GPL (>= 2) Encoding: UTF-8 +Depends: + survival Imports: - survival, ggsurvfit, jaspBase, jaspGraphs diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index b77401f..00dea73 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -26,10 +26,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state .saspFitCox(jaspResults, dataset, options) .saspFitCoxAssumptionTest(jaspResults, dataset, options) + saveRDS(jaspResults[["fitNull"]]$object, file = "C:/JASP/fitNull.RDS") saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") .saspSummaryTable(jaspResults, dataset, options) .saspTestsTable(jaspResults, dataset, options) + if (.saspHasFrailty(options)) + .saspFrailtyTable(jaspResults, dataset, options) if (options[["modelFit"]]) .saspModelFitTable(jaspResults, dataset, options) @@ -78,8 +81,6 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], weights = if (options[["weights"]] != "") options[["weights"]] )) - # fix scoping in ggsurvplot - fit$call$formula <- eval(fit$call$formula) jaspResults[["fit"]]$object <- fit } @@ -89,6 +90,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitNullContainer <- createJaspState() fitNullContainer$dependOn(.saspDependencies) jaspResults[["fitNull"]] <- fitNullContainer + fitNull <- try(coxph( formula = .saGetFormula(options, type = "Cox", null = TRUE), data = dataset, @@ -97,8 +99,6 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state cluster = if (options[["cluster"]] != "") dataset[[options[["cluster"]]]], weights = if (options[["weights"]] != "") options[["weights"]] )) - # fix scoping in ggsurvplot - fitNull$call$formula <- eval(fitNull$call$formula) jaspResults[["fitNull"]]$object <- fitNull } @@ -209,7 +209,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state # create empty table summaryTable$addColumnInfo(name = "mod", title = gettext("Model"), type = "string") summaryTable$addColumnInfo(name = "loglik", title = gettext("Log Lik."), type = "number") - summaryTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") + summaryTable$addColumnInfo(name = "df", title = gettext("df"), type = if (.saspHasFrailty(options)) "number" else "integer") # summaryTable$addColumnInfo(name = "pvl", title = gettext("p"), type = "pvalue") summaryTable$addColumnInfo(name = "aic", title = gettext("AIC"), type = "number", format="dp:3") summaryTable$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number", format="dp:3") @@ -221,7 +221,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitNull <- jaspResults[["fitNull"]][["object"]] if (jaspBase::isTryError(fitNull)) - summaryTable$addFootnote(fitNull, symbol = gettextf("The null model failed with the following message:")) + summaryTable$addFootnote(fitNull, symbol = gettext("The null model failed with the following message:")) else summaryTable$addRows(list( "mod" = "H\u2080", @@ -233,7 +233,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state )) if (jaspBase::isTryError(fit)) - summaryTable$setError(fit, symbol = gettextf("The model failed with the following message:")) + summaryTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) else summaryTable$addRows(list( "mod" = "H\u2081", @@ -286,7 +286,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state fitNull <- jaspResults[["fitNull"]][["object"]] if (jaspBase::isTryError(fitNull)) - modelFitTable$addFootnote(fitNull, symbol = gettextf("The null model failed with the following message:")) + modelFitTable$addFootnote(fitNull, symbol = gettext("The null model failed with the following message:")) else modelFitTable$addRows(list( "mod" = "H\u2080", @@ -295,7 +295,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state )) if (jaspBase::isTryError(fit)) - modelFitTable$setError(fit, symbol = gettextf("The model failed with the following message:")) + modelFitTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) else modelFitTable$addRows(list( "mod" = "H\u2081", @@ -305,6 +305,43 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } +.saspFrailtyTable <- function(jaspResults, dataset, options) { + + if (!is.null(jaspResults[["frailtyTable"]])) + return() + + frailtyTable <- createJaspTable(title = gettext("Frailty Summary Table")) + frailtyTable$dependOn(.saspDependencies) + frailtyTable$position <- 1.1 + jaspResults[["frailtyTable"]] <- frailtyTable + + # create empty table + frailtyTable$addColumnInfo(name = "param", title = "", type = "string") + frailtyTable$addColumnInfo(name = "variance", title = gettext("Variance"), type = "number") + frailtyTable$addColumnInfo(name = "chisq", title = gettext("Chi Square"), type = "number") + frailtyTable$addColumnInfo(name = "df", title = gettext("df"), type = "number") + frailtyTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") + + if (!.saSurvivalReady(options)) + return() + + fit <- jaspResults[["fit"]][["object"]] + + if (jaspBase::isTryError(fit)) + return() + + fitSummary <- summary(fit) + + frailtyTable$addRows(list( + "param" = options[["frailty"]], + "variance" = fit$history[[1]]$theta, + "chisq" = fitSummary$coefficients[grepl("frailty", rownames(fitSummary$coefficients)),"Chisq"], + "df" = fitSummary$coefficients[grepl("frailty", rownames(fitSummary$coefficients)),"DF"], + "p" = fitSummary$coefficients[grepl("frailty", rownames(fitSummary$coefficients)),"p"] + )) + + return() +} .saspEstimatesTable <- function(jaspResults, dataset, options) { if (!is.null(jaspResults[["estimatesTable"]])) @@ -352,7 +389,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080") if (jaspBase::isTryError(fit)) { - estimatesTable$setError(fit, symbol = gettextf("The model failed with the following message:")) + estimatesTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) return() } else estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081")) @@ -402,7 +439,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimates <- .saspCoxFitSummary(fitNull, options, "H\u2080", HR = TRUE) if (jaspBase::isTryError(fit)) { - hazardRatioTable$setError(fit, symbol = gettextf("The model failed with the following message:")) + hazardRatioTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) return() } else estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE)) @@ -681,7 +718,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "scaledSchoenfeld" = gettext("Scaled Schoenfeld Residuals") ) } -.saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { +.saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { # extract coefficients estimatesFit <- summary(fit)$coefficients @@ -693,13 +730,13 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "pval" = "Pr(>|z|)" ) namesEstimatesFit <- colnames(estimatesFit) - estimatesFit <- estimatesFit[,namesEstimatesFit %in% toExtract, drop = FALSE] + estimatesFit <- estimatesFit[!grepl("frailty", rownames(estimatesFit)),namesEstimatesFit %in% toExtract, drop = FALSE] # make into a data.frame - if (is.null(estimatesFit)) return() - else if (is.null(dim(estimatesFit))) estimatesFit <- data.frame(t(estimatesFit)) - else estimatesFit <- data.frame(estimatesFit) + if (is.null(estimatesFit) || nrow(estimatesFit) == 0) return() + else if (is.null(dim(estimatesFit))) estimatesFit <- data.frame(t(estimatesFit)) + else estimatesFit <- data.frame(estimatesFit) # fix column names colnames(estimatesFit) <- names(toExtract)[toExtract %in% namesEstimatesFit] @@ -725,4 +762,6 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return(estimatesFit) } - +.saspHasFrailty <- function(options) { + return(options[["frailty"]] != "") +} diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 88ab14e..86aca2d 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -156,6 +156,7 @@ Form AssignedVariablesList { name: "strata" + id: strata title: qsTr("Strata") allowedColumns: ["nominal"] } @@ -175,6 +176,8 @@ Form AssignedVariablesList { name: "cluster" + id: cluster + enabled: frailty.count == 0 title: qsTr("Cluster") allowedColumns: ["nominal"] singleVariable: true @@ -183,6 +186,8 @@ Form AssignedVariablesList { name: "frailty" + id: frailty + enabled: cluster.count == 0 title: qsTr("Frailty") allowedColumns: ["nominal"] singleVariable: true @@ -192,7 +197,7 @@ Form Group { title: qsTr("Frailty") - // enable if frailty selected + enabled: frailty.count > 0 DropDown { @@ -443,6 +448,7 @@ Form { name: "residualPlotResidualVsPredictors" label: qsTr("Residuals vs. predictors") + enabled:selectedModelTerms.count > 0 } CheckBox From bc9efadfba71babf2fe4128632aeccfa133cfa5f Mon Sep 17 00:00:00 2001 From: FBartos Date: Tue, 8 Oct 2024 14:39:00 +0200 Subject: [PATCH 12/24] finish semi-parametric --- R/commonsurvivalanalysis.R | 85 +++++---- R/nonparametricsurvivalanalysis.R | 5 - R/semiparametricsurvivalanalysis.R | 180 +++++++++++--------- inst/qml/SemiParametricSurvivalAnalysis.qml | 48 ++++-- 4 files changed, 185 insertions(+), 133 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index f8746e2..380a01e 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -1,11 +1,7 @@ # TODO: # qml: -# - make the event indicator be the second lvl of the event status variable # - make "lifeTableStepsTo" correspond to the maximum time # - make "lifeTableStepsSize" correspond to the maxiumum time/10 -# R: -# - convenient function for making factor level parameter names nice (in regression tables)? -# - add frailty to coxph .saSurvivalReady <- function(options) { @@ -15,6 +11,16 @@ "right" = options[["eventStatus"]] != "" && options[["timeToEvent"]] != "" ) + # deal with specifying fixed variance / dfs for frailty (default is zero which is an invalid setting --- user has to specify something themself) + if (ready && !is.null(options[["frailty"]]) && options[["frailty"]] != "" && options[["frailtyMethod"]] == "fixed") { + ready <- ready && switch( + options[["frailtyMethodFixed"]], + "theta" = options[["frailtyMethodFixedTheta"]] > 0, + "df" = options[["frailtyMethodFixedDf"]] > 0 + ) + } + + return(ready) } .saReadDataset <- function(dataset, options) { @@ -189,10 +195,14 @@ "frailty(%1$s, distribution = '%2$s', method = '%3$s'%4$s%5$s)", options[["frailty"]], options[["frailtyDistribution"]], - options[["frailtyMethod"]], + # simplifying GUI for fixed (instead of having fixed.theta and fixed.df) + if (options[["frailtyMethod"]] == "fixed" && options[["frailtyMethodFixed"]] == "theta") "fixed" + else if(options[["frailtyMethod"]] == "fixed" && options[["frailtyMethodFixed"]] == "df") "df" + else options[["frailtyMethod"]], + # adding the fixed part if (options[["frailtyMethod"]] != "fixed") "" - else if (options[["frailtyMethodFixed"]] == "df") paste0("df = ", options[["frailtyMethodFixedDf"]]) - else if (options[["frailtyMethodFixed"]] == "theta") paste0("theta = ", options[["frailtyMethodFixedTheta"]]), + else if (options[["frailtyMethodFixed"]] == "df") paste0(", df = ", options[["frailtyMethodFixedDf"]]) + else if (options[["frailtyMethodFixed"]] == "theta") paste0(", theta = ", options[["frailtyMethodFixedTheta"]]), if (options[["frailtyMethod"]] == "t") paste0("tdf = ", options[["frailtyMethodTDf"]]) else "" ) @@ -220,10 +230,15 @@ .saTermNames <- function(varName, variables) { # based on jaspMixedModels::.mmVariableNames - if (varName == "(Intercept)") - return("Intercept") - if (varName == "Global") - return("Global") + # deal with non-standard columns names + if (!grepl("JaspColumn", varName)) { + if (varName == "(Intercept)") + return("Intercept") + if (varName == "Global") + return("Global") + if (grepl("gamma:", varName, fixed = TRUE) || grepl("gauss:", varName, fixed = TRUE) || grepl("t:", varName, fixed = TRUE)) + return(paste0("(frailty) ", varName)) + } for (vn in variables) { inf <- regexpr(vn, varName, fixed = TRUE) @@ -305,30 +320,34 @@ } if (type == "KM") - tempPlot <- ggsurvfit::survfit2(.saGetFormula(options, type = type), data = dataset) |> - ggsurvfit::ggsurvfit( - type = switch( - options[["plotType"]], - "survival" = "survival", - "risk" = "risk", - "cumulativeHazard" = "cumhaz", - "complementaryLogLog" = "cloglog" - ), - linewidth = 1 - ) + tempPlot <- try(ggsurvfit::ggsurvfit( + x = ggsurvfit::survfit2(.saGetFormula(options, type = type), data = dataset), + type = switch( + options[["plotType"]], + "survival" = "survival", + "risk" = "risk", + "cumulativeHazard" = "cumhaz", + "complementaryLogLog" = "cloglog" + ), + linewidth = 1 + )) else if (type == "Cox") - tempPlot <- ggsurvfit::survfit2(fit) |> - ggsurvfit::ggsurvfit( - type = switch( - options[["plotType"]], - "survival" = "survival", - "risk" = "risk", - "cumulativeHazard" = "cumhaz", - "complementaryLogLog" = "cloglog" - ), - linewidth = 1 - ) + tempPlot <- try(ggsurvfit::ggsurvfit( + x = ggsurvfit::survfit2(fit), + type = switch( + options[["plotType"]], + "survival" = "survival", + "risk" = "risk", + "cumulativeHazard" = "cumhaz", + "complementaryLogLog" = "cloglog" + ), + linewidth = 1 + )) + if (jaspBase::isTryError(tempPlot)) { + surivalPlot$setError(tempPlot) + return() + } if (options[["plotConfidenceInterval"]]) tempPlot <- tempPlot + ggsurvfit::add_confidence_interval() diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 73059e3..9f98e38 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -23,16 +23,11 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = if (.saSurvivalReady(options)) dataset <- .saReadDataset(dataset, options) - saveRDS(options, file = "C:/JASP/options.RDS") - saveRDS(dataset, file = "C:/JASP/dataset.RDS") - if (.saSurvivalReady(options)) { .sanpFitKaplanMeier(jaspResults, dataset, options) .sanpFitTests(jaspResults, dataset, options) } - saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") - .sanpSummaryTable(jaspResults, dataset, options) .sanpTestsTable(jaspResults, dataset, options) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 00dea73..57ce18b 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -20,15 +20,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (.saSurvivalReady(options)) dataset <- .saReadDataset(dataset, options) - saveRDS(options, file = "C:/JASP/options.RDS") - saveRDS(dataset, file = "C:/JASP/dataset.RDS") - .saspFitCox(jaspResults, dataset, options) .saspFitCoxAssumptionTest(jaspResults, dataset, options) - saveRDS(jaspResults[["fitNull"]]$object, file = "C:/JASP/fitNull.RDS") - saveRDS(jaspResults[["fit"]]$object, file = "C:/JASP/fit.RDS") - .saspSummaryTable(jaspResults, dataset, options) .saspTestsTable(jaspResults, dataset, options) if (.saspHasFrailty(options)) @@ -129,11 +123,11 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (jaspBase::isTryError(fit)) return() - fitTest <- cox.zph( + fitTest <- try(cox.zph( fit = fit, transform = options[["proportionalHazardsTransformation"]], terms = options[["proportionalHazardsTestTerms"]] - ) + )) jaspResults[["fitTest"]]$object <- fitTest @@ -154,7 +148,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state testsTable$addColumnInfo(name = "test", title = gettext("Test"), type = "string") testsTable$addColumnInfo(name = "chiSqr", title = gettext("Chi Square"), type = "number") - testsTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") + testsTable$addColumnInfo(name = "df", title = gettext("df"), type = if (.saspHasFrailty(options)) "number" else "integer") testsTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") if (length(options[["factors"]]) == 0 && length(options[["covariates"]]) == 0) { @@ -174,7 +168,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state )) } - if (options[["testsWald"]]) { + if (options[["testsWald"]] && options[["frailty"]] == "") { testsTable$addRows(list( "test" = gettext("Wald"), "chiSqr" = fitSummary[["waldtest"]][["test"]], @@ -183,7 +177,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state )) } - if (options[["testsScore"]]) { + if (options[["testsScore"]] && options[["frailty"]] == "") { testsTable$addRows(list( "test" = gettext("Score"), "chiSqr" = fitSummary[["sctest"]][["test"]], @@ -232,17 +226,19 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "bic" = BIC(fitNull) )) - if (jaspBase::isTryError(fit)) + if (jaspBase::isTryError(fit)) { summaryTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) - else - summaryTable$addRows(list( - "mod" = "H\u2081", - "loglik" = as.numeric(logLik(fit)), - "df" = attr(logLik(fit), "df"), + return() + } + + summaryTable$addRows(list( + "mod" = "H\u2081", + "loglik" = as.numeric(logLik(fit)), + "df" = attr(logLik(fit), "df"), # "pvl" = pchisq(2 * (fit$loglik[2] - fit$loglik[1]), df = attr(logLik(fit), "df"), lower.tail = FALSE), - "aic" = AIC(fit), - "bic" = BIC(fit) - )) + "aic" = AIC(fit), + "bic" = BIC(fit) + )) summaryTable$addFootnote(gettextf("%1$i observations with %2$i events.", fit[["n"]], fit[["nevent"]])) @@ -294,14 +290,16 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "concordanceSe" = fitNull[["concordance"]][["std"]] )) - if (jaspBase::isTryError(fit)) + if (jaspBase::isTryError(fit)) { modelFitTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) - else - modelFitTable$addRows(list( - "mod" = "H\u2081", - "concordanceEstimate" = fit[["concordance"]][["concordance"]], - "concordanceSe" = fit[["concordance"]][["std"]] - )) + return() + } + + modelFitTable$addRows(list( + "mod" = "H\u2081", + "concordanceEstimate" = fit[["concordance"]][["concordance"]], + "concordanceSe" = fit[["concordance"]][["std"]] + )) return() } @@ -357,7 +355,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state estimatesTable$addColumnInfo(name = "param", title = "", type = "string") estimatesTable$addColumnInfo(name = "est", title = gettext("Estimate"), type = "number") estimatesTable$addColumnInfo(name = "se", title = gettext("Standard Error"), type = "number") - if (options[["cluster"]] != "") # || options[["id"]] != "" + if (options[["cluster"]] != "" || options[["frailty"]] != "") # || options[["id"]] != "" estimatesTable$addColumnInfo(name = "rse", title = gettext("Robust Standard Error"), type = "number") if (options[["coefficientsConfidenceIntervals"]]) { overtitle <- gettextf("%.0f%% CI", 100 * options[["coefficientsConfidenceIntervalsLevel"]]) @@ -391,8 +389,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (jaspBase::isTryError(fit)) { estimatesTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) return() - } else - estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081")) + } + + estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081")) if (!is.null(estimates) && options[["vovkSellke"]]) @@ -411,7 +410,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() hazardRatioTable <- createJaspTable(title = gettext("Hazard Ratios Estimates Table")) - hazardRatioTable$dependOn(c(.saspDependencies, "coefficientHazardRatioEstimates", "coefficientsConfidenceIntervals", "coefficientsConfidenceIntervalsLevel")) + hazardRatioTable$dependOn(c(.saspDependencies, "coefficientHazardRatioEstimates", "coefficientsConfidenceIntervals", "coefficientsConfidenceIntervalsLevel", "coefficientHazardRatioEstimatesIncludeFrailty")) hazardRatioTable$position <- 5 jaspResults[["hazardRatioTable"]] <- hazardRatioTable @@ -441,8 +440,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (jaspBase::isTryError(fit)) { hazardRatioTable$setError(gettextf("The model failed with the following message: %1$s.", fit)) return() - } else - estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE)) + } + + estimates <- rbind(estimates, .saspCoxFitSummary(fit, options, "H\u2081", HR = TRUE)) if (!is.null(estimates) && options[["vovkSellke"]]) @@ -465,7 +465,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state # create empty table proportionalHazardsTable$addColumnInfo(name = "param", title = "", type = "string") proportionalHazardsTable$addColumnInfo(name = "chisq", title = gettext("Chi Square"), type = "number") - proportionalHazardsTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") + proportionalHazardsTable$addColumnInfo(name = "df", title = gettext("df"), type = if (.saspHasFrailty(options)) "number" else "integer") proportionalHazardsTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") if (!.saSurvivalReady(options)) @@ -612,15 +612,16 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state residualPlotResidualVsTime <- createJaspPlot(title = gettext("Residuals vs. Time"), dependencies = "residualPlotResidualVsTime", position = 1, width = 450, height = 320) residualsPlots[["residualPlotResidualVsTime"]] <- residualPlotResidualVsTime - if (jaspBase::isTryError(residuals)) + if (jaspBase::isTryError(residuals)) { residualPlotResidualVsTime$setError(residuals) + } else { + tempPlot <- try(.saspResidualsPlot(x = dataset[[options[["timeToEvent"]]]][varIndx], y = residuals, xlab = gettext("Time"), ylab = .saspResidualsPlotName(options))) - tempPlot <- try(.saspResidualsPlot(x = dataset[[options[["timeToEvent"]]]][varIndx], y = residuals, xlab = gettext("Time"), ylab = .saspResidualsPlotName(options))) - - if (jaspBase::isTryError(tempPlot)) - residualsPlots$setError(tempPlot) - else - residualPlotResidualVsTime$plotObject <- tempPlot + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualVsTime$plotObject <- tempPlot + } } # residuals vs predictors @@ -642,6 +643,11 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state residualPlotResidualVsTime$setError(residuals) } else { for(i in 1:ncol(predictorsFit)) { + + # skip frailty terms + if (grepl("frailty", colnames(predictorsFit)[i])) + next + tempPredictorName <- .saTermNames(colnames(predictorsFit)[i], c(options[["covariates"]], options[["factors"]])) residualsPlots[[paste0("residualPlotResidualVsPredictors", i)]] <- createJaspPlot( plot = .saspResidualsPlot(x = predictorsFit[varIndx,i], y = residuals, xlab = tempPredictorName, ylab = .saspResidualsPlotName(options)), @@ -660,15 +666,16 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state residualPlotResidualVsPredicted <- createJaspPlot(title = gettext("Residuals vs. Predicted"), dependencies = "residualPlotResidualVsPredicted", position = 3, width = 450, height = 320) residualsPlots[["residualPlotResidualVsPredicted"]] <- residualPlotResidualVsPredicted - if (jaspBase::isTryError(residuals)) + if (jaspBase::isTryError(residuals)) { residualPlotResidualVsPredicted$setError(residuals) + } else { + tempPlot <- try(.saspResidualsPlot(x = predict(fit)[varIndx], y = residuals, xlab = gettext("Predicted"), ylab = .saspResidualsPlotName(options))) - tempPlot <- try(.saspResidualsPlot(x = predict(fit)[varIndx], y = residuals, xlab = gettext("Predicted"), ylab = .saspResidualsPlotName(options))) - - if (jaspBase::isTryError(tempPlot)) - residualsPlots$setError(tempPlot) - else - residualPlotResidualVsPredicted$plotObject <- tempPlot + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualVsPredicted$plotObject <- tempPlot + } } # residuals histogram @@ -677,15 +684,16 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state residualPlotResidualHistogram <- createJaspPlot(title = gettext("Residuals Histogram"), dependencies = "residualPlotResidualHistogram", position = 4, width = 450, height = 320) residualsPlots[["residualPlotResidualHistogram"]] <- residualPlotResidualHistogram - if (jaspBase::isTryError(residuals)) + if (jaspBase::isTryError(residuals)) { residualPlotResidualHistogram$setError(residuals) + } else { + tempPlot <- try(jaspGraphs::jaspHistogram(residuals, xName = .saspResidualsPlotName(options))) - tempPlot <- try(jaspGraphs::jaspHistogram(residuals, xName = .saspResidualsPlotName(options))) - - if (jaspBase::isTryError(tempPlot)) - residualsPlots$setError(tempPlot) - else - residualPlotResidualHistogram$plotObject <- tempPlot + if (jaspBase::isTryError(tempPlot)) + residualsPlots$setError(tempPlot) + else + residualPlotResidualHistogram$plotObject <- tempPlot + } } return() @@ -718,45 +726,61 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state "scaledSchoenfeld" = gettext("Scaled Schoenfeld Residuals") ) } -.saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { - - # extract coefficients - estimatesFit <- summary(fit)$coefficients - toExtract <- c( - "est" = "coef", - "se" = "se(coef)", - "rse" = "robust se", - "zval" = "z", - "pval" = "Pr(>|z|)" - ) - namesEstimatesFit <- colnames(estimatesFit) - estimatesFit <- estimatesFit[!grepl("frailty", rownames(estimatesFit)),namesEstimatesFit %in% toExtract, drop = FALSE] +.saspCoxFitSummary <- function(fit, options, model, HR = FALSE) { + if (length(coef(fit)) == 0) + return() + + if (HR) { + + estimatesFit <- cbind( + "est" = exp(coef(fit)), + exp(confint(fit, level = options[["coefficientsConfidenceIntervalsLevel"]])) + ) + + if (!options[["coefficientHazardRatioEstimatesIncludeFrailty"]]) + estimatesFit <- estimatesFit[grepl("JaspColumn",rownames(estimatesFit)),,drop=FALSE] + + } else { + + estimatesFit <- summary(fit)$coefficients + toExtract <- c( + "est" = "coef", + "se" = "se(coef)", + "rse" = if (.saspHasFrailty(options)) "se2" else "robust se", + "zval" = if (.saspHasFrailty(options)) "Chisq" else "z", + "pval" = if (.saspHasFrailty(options)) "p" else "Pr(>|z|)" + ) + namesEstimatesFit <- colnames(estimatesFit) + estimatesFit <- estimatesFit[!grepl("frailty", rownames(estimatesFit)), namesEstimatesFit %in% toExtract, drop = FALSE] + } # make into a data.frame if (is.null(estimatesFit) || nrow(estimatesFit) == 0) return() else if (is.null(dim(estimatesFit))) estimatesFit <- data.frame(t(estimatesFit)) else estimatesFit <- data.frame(estimatesFit) - # fix column names - colnames(estimatesFit) <- names(toExtract)[toExtract %in% namesEstimatesFit] + # if there is frailty, change Chisq (with 1 df) to z-value + if (!HR && (.saspHasFrailty(options))) + estimatesFit$Chisq <- sign(estimatesFit$coef) * sqrt(estimatesFit$Chisq) + + # fix names + if (!HR) + colnames(estimatesFit) <- names(toExtract)[toExtract %in% namesEstimatesFit] + else + colnames(estimatesFit) <- c("est", "lower", "upper") # add confidence intervals - if (options[["coefficientsConfidenceIntervals"]]) { + if (!HR && options[["coefficientsConfidenceIntervals"]]) { estimatesFit$lower <- estimatesFit[,"est"] + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] estimatesFit$upper <- estimatesFit[,"est"] - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] } - # transform to HR if needed - if (HR) { - estimatesFit <- estimatesFit[,!colnames(estimatesFit) %in% c("se", "rse", "zval", "pval"), drop = FALSE] - estimatesFit <- exp(estimatesFit) - } - estimatesFit <- cbind( "model" = "", "param" = sapply(rownames(estimatesFit), function(x) .saTermNames(x, c(options[["covariates"]], options[["factors"]]))), - estimatesFit) + estimatesFit + ) estimatesFit[1, "model"] <- model diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 86aca2d..e1fb281 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -27,14 +27,14 @@ Form { VariablesForm { -// removeInvisibles: true - height: 1000 + removeInvisibles: true + height: 850 AvailableVariablesList { name: "allVariablesList" } -/* + AssignedVariablesList { name: "intervalStart" @@ -52,7 +52,7 @@ Form singleVariable: true visible: censoringTypeCounting.checked } -*/ + AssignedVariablesList { name: "timeToEvent" @@ -142,7 +142,7 @@ Form Section { - title: qsTr("Strata, Clustering, and Frailty") + title: qsTr("Strata, Cluster, and Frailty") VariablesForm { @@ -172,7 +172,6 @@ Form } */ - // TODO: allow either cluster/id or frailty AssignedVariablesList { name: "cluster" @@ -224,13 +223,13 @@ Form { label: qsTr("AIC"), value: "aic"}, { label: qsTr("Fixed"), value: "fixed"} ]; - } else if (design.value == "gaussian") { + } else if (frailtyDistribution.value == "gaussian") { return [ { label: qsTr("REML"), value: "reml"}, { label: qsTr("AIC"), value: "aic"}, { label: qsTr("Fixed"), value: "fixed"} ]; - } else if (design.value == "t") { + } else if (frailtyDistribution.value == "t") { return [ { label: qsTr("AIC"), value: "aic"}, { label: qsTr("Fixed"), value: "fixed"} @@ -332,12 +331,14 @@ Form CheckBox { name: "testsWald" + enabled: frailty.count == 0 label: qsTr("Wald") } CheckBox { name: "testsScore" + enabled: frailty.count == 0 label: qsTr("Score (log-rank)") } } @@ -367,6 +368,13 @@ Form name: "coefficientHazardRatioEstimates" label: qsTr("Hazard ratio estimates") checked: true + + CheckBox + { + name: "coefficientHazardRatioEstimatesIncludeFrailty" + label: qsTr("Include frailty") + enabled: frailty.count > 0 + } } CheckBox @@ -440,8 +448,6 @@ Form { name: "residualPlotResidualVsTime" label: qsTr("Residuals vs. time") -// TODO: -// enabled: residualPlotResidualType.value == "martingale" || censoringTypeCounting.length > 0 } CheckBox @@ -468,13 +474,21 @@ Form name: "residualPlotResidualType" id: residualPlotResidualType label: qsTr("Type") - values: - [ - { label: qsTr("Martingale"), value: "martingale"}, - { label: qsTr("Score"), value: "score"}, - { label: qsTr("Schoenfeld"), value: "schoenfeld"}, - { label: qsTr("Scaled Schoenfeld"), value: "scaledSchoenfeld"} - ] + values: (function() { + if (frailty.count == 0) { + return [ + { label: qsTr("Martingale"), value: "martingale"}, + { label: qsTr("Score"), value: "score"}, + { label: qsTr("Schoenfeld"), value: "schoenfeld"}, + { label: qsTr("Scaled Schoenfeld"), value: "scaledSchoenfeld"} + ]; + } else { + return [ + { label: qsTr("Martingale"), value: "martingale"} + ]; + } + })() + } } } From 6f61dc110a584f27128713c8518f5787fd004be6 Mon Sep 17 00:00:00 2001 From: FBartos Date: Thu, 10 Oct 2024 09:16:36 +0200 Subject: [PATCH 13/24] improve interface --- .Rbuildignore | 2 ++ .gitignore | 2 ++ inst/qml/SemiParametricSurvivalAnalysis.qml | 12 ++++++++++-- renv/.gitignore | 7 +++++++ 4 files changed, 21 insertions(+), 2 deletions(-) create mode 100644 renv/.gitignore diff --git a/.Rbuildignore b/.Rbuildignore index 112ad26..7d392e5 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,5 @@ +^renv$ +^renv\.lock$ ^.*\.Rproj$ ^\.Rproj\.user$ ^\.travis\.yml$ diff --git a/.gitignore b/.gitignore index e46a21b..b786a31 100644 --- a/.gitignore +++ b/.gitignore @@ -58,3 +58,5 @@ Thumbs.db # RStudio files .Rproj.user _processedLockFile.lock +renv/activate.R +.Rprofile diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index e1fb281..1d8c536 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -28,7 +28,8 @@ Form VariablesForm { removeInvisibles: true - height: 850 + // TODO: Bruno fix height adjustment please + height: censoringTypeRight.checked ? 900 : 1100 AvailableVariablesList { @@ -42,6 +43,8 @@ Form allowedColumns: ["scale"] singleVariable: true visible: censoringTypeCounting.checked + property bool active: censoringTypeCounting.checked + onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) } AssignedVariablesList @@ -51,6 +54,8 @@ Form allowedColumns: ["scale"] singleVariable: true visible: censoringTypeCounting.checked + property bool active: censoringTypeCounting.checked + onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) } AssignedVariablesList @@ -60,6 +65,8 @@ Form allowedColumns: ["scale"] singleVariable: true visible: censoringTypeRight.checked + property bool active: censoringTypeRight.checked + onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) } AssignedVariablesList @@ -146,7 +153,8 @@ Form VariablesForm { - height: 400 + // TODO Bruno: the heigh adjustment does not seem to work + height: 300 AvailableVariablesList { diff --git a/renv/.gitignore b/renv/.gitignore new file mode 100644 index 0000000..0ec0cbb --- /dev/null +++ b/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ From 199472f05b555d68943ccbbf04b4aa54890802e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franti=C5=A1ek=20Barto=C5=A1?= <38475991+FBartos@users.noreply.github.com> Date: Mon, 14 Oct 2024 10:44:30 +0200 Subject: [PATCH 14/24] Apply suggestions from code review Co-authored-by: Julius Pfadt <38500953+juliuspfadt@users.noreply.github.com> --- R/semiparametricsurvivalanalysis.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 57ce18b..03035a0 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -186,7 +186,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state )) } - testsTable$addFootnote(gettext("Test are based on the H\u2081 model.")) + testsTable$addFootnote(gettext("Tests are based on the H\u2081 model.")) return() } @@ -512,7 +512,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state return() } - for(i in 1:(nrow(fitTest$table) - 1)) { + for (i in 1:(nrow(fitTest$table) - 1)) { tempVariable <- rownames(fitTest$table)[i] tempFitTestPlot <- plot(fitTest, plot = FALSE, var = tempVariable) @@ -642,7 +642,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state residualPlotResidualVsPredictors[["waitingPlot"]] <- tempPlot residualPlotResidualVsTime$setError(residuals) } else { - for(i in 1:ncol(predictorsFit)) { + for (i in 1:ncol(predictorsFit)) { # skip frailty terms if (grepl("frailty", colnames(predictorsFit)[i])) @@ -739,7 +739,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state ) if (!options[["coefficientHazardRatioEstimatesIncludeFrailty"]]) - estimatesFit <- estimatesFit[grepl("JaspColumn",rownames(estimatesFit)),,drop=FALSE] + estimatesFit <- estimatesFit[grepl("JaspColumn", rownames(estimatesFit)), , drop=FALSE] } else { From abbe6e06dc5d727d80d002b05e4a8ad7cd11c6e4 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:11:51 +0200 Subject: [PATCH 15/24] Change data-loading and add informative message for frailty waitting --- R/commonsurvivalanalysis.R | 21 +- R/nonparametricsurvivalanalysis.R | 2 +- R/semiparametricsurvivalanalysis.R | 17 +- inst/Description.qml | 1 + renv.lock | 1439 ++++++++++++++-------------- 5 files changed, 749 insertions(+), 731 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 380a01e..84448c6 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -11,22 +11,14 @@ "right" = options[["eventStatus"]] != "" && options[["timeToEvent"]] != "" ) - # deal with specifying fixed variance / dfs for frailty (default is zero which is an invalid setting --- user has to specify something themself) - if (ready && !is.null(options[["frailty"]]) && options[["frailty"]] != "" && options[["frailtyMethod"]] == "fixed") { - ready <- ready && switch( - options[["frailtyMethodFixed"]], - "theta" = options[["frailtyMethodFixedTheta"]] > 0, - "df" = options[["frailtyMethodFixedDf"]] > 0 - ) - } + # check whether Cox regression is waiting for frailty + coxWaitingForFrailty <- .saspCoxWaitingForFrailty(options) + ready <- ready && !coxWaitingForFrailty return(ready) } -.saReadDataset <- function(dataset, options) { - - if (!is.null(dataset)) - return(dataset) +.saCheckDataset <- function(dataset, options) { # load the data eventVariable <- options[["eventStatus"]] @@ -45,11 +37,6 @@ weightsVariable <- Filter(function(s) s != "", options[["weights"]]) frailtyVariable <- Filter(function(s) s != "", options[["frailty"]]) - dataset <- .readDataSetToEnd( - columns.as.numeric = c(timeVariable, covariatesVariable, weightsVariable), - columns.as.factor = c(eventVariable, factorsVariable, strataVariable, clusterVariable, frailtyVariable), - ) - # clean from NAs dataset <- na.omit(dataset) diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 9f98e38..543e1e1 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -21,7 +21,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = options[["censoringType"]] <- "right" if (.saSurvivalReady(options)) - dataset <- .saReadDataset(dataset, options) + dataset <- .saCheckDataset(dataset, options) if (.saSurvivalReady(options)) { .sanpFitKaplanMeier(jaspResults, dataset, options) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 03035a0..b9fd8fd 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -18,8 +18,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = NULL) { if (.saSurvivalReady(options)) - dataset <- .saReadDataset(dataset, options) - + dataset <- .saCheckDataset(dataset, options) .saspFitCox(jaspResults, dataset, options) .saspFitCoxAssumptionTest(jaspResults, dataset, options) @@ -208,6 +207,9 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state summaryTable$addColumnInfo(name = "aic", title = gettext("AIC"), type = "number", format="dp:3") summaryTable$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number", format="dp:3") + if (.saspCoxWaitingForFrailty(options)) + summaryTable$addFootnote(gettext("Either 'theta' of 'df' must be set to a value larger than zero when using 'Fixed' frailty method.")) + if (!.saSurvivalReady(options)) return() @@ -789,3 +791,14 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state .saspHasFrailty <- function(options) { return(options[["frailty"]] != "") } +.saspCoxWaitingForFrailty <- function(options) { + + if (is.null(options[["frailty"]]) || (options[["frailty"]] != "" && options[["frailtyMethod"]] != "fixed")) + return(FALSE) + else + switch( + options[["frailtyMethodFixed"]], + "theta" = options[["frailtyMethodFixedTheta"]] == 0, + "df" = options[["frailtyMethodFixedDf"]] == 0 + ) +} diff --git a/inst/Description.qml b/inst/Description.qml index 364f9a6..e186b5a 100644 --- a/inst/Description.qml +++ b/inst/Description.qml @@ -7,6 +7,7 @@ Description title : qsTr("Survival (beta)") description: qsTr("Perform analyses of censored time to event data.") requiresData: true + preloadData: true icon: "survival-analysis.svg" version : "0.19.2" author: "JASP Team" diff --git a/renv.lock b/renv.lock index 417fbf1..0071c20 100644 --- a/renv.lock +++ b/renv.lock @@ -9,199 +9,190 @@ ] }, "Packages": { - "Deriv": { - "Package": "Deriv", - "Version": "4.1.6", - "Source": "Repository", - "Requirements": [ - "methods" - ] - }, "Formula": { "Package": "Formula", "Version": "1.2-5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "stats" - ] + ], + "Hash": "7a29697b75e027767a53fde6c903eca7" }, "GPArotation": { "Package": "GPArotation", "Version": "2024.3-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "stats" - ] + ], + "Hash": "b8b658ec0d7a6a55d9d01e00e3cafd20" }, "Hmisc": { "Package": "Hmisc", "Version": "5.1-3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "Formula", "R", - "methods", - "ggplot2", + "base64enc", "cluster", - "rpart", - "nnet", + "colorspace", + "data.table", "foreign", - "gtable", + "ggplot2", "grid", "gridExtra", - "data.table", + "gtable", "htmlTable", - "viridis", "htmltools", - "base64enc", - "colorspace", - "rmarkdown", "knitr", - "Formula" - ] - }, - "KMsurv": { - "Package": "KMsurv", - "Version": "0.1-5", - "Source": "Repository", - "Requirements": [] + "methods", + "nnet", + "rmarkdown", + "rpart", + "viridis" + ], + "Hash": "9a446aea30bff7e8ee20f4c0973e8851" }, "MASS": { "Package": "MASS", "Version": "7.3-61", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "grDevices", "graphics", + "methods", "stats", - "utils", - "methods" - ] + "utils" + ], + "Hash": "0cafd6f0500e5deba33be22c46bf6055" }, "Matrix": { "Package": "Matrix", "Version": "1.7-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "methods", "grDevices", "graphics", "grid", "lattice", + "methods", "stats", "utils" - ] - }, - "MatrixModels": { - "Package": "MatrixModels", - "Version": "0.5-3", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "methods", - "Matrix" - ] + ], + "Hash": "5122bb14d8736372411f955e1b16bc8a" }, "R6": { "Package": "R6", "Version": "2.5.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" }, "RColorBrewer": { "Package": "RColorBrewer", "Version": "1.1-3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "45f0398006e83a5b10b72a90663d8d8c" }, "Rcpp": { "Package": "Rcpp", "Version": "1.0.13", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "methods", "utils" - ] - }, - "RcppEigen": { - "Package": "RcppEigen", - "Version": "0.3.4.0.2", - "Source": "Repository", - "Requirements": [ - "R", - "Rcpp", - "stats", - "utils" - ] + ], + "Hash": "f27411eb6d9c3dada5edd444b8416675" }, - "SparseM": { - "Package": "SparseM", - "Version": "1.84-2", + "abind": { + "Package": "abind", + "Version": "1.4-8", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods", - "graphics", - "stats", "utils" - ] + ], + "Hash": "2288423bb0f20a457800d7fc47f6aa54" }, - "abind": { - "Package": "abind", - "Version": "1.4-8", + "archive": { + "Package": "archive", + "Version": "1.1.9", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "methods", - "utils" - ] + "cli", + "glue", + "rlang", + "tibble" + ], + "Hash": "d26b62e131d4a8b65aba4e9554a4bf74" }, "askpass": { "Package": "askpass", "Version": "1.2.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "sys" - ] + ], + "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" }, "backports": { "Package": "backports", "Version": "1.5.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "e1e1b9d75c37401117b636b7ae50827a" }, "base64enc": { "Package": "base64enc", "Version": "0.1-3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" }, - "boot": { - "Package": "boot", - "Version": "1.3-31", + "brio": { + "Package": "brio", + "Version": "1.1.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "R", - "graphics", - "stats" - ] + "R" + ], + "Hash": "c1ee497a6d999947c2c224ae46799b1a" }, "broom": { "Package": "broom", "Version": "1.0.7", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "backports", @@ -214,12 +205,14 @@ "stringr", "tibble", "tidyr" - ] + ], + "Hash": "8fcc818f3b9887aebaf206f141437cc9" }, "bslib": { "Package": "bslib", "Version": "0.8.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "base64enc", @@ -234,219 +227,195 @@ "mime", "rlang", "sass" - ] + ], + "Hash": "b299c6741ca9746fb227debcb0f9fb6c" }, "cachem": { "Package": "cachem", "Version": "1.1.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "rlang", - "fastmap" - ] + "fastmap", + "rlang" + ], + "Hash": "cd9a672193789068eb5a2aad65a0dedf" }, "callr": { "Package": "callr", "Version": "3.7.6", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "processx", "R6", + "processx", "utils" - ] - }, - "car": { - "Package": "car", - "Version": "3.1-3", - "Source": "Repository", - "Requirements": [ - "R", - "carData", - "abind", - "Formula", - "MASS", - "mgcv", - "nnet", - "pbkrtest", - "quantreg", - "grDevices", - "utils", - "stats", - "graphics", - "lme4", - "nlme", - "scales" - ] - }, - "carData": { - "Package": "carData", - "Version": "3.0-5", - "Source": "Repository", - "Requirements": [ - "R" - ] + ], + "Hash": "d7e13f49c19103ece9e58ad2d83a7354" }, "checkmate": { "Package": "checkmate", "Version": "2.3.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "backports", "utils" - ] + ], + "Hash": "0e14e01ce07e7c88fd25de6d4260d26b" }, "cli": { "Package": "cli", "Version": "3.6.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "utils" - ] + ], + "Hash": "b21916dd77a27642b447374a5d30ecf3" }, "cluster": { "Package": "cluster", "Version": "2.1.6", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "graphics", "grDevices", + "graphics", "stats", "utils" - ] + ], + "Hash": "0aaa05204035dc43ea0004b9c76611dd" }, "codetools": { "Package": "codetools", "Version": "0.2-20", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "61e097f35917d342622f21cdc79c256e" }, "colorspace": { "Package": "colorspace", "Version": "2.1-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "methods", - "graphics", "grDevices", + "graphics", + "methods", "stats" - ] - }, - "commonmark": { - "Package": "commonmark", - "Version": "1.9.2", - "Source": "Repository", - "Requirements": [] + ], + "Hash": "d954cb1c57e8d8b756165d7ba18aa55a" }, "corpcor": { "Package": "corpcor", "Version": "1.6.10", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "stats" - ] - }, - "corrplot": { - "Package": "corrplot", - "Version": "0.95", - "Source": "Repository", - "Requirements": [] - }, - "cowplot": { - "Package": "cowplot", - "Version": "1.1.3", - "Source": "Repository", - "Requirements": [ - "R", - "ggplot2", - "grid", - "gtable", - "grDevices", - "methods", - "rlang", - "scales" - ] + ], + "Hash": "17ebe3b6d75d09c5bab3891880b34237" }, "cpp11": { "Package": "cpp11", "Version": "0.5.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "91570bba75d0c9d3f1040c835cee8fba" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "859d96e65ef198fd43e82b9628d593ef" }, "curl": { "Package": "curl", "Version": "5.2.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "d91263322a58af798f6cf3b13fd56dde" }, "data.table": { "Package": "data.table", "Version": "1.16.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods" - ] + ], + "Hash": "2e00b378fc3be69c865120d9f313039a" }, "desc": { "Package": "desc", "Version": "1.4.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "cli", "R6", + "cli", "utils" - ] + ], + "Hash": "99b79fcbd6c4d1ce087f5c5c758b384f" }, - "digest": { - "Package": "digest", - "Version": "0.6.37", + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "crayon", + "methods", + "stats", + "tools", "utils" - ] + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" }, - "doBy": { - "Package": "doBy", - "Version": "4.6.24", + "digest": { + "Package": "digest", + "Version": "0.6.37", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "methods", - "boot", - "broom", - "cowplot", - "Deriv", - "dplyr", - "ggplot2", - "MASS", - "Matrix", - "modelr", - "microbenchmark", - "rlang", - "tibble", - "tidyr" - ] + "utils" + ], + "Hash": "33698c4b3127fc9f506654607fb73676" }, "dplyr": { "Package": "dplyr", "Version": "1.1.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "R6", "cli", "generics", "glue", @@ -454,148 +423,164 @@ "magrittr", "methods", "pillar", - "R6", "rlang", "tibble", "tidyselect", "utils", "vctrs" - ] + ], + "Hash": "fedd9d00c2944ff00a0e2696ccf048ec" }, "evaluate": { "Package": "evaluate", "Version": "1.0.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] - }, - "exactRankTests": { - "Package": "exactRankTests", - "Version": "0.8-35", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "utils" - ] + ], + "Hash": "3fd29944b231036ad67c3edb32e02201" }, "fansi": { "Package": "fansi", "Version": "1.0.6", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "grDevices", "utils" - ] + ], + "Hash": "962174cf2aeb5b9eea581522286a911f" }, "farver": { "Package": "farver", "Version": "2.1.2", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "680887028577f3fa2a81e410ed0d6e42" }, "fastmap": { "Package": "fastmap", "Version": "1.2.0", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "aa5e1cd11c2d15497494c5292d7ffcc8" }, "fdrtool": { "Package": "fdrtool", "Version": "1.2.18", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "graphics", "grDevices", + "graphics", "stats" - ] + ], + "Hash": "d2a06fbed1234e31c6a872aebbf30057" }, "fontBitstreamVera": { "Package": "fontBitstreamVera", "Version": "0.1.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "f6068021eff4aba735a9b2353516636c" }, "fontLiberation": { "Package": "fontLiberation", "Version": "0.1.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "f918c5e723f86f409912104d5b7a71d6" }, "fontawesome": { "Package": "fontawesome", "Version": "0.5.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "rlang", - "htmltools" - ] + "htmltools", + "rlang" + ], + "Hash": "c2efdd5f0bcd1ea861c2d4e2a883a67d" }, "fontquiver": { "Package": "fontquiver", "Version": "0.2.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "fontBitstreamVera", "fontLiberation" - ] + ], + "Hash": "fc0f4226379e451057d55419fd31761e" }, "foreign": { "Package": "foreign", "Version": "0.8-87", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods", - "utils", - "stats" - ] + "stats", + "utils" + ], + "Hash": "81fc09bdeab0077a73927ed1243404b6" }, "fs": { "Package": "fs", "Version": "1.6.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods" - ] + ], + "Hash": "15aeb8c27f5ea5161f9f6a641fafd93a" }, "gdtools": { "Package": "gdtools", "Version": "0.4.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "Rcpp", "fontquiver", "htmltools", - "Rcpp", "systemfonts", "tools" - ] + ], + "Hash": "e8e09897fee8d96f6bb02bf841177d20" }, "generics": { "Package": "generics", "Version": "0.1.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods" - ] + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" }, "ggplot2": { "Package": "ggplot2", "Version": "3.5.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "MASS", "R", "cli", "glue", @@ -604,7 +589,6 @@ "gtable", "isoband", "lifecycle", - "MASS", "mgcv", "rlang", "scales", @@ -612,188 +596,134 @@ "tibble", "vctrs", "withr" - ] + ], + "Hash": "44c6a2f8202d5b7e878ea274b1092426" }, - "ggpubr": { - "Package": "ggpubr", - "Version": "0.6.0", + "ggsurvfit": { + "Package": "ggsurvfit", + "Version": "1.1.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "ggplot2", - "ggrepel", - "grid", - "ggsci", - "stats", - "utils", - "tidyr", - "purrr", + "broom", + "cli", "dplyr", - "cowplot", - "ggsignif", - "scales", - "gridExtra", - "glue", - "polynom", - "rlang", - "rstatix", - "tibble", - "magrittr" - ] - }, - "ggrepel": { - "Package": "ggrepel", - "Version": "0.9.6", - "Source": "Repository", - "Requirements": [ - "R", - "ggplot2", - "grid", - "Rcpp", - "rlang", - "scales", - "withr" - ] - }, - "ggsci": { - "Package": "ggsci", - "Version": "3.2.0", - "Source": "Repository", - "Requirements": [ - "R", - "ggplot2", - "grDevices", - "scales" - ] - }, - "ggsignif": { - "Package": "ggsignif", - "Version": "0.6.4", - "Source": "Repository", - "Requirements": [ - "ggplot2" - ] - }, - "ggtext": { - "Package": "ggtext", - "Version": "0.1.2", - "Source": "Repository", - "Requirements": [ - "R", "ggplot2", - "grid", - "gridtext", + "glue", + "gtable", + "patchwork", "rlang", - "scales" - ] + "survival", + "tidyr" + ], + "Hash": "1b209a10614809cea0f3456554fb67f6" }, "glasso": { "Package": "glasso", "Version": "1.11", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "1e1217c1b472d1dbffda819b57dc6d8d" }, "glue": { "Package": "glue", "Version": "1.8.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods" - ] + ], + "Hash": "5899f1eaa825580172bb56c08266f37c" }, "gridExtra": { "Package": "gridExtra", "Version": "2.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "gtable", - "grid", "grDevices", "graphics", + "grid", + "gtable", "utils" - ] + ], + "Hash": "7d7f283939f563670a697165b2cf5560" }, "gridGraphics": { "Package": "gridGraphics", "Version": "0.5-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "grid", + "grDevices", "graphics", - "grDevices" - ] + "grid" + ], + "Hash": "5b79228594f02385d4df4979284879ae" }, - "gridtext": { - "Package": "gridtext", - "Version": "0.1.5", + "gtable": { + "Package": "gtable", + "Version": "0.3.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "curl", - "grid", - "grDevices", - "markdown", - "rlang", - "Rcpp", - "png", - "jpeg", - "stringr", - "xml2" - ] - }, - "gtable": { - "Package": "gtable", - "Version": "0.3.5", - "Source": "Repository", - "Requirements": [ - "R", - "cli", - "glue", + "cli", + "glue", "grid", "lifecycle", "rlang" - ] + ], + "Hash": "e18861963cbc65a27736e02b3cd3c4a0" }, "gtools": { "Package": "gtools", "Version": "3.9.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "methods", "stats", "utils" - ] + ], + "Hash": "588d091c35389f1f4a9d533c8d709b35" }, "highr": { "Package": "highr", "Version": "0.11", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "xfun" - ] + ], + "Hash": "d65ba49117ca223614f71b60d85b8ab7" }, "htmlTable": { "Package": "htmlTable", "Version": "2.4.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "stringr", + "checkmate", + "htmltools", + "htmlwidgets", "knitr", "magrittr", "methods", - "checkmate", - "htmlwidgets", - "htmltools", - "rstudioapi" - ] + "rstudioapi", + "stringr" + ], + "Hash": "ca027d8771f2c039aed82f00a81e725b" }, "htmltools": { "Package": "htmltools", "Version": "0.5.8.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "base64enc", @@ -802,12 +732,14 @@ "grDevices", "rlang", "utils" - ] + ], + "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" }, "htmlwidgets": { "Package": "htmlwidgets", "Version": "1.6.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "grDevices", "htmltools", @@ -815,134 +747,183 @@ "knitr", "rmarkdown", "yaml" - ] + ], + "Hash": "04291cc45198225444a397606810ac37" + }, + "httr": { + "Package": "httr", + "Version": "1.4.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "ac107251d9d9fd72f0ca8049988f1d7f" }, "igraph": { "Package": "igraph", "Version": "2.1.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "methods", + "Matrix", "R", "cli", - "graphics", + "cpp11", "grDevices", + "graphics", "lifecycle", "magrittr", - "Matrix", + "methods", "pkgconfig", "rlang", "stats", "utils", - "vctrs", - "cpp11" - ] + "vctrs" + ], + "Hash": "c03878b48737a0e2da3b772d7b2e22da" }, "isoband": { "Package": "isoband", "Version": "0.2.7", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "grid", "utils" - ] + ], + "Hash": "0080607b4a1a7b28979aecef976d8bc2" }, "jaspBase": { "Package": "jaspBase", "Version": "0.19.2", "Source": "GitHub", + "RemoteType": "github", + "RemoteUsername": "jasp-stats", + "RemoteRepo": "jaspBase", + "RemoteRef": "master", + "RemoteSha": "490c3729f1c34406fc662bb20aa872c99a88eeac", + "RemoteHost": "api.github.com", "Requirements": [ + "R6", + "Rcpp", "cli", "codetools", + "compiler", "ggplot2", + "grDevices", + "grid", "gridExtra", "gridGraphics", "jaspGraphs", "jsonlite", "lifecycle", + "methods", "modules", "officer", "pkgbuild", "plyr", "qgraph", "ragg", - "R6", - "Rcpp", "remotes", "rjson", "rvg", "svglite", "systemfonts", - "withr", - "testthat" + "withr" ], - "RemoteType": "github", - "RemoteHost": "api.github.com", - "RemoteUsername": "jasp-stats", - "RemoteRepo": "jaspBase", - "RemoteSha": "490c3729f1c34406fc662bb20aa872c99a88eeac" + "Hash": "240b27a199461a7365b77a3aa0917fef" }, "jaspGraphs": { "Package": "jaspGraphs", "Version": "0.19.2", "Source": "GitHub", + "RemoteType": "github", + "RemoteUsername": "jasp-stats", + "RemoteRepo": "jaspGraphs", + "RemoteRef": "master", + "RemoteSha": "550191feb1f662ba400e9b96617050aad4927048", + "RemoteHost": "api.github.com", "Requirements": [ - "testthat", + "R6", + "RColorBrewer", "ggplot2", "gridExtra", "gtable", - "lifecycle", "jsonlite", - "R6", - "RColorBrewer", + "lifecycle", "rlang", "scales", "viridisLite" ], + "Hash": "4459270f4582584f4426db85d0f55fa4" + }, + "jaspTools": { + "Package": "jaspTools", + "Version": "0.19.2", + "Source": "GitHub", "RemoteType": "github", - "RemoteHost": "api.github.com", "RemoteUsername": "jasp-stats", - "RemoteRepo": "jaspGraphs", - "RemoteSha": "550191feb1f662ba400e9b96617050aad4927048" + "RemoteRepo": "jaspTools", + "RemoteRef": "master", + "RemoteSha": "6ffbc7a68058aa1a30908382f5c0797afc1303ab", + "RemoteHost": "api.github.com", + "Requirements": [ + "archive", + "data.table", + "httr", + "jsonlite", + "lifecycle", + "pkgload", + "remotes", + "rjson", + "stringi", + "stringr", + "testthat", + "vdiffr" + ], + "Hash": "063c1201538d24bbe97397796e2e75a4" }, "jpeg": { "Package": "jpeg", "Version": "0.1-10", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "031a0b683d001a7519202f0628fc0358" }, "jquerylib": { "Package": "jquerylib", "Version": "0.1.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "htmltools" - ] + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" }, "jsonlite": { "Package": "jsonlite", "Version": "1.8.9", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "methods" - ] - }, - "km.ci": { - "Package": "km.ci", - "Version": "0.5-6", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "survival" - ] + ], + "Hash": "4e993b65c2c3ffbffce7bb3e2c6f832b" }, "knitr": { "Package": "knitr", "Version": "1.48", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "evaluate", @@ -951,312 +932,256 @@ "tools", "xfun", "yaml" - ] + ], + "Hash": "acf380f300c721da9fde7df115a5f86f" }, "labeling": { "Package": "labeling", "Version": "0.4.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "stats", - "graphics" - ] + "graphics", + "stats" + ], + "Hash": "b64ec208ac5bc1852b285f665d6368b3" }, "lattice": { "Package": "lattice", "Version": "0.22-6", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "grid", "grDevices", "graphics", + "grid", "stats", "utils" - ] + ], + "Hash": "cc5ac1ba4c238c7ca9fa6a87ca11a7e2" }, "lavaan": { "Package": "lavaan", "Version": "0.6-19", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "MASS", "R", - "methods", - "stats4", - "stats", - "utils", "graphics", - "MASS", + "methods", "mnormt", - "pbivnorm", "numDeriv", - "quadprog" - ] + "pbivnorm", + "quadprog", + "stats", + "stats4", + "utils" + ], + "Hash": "78573997f3acd282f34c626ffb6a906d" }, "lifecycle": { "Package": "lifecycle", "Version": "1.0.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", "glue", "rlang" - ] - }, - "lme4": { - "Package": "lme4", - "Version": "1.1-35.5", - "Source": "Repository", - "Requirements": [ - "R", - "Matrix", - "methods", - "stats", - "graphics", - "grid", - "splines", - "utils", - "parallel", - "MASS", - "lattice", - "boot", - "nlme", - "minqa", - "nloptr", - "Rcpp", - "RcppEigen" - ] + ], + "Hash": "b8552d117e1b808b09a832f589b79035" }, "magrittr": { "Package": "magrittr", "Version": "2.0.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] - }, - "markdown": { - "Package": "markdown", - "Version": "1.13", - "Source": "Repository", - "Requirements": [ - "R", - "utils", - "commonmark", - "xfun" - ] - }, - "maxstat": { - "Package": "maxstat", - "Version": "0.7-25", - "Source": "Repository", - "Requirements": [ - "R", - "exactRankTests", - "mvtnorm", - "stats", - "graphics" - ] + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" }, "memoise": { "Package": "memoise", "Version": "2.0.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "rlang", - "cachem" - ] + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" }, "mgcv": { "Package": "mgcv", "Version": "1.9-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "Matrix", "R", - "nlme", - "methods", - "stats", "graphics", - "Matrix", + "methods", + "nlme", "splines", + "stats", "utils" - ] - }, - "microbenchmark": { - "Package": "microbenchmark", - "Version": "1.5.0", - "Source": "Repository", - "Requirements": [ - "R", - "graphics", - "stats" - ] + ], + "Hash": "110ee9d83b496279960e162ac97764ce" }, "mime": { "Package": "mime", "Version": "0.12", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "tools" - ] - }, - "minqa": { - "Package": "minqa", - "Version": "1.2.8", - "Source": "Repository", - "Requirements": [ - "Rcpp" - ] + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" }, "mnormt": { "Package": "mnormt", "Version": "2.1.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] - }, - "modelr": { - "Package": "modelr", - "Version": "0.1.11", - "Source": "Repository", - "Requirements": [ - "R", - "broom", - "magrittr", - "purrr", - "rlang", - "tibble", - "tidyr", - "tidyselect", - "vctrs" - ] + ], + "Hash": "c83992ef63553d1e4b97162a4a753470" }, "modules": { "Package": "modules", "Version": "0.13.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "utils" - ] + ], + "Hash": "1485aee3373bcfdbb2dd9048995af2ae" }, "munsell": { "Package": "munsell", "Version": "0.5.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "colorspace", "methods" - ] - }, - "mvtnorm": { - "Package": "mvtnorm", - "Version": "1.3-1", - "Source": "Repository", - "Requirements": [ - "R", - "stats" - ] + ], + "Hash": "4fd8900853b746af55b81fda99da7695" }, "nlme": { "Package": "nlme", "Version": "3.1-166", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "graphics", + "lattice", "stats", - "utils", - "lattice" - ] - }, - "nloptr": { - "Package": "nloptr", - "Version": "2.1.1", - "Source": "Repository", - "Requirements": [] + "utils" + ], + "Hash": "ccbb8846be320b627e6aa2b4616a2ded" }, "nnet": { "Package": "nnet", "Version": "7.3-19", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "stats", "utils" - ] + ], + "Hash": "2c797b46eea7fb58ede195bc0b1f1138" }, "numDeriv": { "Package": "numDeriv", "Version": "2016.8-1.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "df58958f293b166e4ab885ebcad90e02" }, "officer": { "Package": "officer", "Version": "0.6.7", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "R6", "cli", - "graphics", "grDevices", + "graphics", "openssl", - "R6", "ragg", "stats", "utils", "uuid", "xml2", "zip" - ] + ], + "Hash": "d6c0a4e796301a5d252de42c92a9a8b9" }, "openssl": { "Package": "openssl", "Version": "2.2.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "askpass" - ] + ], + "Hash": "d413e0fef796c9401a4419485f709ca1" + }, + "patchwork": { + "Package": "patchwork", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cli", + "farver", + "ggplot2", + "grDevices", + "graphics", + "grid", + "gtable", + "rlang", + "stats", + "utils" + ], + "Hash": "e23fb9ecb1258207bcb763d78d513439" }, "pbapply": { "Package": "pbapply", "Version": "1.7-2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "parallel" - ] + ], + "Hash": "68a2d681e10cf72f0afa1d84d45380e5" }, "pbivnorm": { "Package": "pbivnorm", "Version": "0.6.0", "Source": "Repository", - "Requirements": [] - }, - "pbkrtest": { - "Package": "pbkrtest", - "Version": "0.5.3", - "Source": "Repository", - "Requirements": [ - "R", - "lme4", - "broom", - "dplyr", - "MASS", - "methods", - "numDeriv", - "Matrix", - "doBy" - ] + "Repository": "CRAN", + "Hash": "643e16a7da6aac3e18cadc3e14abb94b" }, "pillar": { "Package": "pillar", "Version": "1.9.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "cli", "fansi", @@ -1266,95 +1191,131 @@ "utf8", "utils", "vctrs" - ] + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" }, "pkgbuild": { "Package": "pkgbuild", "Version": "1.4.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "R6", "callr", "cli", "desc", - "processx", - "R6" - ] + "processx" + ], + "Hash": "a29e8e134a460a01e0ca67a4763c595b" }, "pkgconfig": { "Package": "pkgconfig", "Version": "2.0.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "utils" - ] + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "desc", + "fs", + "glue", + "lifecycle", + "methods", + "pkgbuild", + "processx", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "2ec30ffbeec83da57655b850cf2d3e0e" }, "plyr": { "Package": "plyr", "Version": "1.8.9", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "Rcpp" - ] + ], + "Hash": "6b8177fd19982f0020743fadbfdbd933" }, "png": { "Package": "png", "Version": "0.1-8", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "bd54ba8a0a5faded999a7aab6e46b374" }, - "polynom": { - "Package": "polynom", - "Version": "1.4-1", + "praise": { + "Package": "praise", + "Version": "1.0.0", "Source": "Repository", - "Requirements": [ - "stats", - "graphics" - ] + "Repository": "CRAN", + "Hash": "a555924add98c99d2f411e37e7d25e9f" }, "processx": { "Package": "processx", "Version": "3.8.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "ps", "R6", + "ps", "utils" - ] + ], + "Hash": "0c90a7d71988856bad2a2a45dd871bb9" }, "ps": { "Package": "ps", "Version": "1.8.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "utils" - ] + ], + "Hash": "4b9c8485b0c7eecdf0a9ba5132a45576" }, "psych": { "Package": "psych", "Version": "2.4.6.26", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "mnormt", - "parallel", - "stats", - "graphics", + "GPArotation", "grDevices", - "methods", + "graphics", "lattice", + "methods", + "mnormt", "nlme", - "GPArotation" - ] + "parallel", + "stats" + ], + "Hash": "4448d5f3ac3e2cbf79074391d494637e" }, "purrr": { "Package": "purrr", "Version": "1.0.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", @@ -1362,122 +1323,144 @@ "magrittr", "rlang", "vctrs" - ] + ], + "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" }, "qgraph": { "Package": "qgraph", "Version": "1.9.8", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "Hmisc", + "Matrix", "R", "Rcpp", - "methods", - "grDevices", - "psych", - "lavaan", - "plyr", - "Hmisc", - "igraph", - "jpeg", - "png", + "abind", "colorspace", - "Matrix", "corpcor", - "reshape2", + "fdrtool", "ggplot2", "glasso", - "fdrtool", + "grDevices", "gtools", + "igraph", + "jpeg", + "lavaan", + "methods", "parallel", "pbapply", - "abind" - ] + "plyr", + "png", + "psych", + "reshape2" + ], + "Hash": "a78e4896ba8e67ceaa1086d664dc72a8" }, "quadprog": { "Package": "quadprog", "Version": "1.5-8", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] - }, - "quantreg": { - "Package": "quantreg", - "Version": "5.98", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "SparseM", - "methods", - "graphics", - "Matrix", - "MatrixModels", - "survival", - "MASS" - ] + ], + "Hash": "5f919ae5e7f83a6f91dcf2288943370d" }, "ragg": { "Package": "ragg", "Version": "1.3.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "systemfonts", "textshaping" - ] + ], + "Hash": "0595fe5e47357111f29ad19101c7d271" }, "rappdirs": { "Package": "rappdirs", "Version": "0.3.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" }, "remotes": { "Package": "remotes", "Version": "2.5.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "methods", "stats", "tools", "utils" - ] + ], + "Hash": "3ee025083e66f18db6cf27b56e23e141" + }, + "renv": { + "Package": "renv", + "Version": "1.0.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "47623f66b4e80b3b0587bc5d7b309888" }, "reshape2": { "Package": "reshape2", "Version": "1.4.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "plyr", "Rcpp", + "plyr", "stringr" - ] + ], + "Hash": "bb5996d0bd962d214a11140d77589917" }, "rjson": { "Package": "rjson", "Version": "0.2.23", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "7a04e9eff95857dbf557b4e5f0b3d1a8" }, "rlang": { "Package": "rlang", "Version": "1.1.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "utils" - ] + ], + "Hash": "3eec01f8b1dee337674b2e34ab1f9bc1" }, "rmarkdown": { "Package": "rmarkdown", "Version": "2.28", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "bslib", @@ -1493,105 +1476,107 @@ "utils", "xfun", "yaml" - ] + ], + "Hash": "062470668513dcda416927085ee9bdc7" }, "rpart": { "Package": "rpart", "Version": "4.1.23", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "grDevices", "graphics", - "stats", - "grDevices" - ] + "stats" + ], + "Hash": "b3d390424f41d04174cccf84d49676c2" }, - "rstatix": { - "Package": "rstatix", - "Version": "0.7.2", + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ - "R", - "stats", - "utils", - "tidyr", - "purrr", - "broom", - "rlang", - "tibble", - "dplyr", - "magrittr", - "corrplot", - "tidyselect", - "car", - "generics" - ] + "R" + ], + "Hash": "4c8415e0ec1e29f3f4f6fc108bef0144" }, "rstudioapi": { "Package": "rstudioapi", "Version": "0.17.0", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "fb9f5fce8f609e9b66f0bea5c783f88a" }, "rvg": { "Package": "rvg", "Version": "0.3.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "grDevices", "Rcpp", - "officer", "gdtools", - "xml2", - "rlang" - ] + "grDevices", + "officer", + "rlang", + "xml2" + ], + "Hash": "84feb96f75452bfbb4b7858e36bea2c5" }, "sass": { "Package": "sass", "Version": "0.4.9", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "R6", "fs", - "rlang", "htmltools", - "R6", - "rappdirs" - ] + "rappdirs", + "rlang" + ], + "Hash": "d53dbfddf695303ea4ad66f86e99b95d" }, "scales": { "Package": "scales", "Version": "1.3.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "R6", + "RColorBrewer", "cli", "farver", "glue", "labeling", "lifecycle", "munsell", - "R6", - "RColorBrewer", "rlang", "viridisLite" - ] + ], + "Hash": "c19df082ba346b0ffa6f833e92de34d1" }, "stringi": { "Package": "stringi", "Version": "1.8.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "stats", "tools", - "utils", - "stats" - ] + "utils" + ], + "Hash": "39e1144fd75428983dc3f63aa53dfa91" }, "stringr": { "Package": "stringr", "Version": "1.5.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", @@ -1601,109 +1586,103 @@ "rlang", "stringi", "vctrs" - ] - }, - "survMisc": { - "Package": "survMisc", - "Version": "0.5.6", - "Source": "Repository", - "Requirements": [ - "survival", - "graphics", - "grDevices", - "stats", - "utils", - "knitr", - "KMsurv", - "ggplot2", - "data.table", - "zoo", - "grid", - "gridExtra", - "km.ci", - "xtable" - ] + ], + "Hash": "960e2ae9e09656611e0b8214ad543207" }, "survival": { "Package": "survival", "Version": "3.7-0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ + "Matrix", "R", "graphics", - "Matrix", "methods", "splines", "stats", "utils" - ] - }, - "survminer": { - "Package": "survminer", - "Version": "0.4.9", - "Source": "Repository", - "Requirements": [ - "ggplot2", - "ggpubr", - "grid", - "gridExtra", - "magrittr", - "maxstat", - "methods", - "scales", - "survival", - "stats", - "broom", - "dplyr", - "tidyr", - "survMisc", - "purrr", - "tibble", - "rlang", - "ggtext" - ] + ], + "Hash": "5aaa9cbaf4aba20f8e06fdea1850a398" }, "svglite": { "Package": "svglite", "Version": "2.1.3", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "systemfonts", - "cpp11" - ] + "cpp11", + "systemfonts" + ], + "Hash": "124a41fdfa23e8691cb744c762f10516" }, "sys": { "Package": "sys", "Version": "3.4.3", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "de342ebfebdbf40477d0758d05426646" }, "systemfonts": { "Package": "systemfonts", "Version": "1.1.0", "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "lifecycle" + ], + "Hash": "213b6b8ed5afbf934843e6c3b090d418" + }, + "testthat": { + "Package": "testthat", + "Version": "3.2.1.1", + "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "evaluate", + "jsonlite", "lifecycle", - "cpp11" - ] + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "3f6e7e5e2220856ff865e4834766bf2b" }, "textshaping": { "Package": "textshaping", "Version": "0.4.0", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", + "cpp11", "lifecycle", - "systemfonts", - "cpp11" - ] + "systemfonts" + ], + "Hash": "5142f8bc78ed3d819d26461b641627ce" }, "tibble": { "Package": "tibble", "Version": "3.2.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "fansi", @@ -1715,15 +1694,18 @@ "rlang", "utils", "vctrs" - ] + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" }, "tidyr": { "Package": "tidyr", "Version": "1.3.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", + "cpp11", "dplyr", "glue", "lifecycle", @@ -1734,14 +1716,15 @@ "tibble", "tidyselect", "utils", - "vctrs", - "cpp11" - ] + "vctrs" + ], + "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" }, "tidyselect": { "Package": "tidyselect", "Version": "1.2.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", @@ -1750,129 +1733,163 @@ "rlang", "vctrs", "withr" - ] + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" }, "tinytex": { "Package": "tinytex", "Version": "0.53", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "xfun" - ] + ], + "Hash": "9db859e8aabbb474293dde3097839420" }, "utf8": { "Package": "utf8", "Version": "1.2.4", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "62b65c52671e6665f803ff02954446e9" }, "uuid": { "Package": "uuid", "Version": "1.2-1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "34e965e62a41fcafb1ca60e9b142085b" }, "vctrs": { "Package": "vctrs", "Version": "0.6.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", "glue", "lifecycle", "rlang" - ] + ], + "Hash": "c03fa420630029418f7e6da3667aac4a" + }, + "vdiffr": { + "Package": "vdiffr", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "diffobj", + "glue", + "grDevices", + "htmltools", + "lifecycle", + "rlang", + "testthat", + "xml2" + ], + "Hash": "c359a4beb35ca8a9ab98646fdd654f0f" }, "viridis": { "Package": "viridis", "Version": "0.6.5", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "viridisLite", "ggplot2", - "gridExtra" - ] + "gridExtra", + "viridisLite" + ], + "Hash": "acd96d9fa70adeea4a5a1150609b9745" }, "viridisLite": { "Package": "viridisLite", "Version": "0.4.2", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R" - ] + ], + "Hash": "c826c7c4241b6fc89ff55aaea3fa7491" + }, + "waldo": { + "Package": "waldo", + "Version": "0.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "diffobj", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "16aa934a49658677d8041df9017329b9" }, "withr": { "Package": "withr", "Version": "3.0.1", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", - "graphics", - "grDevices" - ] + "grDevices", + "graphics" + ], + "Hash": "07909200e8bbe90426fbfeb73e1e27aa" }, "xfun": { "Package": "xfun", "Version": "0.48", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "grDevices", "stats", "tools" - ] + ], + "Hash": "89e455b87c84e227eb7f60a1b4e5fe1f" }, "xml2": { "Package": "xml2", "Version": "1.3.6", "Source": "Repository", + "Repository": "CRAN", "Requirements": [ "R", "cli", "methods", "rlang" - ] - }, - "xtable": { - "Package": "xtable", - "Version": "1.8-4", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "utils" - ] + ], + "Hash": "1d0336142f4cd25d8d23cd3ba7a8fb61" }, "yaml": { "Package": "yaml", "Version": "2.3.10", "Source": "Repository", - "Requirements": [] + "Repository": "CRAN", + "Hash": "51dab85c6c98e50a18d7551e9d49f76c" }, "zip": { "Package": "zip", "Version": "2.3.1", "Source": "Repository", - "Requirements": [] - }, - "zoo": { - "Package": "zoo", - "Version": "1.8-12", - "Source": "Repository", - "Requirements": [ - "R", - "stats", - "utils", - "graphics", - "grDevices", - "lattice" - ] + "Repository": "CRAN", + "Hash": "fcc4bd8e6da2d2011eb64a5e5cc685ab" } } } From f7cd216e5ea22557343f3b7328fd05485e0bb6bf Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:22:25 +0200 Subject: [PATCH 16/24] disable `cluster` when `exact` method is selected --- inst/qml/SemiParametricSurvivalAnalysis.qml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 1d8c536..8a4ad4d 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -113,6 +113,7 @@ Form DropDown { name: "method" + id: method label: qsTr("Method") values: [ @@ -184,7 +185,7 @@ Form { name: "cluster" id: cluster - enabled: frailty.count == 0 + enabled: frailty.count == 0 && method.value != "exact" title: qsTr("Cluster") allowedColumns: ["nominal"] singleVariable: true From eb1d793a2132363b1637b365072450d1a1c3734f Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:24:25 +0200 Subject: [PATCH 17/24] "plotConfidenceInterval" -> "plotCi" --- R/commonsurvivalanalysis.R | 4 ++-- R/nonparametricsurvivalanalysis.R | 4 ++-- inst/qml/qml_components/SurvivalPlot.qml | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 84448c6..48de5a8 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -274,7 +274,7 @@ "cumulativeHazard" = gettext("Cumulative Hazard Plot"), "complementaryLogLog" = gettext("Complementary Log-Log Plot") ), width = 450, height = .saGetSurvivalPlotHeight(options)) - surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotStrata", "plotConfidenceInterval", "plotRiskTable", + surivalPlot$dependOn(c(.sanpDependencies, "plot", "plotType", "plotStrata", "plotCi", "plotRiskTable", "plotRiskTableNumberAtRisk", "plotRiskTableCumulativeNumberOfObservedEvents", "plotRiskTableCumulativeNumberOfCensoredObservations", "plotRiskTableNumberOfEventsInTimeInterval", "plotRiskTableNumberOfCensoredObservationsInTimeInterval", "plotRiskTableAsASingleLine", @@ -336,7 +336,7 @@ return() } - if (options[["plotConfidenceInterval"]]) + if (options[["plotCi"]]) tempPlot <- tempPlot + ggsurvfit::add_confidence_interval() if (options[["plotRiskTable"]]) { diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index 543e1e1..ffd43a0 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -331,7 +331,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempPlot <- ggplot2::ggplot(fitLifeTable) + jaspGraphs::geom_line(mapping = ggplot2::aes(x = time, y = survival)) - if (options[["survivalCurvePlotConfidenceInterval"]]) + if (options[["survivalCurveplotCi"]]) tempPlot <- tempPlot + ggplot2::geom_ribbon(mapping = ggplot2::aes(x = time, ymin = lowerCI, ymax = upperCI), alpha = 0.1, size = 1) if (options[["survivalCurvePlotDataRug"]]) @@ -342,7 +342,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = tempPlot <- ggplot2::ggplot(fitLifeTable) + jaspGraphs::geom_line(mapping = ggplot2::aes(x = time, y = survival, group = strata, color = strata)) - if (options[["survivalCurvePlotConfidenceInterval"]]) + if (options[["survivalCurveplotCi"]]) tempPlot <- tempPlot + ggplot2::geom_ribbon(mapping = ggplot2::aes(x = time, ymin = lowerCI, ymax = upperCI, group = strata, fill = strata), alpha = 0.1, size = 1) if (options[["survivalCurvePlotDataRug"]]) diff --git a/inst/qml/qml_components/SurvivalPlot.qml b/inst/qml/qml_components/SurvivalPlot.qml index 85f13c4..1146e83 100644 --- a/inst/qml/qml_components/SurvivalPlot.qml +++ b/inst/qml/qml_components/SurvivalPlot.qml @@ -40,7 +40,7 @@ CheckBox CheckBox { - name: "plotConfidenceInterval" + name: "plotCi" label: qsTr("Confidence interval") checked: true } @@ -133,4 +133,4 @@ CheckBox { label: qsTr("ggsurvfit"), value: "ggsurvfit"} ] } -} \ No newline at end of file +} From 9ac82bd0703639e40125d0323208828502f26966 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:33:42 +0200 Subject: [PATCH 18/24] Non-parametric: factors -> strata for consistency --- R/commonsurvivalanalysis.R | 8 ++++---- R/nonparametricsurvivalanalysis.R | 16 ++++++++-------- inst/qml/NonParametricSurvivalAnalysis.qml | 6 +++--- .../test-nonparametricsurvivalanalysis.R | 6 +++--- 4 files changed, 18 insertions(+), 18 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 48de5a8..38e34e2 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -28,10 +28,10 @@ "right" = options[["timeToEvent"]] ) - factorsVariable <- Filter(function(s) s != "", options[["factors"]]) + strataVariable <- Filter(function(s) s != "", options[["strata"]]) # only for (semi)parametric covariatesVariable <- Filter(function(s) s != "", options[["covariates"]]) - strataVariable <- Filter(function(s) s != "", options[["strata"]]) + factorsVariable <- Filter(function(s) s != "", options[["factors"]]) # idVariable <- Filter(function(s) s != "", options[["id"]]) clusterVariable <- Filter(function(s) s != "", options[["cluster"]]) weightsVariable <- Filter(function(s) s != "", options[["weights"]]) @@ -115,8 +115,8 @@ .saGetFormula <- function(options, type, null = FALSE) { if (type == "KM") { - # nonparametric (Kaplan-Meier) only stratifies by factors - predictors <- options[["factors"]] + # nonparametric (Kaplan-Meier) only stratifies by strata + predictors <- options[["strata"]] interceptTerm <- TRUE } else if (type == "Cox") { # Cox proportional hazards always includes intercept diff --git a/R/nonparametricsurvivalanalysis.R b/R/nonparametricsurvivalanalysis.R index ffd43a0..89368f1 100644 --- a/R/nonparametricsurvivalanalysis.R +++ b/R/nonparametricsurvivalanalysis.R @@ -40,7 +40,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = return() } -.sanpDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "factors") +.sanpDependencies <- c("timeToEvent", "eventStatus", "eventIndicator", "strata") .sanpFitKaplanMeier <- function(jaspResults, dataset, options) { @@ -66,7 +66,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = } .sanpFitTests <- function(jaspResults, dataset, options) { - if (length(options[["factors"]]) == 0) + if (length(options[["strata"]]) == 0) return() if (options[["testsLogRank"]] && is.null(jaspResults[["testLogRank"]])) { @@ -128,7 +128,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = # create empty table overtitleCi <- gettextf("%s%% CI", 95) - if (length(options[["factors"]]) != 0) + if (length(options[["strata"]]) != 0) summaryTable$addColumnInfo(name = "strata", title = gettext("Strata"), type = "string") summaryTable$addColumnInfo(name = "n", title = gettext("N"), type = "integer") @@ -175,8 +175,8 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = testsTable$addColumnInfo(name = "df", title = gettext("df"), type = "integer") testsTable$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue") - if (length(options[["factors"]]) == 0) { - testsTable$addFootnote(gettext("At least one factor needs to be specified")) + if (length(options[["strata"]]) == 0) { + testsTable$addFootnote(gettext("At least one strata needs to be specified")) return() } @@ -238,7 +238,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = } - if (length(options[["factors"]]) == 0) { + if (length(options[["strata"]]) == 0) { tempTable <- .sanpEmptyLifeTable() tempTable$setData(fitLifeTable) @@ -326,7 +326,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = } .sanpPlotLifeTable <- function(fitLifeTable, options) { - if (length(options[["factors"]]) == 0) { + if (length(options[["strata"]]) == 0) { tempPlot <- ggplot2::ggplot(fitLifeTable) + jaspGraphs::geom_line(mapping = ggplot2::aes(x = time, y = survival)) @@ -358,7 +358,7 @@ NonParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state = jaspGraphs::scale_x_continuous(name = gettext("Time")) + jaspGraphs::scale_y_continuous(name = gettext("Survival")) + jaspGraphs::geom_rangeframe(sides = 'bl') + - jaspGraphs::themeJaspRaw(legend.position = if (length(options[["factors"]]) != 0) options[["survivalCurvePlotLegend"]]) + jaspGraphs::themeJaspRaw(legend.position = if (length(options[["strata"]]) != 0) options[["survivalCurvePlotLegend"]]) return(tempPlot) } diff --git a/inst/qml/NonParametricSurvivalAnalysis.qml b/inst/qml/NonParametricSurvivalAnalysis.qml index 8301ca9..e3aef12 100644 --- a/inst/qml/NonParametricSurvivalAnalysis.qml +++ b/inst/qml/NonParametricSurvivalAnalysis.qml @@ -59,9 +59,9 @@ Form AssignedVariablesList { - name: "factors" - id: factors - title: qsTr("Factors") + name: "strata" + id: strata + title: qsTr("Strata") allowedColumns: ["nominal"] } } diff --git a/tests/testthat/test-nonparametricsurvivalanalysis.R b/tests/testthat/test-nonparametricsurvivalanalysis.R index d3f1eea..c511120 100644 --- a/tests/testthat/test-nonparametricsurvivalanalysis.R +++ b/tests/testthat/test-nonparametricsurvivalanalysis.R @@ -2,7 +2,7 @@ context("Nonparametric Survival Analysis") #### single group ---- options <- analysisOptions("NonParametricSurvivalAnalysis") -options$.meta <- list(eventStatus = list(shouldEncode = TRUE), factors = list( +options$.meta <- list(eventStatus = list(shouldEncode = TRUE), strata = list( shouldEncode = TRUE), timeToEvent = list(shouldEncode = TRUE)) options$colorPalette <- "colorblind" options$eventIndicator <- "1" @@ -77,12 +77,12 @@ test_that("Survival Curve plot matches", { #### multigroup + test ---- options <- analysisOptions("NonParametricSurvivalAnalysis") -options$.meta <- list(eventStatus = list(shouldEncode = TRUE), factors = list( +options$.meta <- list(eventStatus = list(shouldEncode = TRUE), strata = list( shouldEncode = TRUE), timeToEvent = list(shouldEncode = TRUE)) options$colorPalette <- "grandBudapest" options$eventIndicator <- "1" options$eventStatus <- "status" -options$factors <- "x" +options$strata <- "x" options$lifeTable <- TRUE options$lifeTableStepsType <- "quantiles" options$survivalCurveCensoringPlot <- TRUE From 0cdbed0c97cd3b3cf7ab5ad5c0063a4dd9060758 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:54:00 +0200 Subject: [PATCH 19/24] enable `ColorPalette` and `Legend` only when strata is selected --- inst/qml/qml_components/SurvivalPlot.qml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/inst/qml/qml_components/SurvivalPlot.qml b/inst/qml/qml_components/SurvivalPlot.qml index 1146e83..e1c0436 100644 --- a/inst/qml/qml_components/SurvivalPlot.qml +++ b/inst/qml/qml_components/SurvivalPlot.qml @@ -110,6 +110,7 @@ CheckBox DropDown { name: "plotLegend" + enabled: strata.count > 0 label: qsTr("Legend") values: [ @@ -121,7 +122,10 @@ CheckBox ] } - ColorPalette{} + ColorPalette + { + enabled: strata.count > 0 + } DropDown { From 557159c488d816cfa32941fb179708b2cc783a99 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 10:54:09 +0200 Subject: [PATCH 20/24] fix ready function --- R/semiparametricsurvivalanalysis.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index b9fd8fd..c35b3d2 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -793,7 +793,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state } .saspCoxWaitingForFrailty <- function(options) { - if (is.null(options[["frailty"]]) || (options[["frailty"]] != "" && options[["frailtyMethod"]] != "fixed")) + if (is.null(options[["frailty"]]) || options[["frailty"]] == "" || (options[["frailty"]] != "" && options[["frailtyMethod"]] != "fixed")) return(FALSE) else switch( From 4c82b0e571700b50e60880a2a3a07424272817c5 Mon Sep 17 00:00:00 2001 From: FBartos Date: Mon, 21 Oct 2024 15:43:33 +0200 Subject: [PATCH 21/24] fix residual plots --- R/semiparametricsurvivalanalysis.R | 36 ++++++++++++------- inst/qml/SemiParametricSurvivalAnalysis.qml | 39 +++++++++------------ 2 files changed, 41 insertions(+), 34 deletions(-) diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index c35b3d2..58076ca 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -609,7 +609,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state ### create all requested plots # residuals vs time - if (options[["residualPlotResidualVsTime"]] && is.null(residualsPlots[["residualPlotResidualVsTime"]])) { + if (options[["residualPlotResidualType"]] %in% c("martingale", "deviance") && options[["residualPlotResidualVsTime"]] && is.null(residualsPlots[["residualPlotResidualVsTime"]])) { residualPlotResidualVsTime <- createJaspPlot(title = gettext("Residuals vs. Time"), dependencies = "residualPlotResidualVsTime", position = 1, width = 450, height = 320) residualsPlots[["residualPlotResidualVsTime"]] <- residualPlotResidualVsTime @@ -650,20 +650,31 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (grepl("frailty", colnames(predictorsFit)[i])) next - tempPredictorName <- .saTermNames(colnames(predictorsFit)[i], c(options[["covariates"]], options[["factors"]])) - residualsPlots[[paste0("residualPlotResidualVsPredictors", i)]] <- createJaspPlot( - plot = .saspResidualsPlot(x = predictorsFit[varIndx,i], y = residuals, xlab = tempPredictorName, ylab = .saspResidualsPlotName(options)), - title = gettextf("Residuals vs. %1$s", tempPredictorName), - position = i, - width = 450, - height = 320 - ) + if (options[["residualPlotResidualType"]] %in% c("schoenfeld", "scaledSchoenfeld", "score")) { + tempPredictorName <- .saTermNames(colnames(predictorsFit)[i], c(options[["covariates"]], options[["factors"]])) + residualsPlots[[paste0("residualPlotResidualVsPredictors", i)]] <- createJaspPlot( + plot = .saspResidualsPlot(x = predictorsFit[varIndx,i], y = if (ncol(predictorsFit) == 1) residuals else residuals[,i], xlab = tempPredictorName, ylab = .saspResidualsPlotName(options)), + title = gettextf("Residuals vs. %1$s", tempPredictorName), + position = i, + width = 450, + height = 320 + ) + } else { + tempPredictorName <- .saTermNames(colnames(predictorsFit)[i], c(options[["covariates"]], options[["factors"]])) + residualsPlots[[paste0("residualPlotResidualVsPredictors", i)]] <- createJaspPlot( + plot = .saspResidualsPlot(x = predictorsFit[varIndx,i], y = residuals, xlab = tempPredictorName, ylab = .saspResidualsPlotName(options)), + title = gettextf("Residuals vs. %1$s", tempPredictorName), + position = i, + width = 450, + height = 320 + ) + } } } } # residuals vs predicted - if (options[["residualPlotResidualVsPredicted"]] && is.null(residualsPlots[["residualPlotResidualVsPredicted"]])) { + if (options[["residualPlotResidualType"]] %in% c("martingale", "deviance") && options[["residualPlotResidualVsPredicted"]] && is.null(residualsPlots[["residualPlotResidualVsPredicted"]])) { residualPlotResidualVsPredicted <- createJaspPlot(title = gettext("Residuals vs. Predicted"), dependencies = "residualPlotResidualVsPredicted", position = 3, width = 450, height = 320) residualsPlots[["residualPlotResidualVsPredicted"]] <- residualPlotResidualVsPredicted @@ -671,7 +682,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (jaspBase::isTryError(residuals)) { residualPlotResidualVsPredicted$setError(residuals) } else { - tempPlot <- try(.saspResidualsPlot(x = predict(fit)[varIndx], y = residuals, xlab = gettext("Predicted"), ylab = .saspResidualsPlotName(options))) + tempPlot <- try(.saspResidualsPlot(y = exp(-predict(fit, type = "expected")[varIndx]), x = residuals, ylab = gettext("Predicted Survival"), xlab = .saspResidualsPlotName(options))) if (jaspBase::isTryError(tempPlot)) residualsPlots$setError(tempPlot) @@ -681,7 +692,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state } # residuals histogram - if (options[["residualPlotResidualHistogram"]] && is.null(residualsPlots[["residualPlotResidualHistogram"]])) { + if (options[["residualPlotResidualType"]] %in% c("martingale", "deviance") && options[["residualPlotResidualHistogram"]] && is.null(residualsPlots[["residualPlotResidualHistogram"]])) { residualPlotResidualHistogram <- createJaspPlot(title = gettext("Residuals Histogram"), dependencies = "residualPlotResidualHistogram", position = 4, width = 450, height = 320) residualsPlots[["residualPlotResidualHistogram"]] <- residualPlotResidualHistogram @@ -723,6 +734,7 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state switch( options[["residualPlotResidualType"]], "martingale" = gettext("Martingale Residuals"), + "deviance" = gettext("Deviance Residuals"), "score" = gettext("Score Residuals"), "schoenfeld" = gettext("Schoenfeld Residuals"), "scaledSchoenfeld" = gettext("Scaled Schoenfeld Residuals") diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 8a4ad4d..9031c8c 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -457,25 +457,28 @@ Form { name: "residualPlotResidualVsTime" label: qsTr("Residuals vs. time") + enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" } CheckBox { - name: "residualPlotResidualVsPredictors" - label: qsTr("Residuals vs. predictors") - enabled:selectedModelTerms.count > 0 + name: "residualPlotResidualVsPredictors" + label: qsTr("Residuals vs. predictors") + enabled: selectedModelTerms.count > 0 } CheckBox { - name: "residualPlotResidualVsPredicted" - label: qsTr("Residuals vs. predicted") + name: "residualPlotResidualVsPredicted" + label: qsTr("Residuals vs. predicted survival") + enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" } CheckBox { - name: "residualPlotResidualHistogram" - label: qsTr("Residuals histogram") + name: "residualPlotResidualHistogram" + label: qsTr("Residuals histogram") + enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" } DropDown @@ -483,21 +486,13 @@ Form name: "residualPlotResidualType" id: residualPlotResidualType label: qsTr("Type") - values: (function() { - if (frailty.count == 0) { - return [ - { label: qsTr("Martingale"), value: "martingale"}, - { label: qsTr("Score"), value: "score"}, - { label: qsTr("Schoenfeld"), value: "schoenfeld"}, - { label: qsTr("Scaled Schoenfeld"), value: "scaledSchoenfeld"} - ]; - } else { - return [ - { label: qsTr("Martingale"), value: "martingale"} - ]; - } - })() - + values: [ + { label: qsTr("Martingale"), value: "martingale"}, + { label: qsTr("Deviance"), value: "deviance"}, + { label: qsTr("Score"), value: "score"}, + { label: qsTr("Schoenfeld"), value: "schoenfeld"}, + { label: qsTr("Scaled Schoenfeld"), value: "scaledSchoenfeld"} + ] } } } From 969fb50a2c503619001915ea55fdf57110ba4536 Mon Sep 17 00:00:00 2001 From: boutinb Date: Mon, 21 Oct 2024 16:35:08 +0200 Subject: [PATCH 22/24] Set preferredHeight for variablesForm --- inst/qml/SemiParametricSurvivalAnalysis.qml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 9031c8c..5e1efeb 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -28,8 +28,7 @@ Form VariablesForm { removeInvisibles: true - // TODO: Bruno fix height adjustment please - height: censoringTypeRight.checked ? 900 : 1100 + preferredHeight: (censoringTypeRight.checked ? 400 : 450 ) * jaspTheme.uiScale AvailableVariablesList { From c1774501185ddab5845597cf10c73314c2e56c92 Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 23 Oct 2024 16:51:43 +0200 Subject: [PATCH 23/24] fix issues from the review --- R/commonsurvivalanalysis.R | 4 ++-- R/semiparametricsurvivalanalysis.R | 16 ++++++++-------- inst/qml/SemiParametricSurvivalAnalysis.qml | 19 +++++++++---------- 3 files changed, 19 insertions(+), 20 deletions(-) diff --git a/R/commonsurvivalanalysis.R b/R/commonsurvivalanalysis.R index 38e34e2..addc253 100644 --- a/R/commonsurvivalanalysis.R +++ b/R/commonsurvivalanalysis.R @@ -54,7 +54,7 @@ # check that interval start < end if (options[["censoringType"]] == "counting") { if (any(dataset[[options[["intervalStart"]]]] > dataset[[options[["intervalEnd"]]]])) - .quitAnalysis(gettextf("The end time must be larger than start time.")) + .quitAnalysis(gettextf("The end time must be larger than the start time.")) } if (!is.null(covariatesVariable)) @@ -184,7 +184,7 @@ options[["frailtyDistribution"]], # simplifying GUI for fixed (instead of having fixed.theta and fixed.df) if (options[["frailtyMethod"]] == "fixed" && options[["frailtyMethodFixed"]] == "theta") "fixed" - else if(options[["frailtyMethod"]] == "fixed" && options[["frailtyMethodFixed"]] == "df") "df" + else if (options[["frailtyMethod"]] == "fixed" && options[["frailtyMethodFixed"]] == "df") "df" else options[["frailtyMethod"]], # adding the fixed part if (options[["frailtyMethod"]] != "fixed") "" diff --git a/R/semiparametricsurvivalanalysis.R b/R/semiparametricsurvivalanalysis.R index 58076ca..8d3f4a0 100644 --- a/R/semiparametricsurvivalanalysis.R +++ b/R/semiparametricsurvivalanalysis.R @@ -747,10 +747,12 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state if (HR) { - estimatesFit <- cbind( - "est" = exp(coef(fit)), - exp(confint(fit, level = options[["coefficientsConfidenceIntervalsLevel"]])) - ) + estimatesFit <- data.frame("est" = exp(coef(fit))) + + if (options[[ "coefficientsConfidenceIntervals"]]) { + estimatesFit <- cbind(estimatesFit, exp(confint(fit, level = options[["coefficientsConfidenceIntervalsLevel"]]))) + colnames(estimatesFit)[2:3] <- c("lower", "upper") + } if (!options[["coefficientHazardRatioEstimatesIncludeFrailty"]]) estimatesFit <- estimatesFit[grepl("JaspColumn", rownames(estimatesFit)), , drop=FALSE] @@ -781,13 +783,11 @@ SemiParametricSurvivalAnalysis <- function(jaspResults, dataset, options, state # fix names if (!HR) colnames(estimatesFit) <- names(toExtract)[toExtract %in% namesEstimatesFit] - else - colnames(estimatesFit) <- c("est", "lower", "upper") # add confidence intervals if (!HR && options[["coefficientsConfidenceIntervals"]]) { - estimatesFit$lower <- estimatesFit[,"est"] + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] - estimatesFit$upper <- estimatesFit[,"est"] - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[,if("rse" %in% colnames(estimatesFit)) "rse" else "se"] + estimatesFit$lower <- estimatesFit[, "est"] + qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[, if("rse" %in% colnames(estimatesFit)) "rse" else "se"] + estimatesFit$upper <- estimatesFit[, "est"] - qnorm((1 - options[["coefficientsConfidenceIntervalsLevel"]]) / 2) * estimatesFit[, if("rse" %in% colnames(estimatesFit)) "rse" else "se"] } estimatesFit <- cbind( diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index 5e1efeb..f49c7b4 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -63,7 +63,7 @@ Form title: qsTr("Time to Event") allowedColumns: ["scale"] singleVariable: true - visible: censoringTypeRight.checked + visible: censoringTypeRight.checked property bool active: censoringTypeRight.checked onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) } @@ -153,8 +153,7 @@ Form VariablesForm { - // TODO Bruno: the heigh adjustment does not seem to work - height: 300 + preferredHeight: 300 AvailableVariablesList { @@ -263,7 +262,7 @@ Form name: "frailtyMethodFixed" id: frailtyMethodFixed label: qsTr("Fix") - values: + values: [ { label: qsTr("Theta"), value: "theta"}, { label: qsTr("Df"), value: "df"} @@ -302,7 +301,7 @@ Form name: "availableTerms" title: qsTr("Components") width: parent.width / 4 - source: ['covariates', 'factors', 'strata'] + source: ['covariates', 'factors', 'strata'] } ModelTermsList @@ -349,7 +348,7 @@ Form enabled: frailty.count == 0 label: qsTr("Score (log-rank)") } - } + } } Group @@ -391,12 +390,12 @@ Form label: qsTr("Confidence intervals") checked: true childrenOnSameRow: true - + CIField { name: "coefficientsConfidenceIntervalsLevel" } - } + } } } } @@ -444,14 +443,14 @@ Form { name: "proportionalHazardsTestTerms" label: qsTr("Test terms") - } + } } Group { title: qsTr("Residuals Plots") - + CheckBox { name: "residualPlotResidualVsTime" From 5793f9f70b9f59d709db9f0130cf4749e87232da Mon Sep 17 00:00:00 2001 From: FBartos Date: Wed, 23 Oct 2024 17:40:27 +0200 Subject: [PATCH 24/24] add documentation --- inst/qml/NonParametricSurvivalAnalysis.qml | 19 +++++++++- inst/qml/SemiParametricSurvivalAnalysis.qml | 41 +++++++++++++++++++++ inst/qml/qml_components/SurvivalPlot.qml | 15 ++++++++ 3 files changed, 74 insertions(+), 1 deletion(-) diff --git a/inst/qml/NonParametricSurvivalAnalysis.qml b/inst/qml/NonParametricSurvivalAnalysis.qml index e3aef12..81921b4 100644 --- a/inst/qml/NonParametricSurvivalAnalysis.qml +++ b/inst/qml/NonParametricSurvivalAnalysis.qml @@ -24,7 +24,9 @@ import JASP 1.0 import "./qml_components" as SA Form -{ +{ + info: qsTr("This analysis computes a survival curve for censored data using the Kaplan-Meier estimator for single-event survival data. It estimates the probability of survival over time, allowing you to understand and visualize the distribution of survival times within your data. The analysis accommodates censored observations (subjects for whom the event has not occurred during the study period) and enables comparison of survival curves across different groups using statistical tests such as the Log-Rank test, Peto and Peto test, and Fleming-Harrington test. Additionally, you can generate life tables to summarize survival data at specified intervals.") + VariablesForm { AvailableVariablesList @@ -38,6 +40,7 @@ Form title: qsTr("Time to Event") allowedColumns: ["scale"] singleVariable: true + info: qsTr("Select the variable that represents the time until the event or censoring occurs.") } AssignedVariablesList @@ -47,6 +50,7 @@ Form title: qsTr("Event Status") allowedColumns: ["nominal"] singleVariable: true + info: qsTr("Choose the variable that indicates the event status, specifying whether each observation is an event or censored.") } DropDown @@ -55,6 +59,7 @@ Form label: qsTr("Event Indicator") source: [{name: "eventStatus", use: "levels"}] onCountChanged: currentIndex = 1 + info: qsTr("Specify the value in the Event Status variable that indicates the occurrence of the event.") } AssignedVariablesList @@ -63,6 +68,7 @@ Form id: strata title: qsTr("Strata") allowedColumns: ["nominal"] + info: qsTr("Select variables to define strata, allowing separate survival curves for each stratum.") } } @@ -77,18 +83,21 @@ Form { name: "testsLogRank" label: qsTr("Log-rank (Mantel-Haenszel)") + info: qsTr("Include the Log-Rank (Mantel-Haenszel) test to compare survival curves across strata.") } CheckBox { name: "testsPetoAndPeto" label: qsTr("Peto and Peto") + info: qsTr("Include the Peto and Peto modification of the Gehan-Wilcoxon test to compare survival curves across strata.") } CheckBox { name: "testsFlemmingHarrington" label: qsTr("Flemming-Harrington") + info: qsTr("Include the Fleming-Harrington test to compare survival curves across strata., with a customizable rho parameter.") DoubleField { @@ -97,6 +106,7 @@ Form defaultValue: 0.5 min: 0 max: 1 + info: qsTr("Set the rho parameter for the Fleming-Harrington test, controlling the weight given to different time points (values between 0 and 1).") } } } @@ -105,12 +115,14 @@ Form { name: "lifeTable" label: qsTr("Life table") + info: qsTr("Generate a life table summarizing survival data at specified time intervals.") DropDown { name: "lifeTableStepsType" id: lifeTableStepsType label: qsTr("Steps type") + info: qsTr("Select the method to define intervals for the life table: Default, Quantiles, or Fixed size.") values: [ { label: qsTr("Default"), value: "default"}, @@ -125,6 +137,7 @@ Form label: qsTr("Number") defaultValue: 10 visible: lifeTableStepsType.value == "quantiles" + info: qsTr("Specify the number of intervals when using Quantiles as the steps type.") } CheckBox @@ -133,6 +146,7 @@ Form label: qsTr("Round steps") checked: true visible: lifeTableStepsType.value == "quantiles" + info: qsTr("Round the interval boundaries to the nearest integer when using Quantiles steps.") } DoubleField @@ -143,6 +157,7 @@ Form defaultValue: 0 max: lifeTableStepsTo.value visible: lifeTableStepsType.value == "fixedSize" + info: qsTr("Set the starting time for intervals when using Fixed size steps.") } DoubleField @@ -152,6 +167,7 @@ Form defaultValue: 1 // max: lifeTableStepsTo.value // TODO: enable once max is data dependent visible: lifeTableStepsType.value == "fixedSize" + info: qsTr("Define the size of each interval when using Fixed size steps.") } DoubleField @@ -162,6 +178,7 @@ Form defaultValue: 0 min: lifeTableStepsFrom.value visible: lifeTableStepsType.value == "fixedSize" + info: qsTr("Set the ending time for intervals when using Fixed size steps.") } } } diff --git a/inst/qml/SemiParametricSurvivalAnalysis.qml b/inst/qml/SemiParametricSurvivalAnalysis.qml index f49c7b4..03eb50f 100644 --- a/inst/qml/SemiParametricSurvivalAnalysis.qml +++ b/inst/qml/SemiParametricSurvivalAnalysis.qml @@ -25,6 +25,8 @@ import "./qml_components" as SA Form { + info: qsTr("This analysis performs a Cox proportional hazards regression, a statistical method used in survival analysis to examine the relationship between the time until an event occurs (such as death or failure) and one or more predictor variables. It helps you understand how different factors influence the risk or hazard of the event happening at any given time. The Cox model is particularly useful because it can handle censored data (when the event has not occurred for some subjects during the study period) and does not require assumptions about the baseline hazard function.") + VariablesForm { removeInvisibles: true @@ -44,6 +46,7 @@ Form visible: censoringTypeCounting.checked property bool active: censoringTypeCounting.checked onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) + info: qsTr("Select the variable that represents the start time of the observation interval. Only available when Censoring Type is set to Counting.") } AssignedVariablesList @@ -55,6 +58,7 @@ Form visible: censoringTypeCounting.checked property bool active: censoringTypeCounting.checked onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) + info: qsTr("Select the variable that represents the end time of the observation interval. Only available when Censoring Type is set to Counting.") } AssignedVariablesList @@ -66,6 +70,7 @@ Form visible: censoringTypeRight.checked property bool active: censoringTypeRight.checked onActiveChanged: if (!active && count > 0) itemDoubleClicked(0) + info: qsTr("Select the variable that represents the time until the event or censoring occurs. Only available when Censoring Type is set to Right.") } AssignedVariablesList @@ -75,6 +80,7 @@ Form title: qsTr("Event Status") allowedColumns: ["nominal"] singleVariable: true + info: qsTr("Choose the variable that indicates the event status, specifying whether each observation is an event or censored.") } DropDown @@ -83,6 +89,7 @@ Form label: qsTr("Event Indicator") source: [{name: "eventStatus", use: "levels"}] onCountChanged: currentIndex = 1 + info: qsTr("Specify the value in the Event Status variable that indicates the occurrence of the event.") } AssignedVariablesList @@ -90,6 +97,7 @@ Form name: "covariates" title: qsTr("Covariates") allowedColumns: ["scale"] + info: qsTr("Add continuous variables as covariates to include them in the Cox regression model.") } AssignedVariablesList @@ -97,6 +105,7 @@ Form name: "factors" title: qsTr("Factors") allowedColumns: ["nominal"] + info: qsTr("Add categorical variables as factors to include them in the Cox regression model.") } @@ -106,6 +115,7 @@ Form title: qsTr("Weights") allowedColumns: ["scale"] singleVariable: true + info: qsTr("Select a variable for case weights, weighting each observation accordingly in the model.") } } @@ -120,6 +130,7 @@ Form { label: qsTr("Breslow"), value: "breslow"}, { label: qsTr("Exact"), value: "exact"} ] + info: qsTr("Choose the method for handling tied event times: Efron, Breslow, or Exact.") } RadioButtonGroup @@ -130,6 +141,7 @@ Form title: qsTr("Censoring Type") radioButtonsOnSameRow: true columns: 2 + info: qsTr("Select the type of censoring in your data: Right censoring or Counting process.") RadioButton { @@ -166,6 +178,7 @@ Form id: strata title: qsTr("Strata") allowedColumns: ["nominal"] + info: qsTr("Select variables to define strata, allowing separate baseline hazard functions for each stratum.") } // TODO: allow only if multiple outcomes are possible @@ -187,6 +200,7 @@ Form title: qsTr("Cluster") allowedColumns: ["nominal"] singleVariable: true + info: qsTr("Select a variable to define clusters of correlated observations for robust variance estimation. Disabled when a Frailty variable is specified or Method is set to Exact.") } AssignedVariablesList @@ -197,6 +211,7 @@ Form title: qsTr("Frailty") allowedColumns: ["nominal"] singleVariable: true + info: qsTr("Select a variable for frailty to model unobserved heterogeneity using random effects. Disabled when a Cluster variable is specified.") } } @@ -210,6 +225,7 @@ Form name: "frailtyDistribution" id: frailtyDistribution label: qsTr("Distribution") + info: qsTr("Choose the distribution for the frailty term: Gamma, Gaussian, or T distribution. Only available when a Frailty variable is specified.") values: [ { label: qsTr("Gamma"), value: "gamma"}, @@ -223,6 +239,7 @@ Form name: "frailtyMethod" id: frailtyMethod label: qsTr("Method") + info: qsTr("Select the estimation method for the frailty distribution. Options vary based on the chosen Distribution.") values: (function() { if (frailtyDistribution.value == "gamma") { return [ @@ -251,6 +268,7 @@ Form visible: frailtyDistribution.value == "t" name: "frailtyMethodTDf" defaultValue: 5 + info: qsTr("Set the degrees of freedom (Df) for the T frailty distribution. Only visible when Distribution is set to T.") } Group @@ -262,6 +280,7 @@ Form name: "frailtyMethodFixed" id: frailtyMethodFixed label: qsTr("Fix") + info: qsTr("Choose the parameter to fix in the frailty model when Method is set to Fixed: Theta or Df.") values: [ { label: qsTr("Theta"), value: "theta"}, @@ -275,6 +294,7 @@ Form visible: frailtyMethodFixed.value == "theta" name: "frailtyMethodFixedTheta" defaultValue: 0 + info: qsTr("Specify the value of Theta to fix in the frailty model. Only visible when Fix is set to Theta.") } DoubleField @@ -283,6 +303,7 @@ Form visible: frailtyMethodFixed.value == "df" name: "frailtyMethodFixedDf" defaultValue: 0 + info: qsTr("Specify the degrees of freedom (Df) to fix in the frailty model. Only visible when Fix is set to Df.") } } } @@ -323,16 +344,19 @@ Form { name: "modelFit" label: qsTr("Model fit") + info: qsTr("Include overall model fit statistics in the output.") } Group { title: qsTr("Tests") + info: qsTr("Test all parameters of the H₁ model.") CheckBox { name: "testsLikelihoodRatio" label: qsTr("Likelihood ratio") + info: qsTr("Include the Likelihood Ratio Test in the model summary.") } CheckBox @@ -340,6 +364,7 @@ Form name: "testsWald" enabled: frailty.count == 0 label: qsTr("Wald") + info: qsTr("Include the Wald Test in the model summary. Disabled when a Frailty variable is specified.") } CheckBox @@ -347,6 +372,7 @@ Form name: "testsScore" enabled: frailty.count == 0 label: qsTr("Score (log-rank)") + info: qsTr("Include the Score (Log-Rank) Test in the model summary. Disabled when a Frailty variable is specified.") } } } @@ -362,11 +388,13 @@ Form name: "coefficientEstimate" label: qsTr("Estimates") checked: true + info: qsTr("Display the estimated coefficients in the model output.") CheckBox { name: "vovkSellke" label: qsTr("Vovk-Sellke maximum p-ratio") + info: qsTr("Include the Vovk-Sellke maximum p-ratio for each coefficient.") } } @@ -375,12 +403,14 @@ Form name: "coefficientHazardRatioEstimates" label: qsTr("Hazard ratio estimates") checked: true + info: qsTr("Display the hazard ratio estimates (exponentiated coefficients).") CheckBox { name: "coefficientHazardRatioEstimatesIncludeFrailty" label: qsTr("Include frailty") enabled: frailty.count > 0 + info: qsTr("Include the effect of frailty in hazard ratio estimates. Only available when a Frailty variable is specified.") } } @@ -390,10 +420,12 @@ Form label: qsTr("Confidence intervals") checked: true childrenOnSameRow: true + info: qsTr("Include confidence intervals for the coefficients.") CIField { name: "coefficientsConfidenceIntervalsLevel" + info: qsTr("Set the confidence level (e.g., 95%) for the confidence intervals.") } } } @@ -419,18 +451,21 @@ Form { name: "proportionalHazardsTable" label: qsTr("Table") + info: qsTr("Provide a table to test the proportional hazards assumption.") } CheckBox { name: "proportionalHazardsPlot" label: qsTr("Plot") + info: qsTr("Generate plots to assess the proportional hazards assumption.") } DropDown { name: "proportionalHazardsTransformation" label: qsTr("Transformation") + info: qsTr("Select the transformation for time in proportional hazards testing: KM, Rank, or Identity.") values: [ { label: qsTr("KM"), value: "km"}, @@ -443,6 +478,7 @@ Form { name: "proportionalHazardsTestTerms" label: qsTr("Test terms") + info: qsTr("Test the proportional hazards assumption for individual model terms (instead of coefficients).") } } @@ -456,6 +492,7 @@ Form name: "residualPlotResidualVsTime" label: qsTr("Residuals vs. time") enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" + info: qsTr("Plot residuals versus time to detect non-proportional hazards. Available only for Martingale or Deviance residuals.") } CheckBox @@ -463,6 +500,7 @@ Form name: "residualPlotResidualVsPredictors" label: qsTr("Residuals vs. predictors") enabled: selectedModelTerms.count > 0 + info: qsTr("Plot residuals versus predictors to assess model fit. Available when model terms are specified.") } CheckBox @@ -470,6 +508,7 @@ Form name: "residualPlotResidualVsPredicted" label: qsTr("Residuals vs. predicted survival") enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" + info: qsTr("Plot residuals versus predicted survival probabilities. Available only for Martingale or Deviance residuals.") } CheckBox @@ -477,6 +516,7 @@ Form name: "residualPlotResidualHistogram" label: qsTr("Residuals histogram") enabled: residualPlotResidualType.value == "martingale" || residualPlotResidualType.value == "deviance" + info: qsTr("Display a histogram of residuals to assess their distribution. Available only for Martingale or Deviance residuals.") } DropDown @@ -484,6 +524,7 @@ Form name: "residualPlotResidualType" id: residualPlotResidualType label: qsTr("Type") + info: qsTr("Select the type of residuals to plot: Martingale, Deviance, Score, Schoenfeld, or Scaled Schoenfeld.") values: [ { label: qsTr("Martingale"), value: "martingale"}, { label: qsTr("Deviance"), value: "deviance"}, diff --git a/inst/qml/qml_components/SurvivalPlot.qml b/inst/qml/qml_components/SurvivalPlot.qml index e1c0436..6263309 100644 --- a/inst/qml/qml_components/SurvivalPlot.qml +++ b/inst/qml/qml_components/SurvivalPlot.qml @@ -24,11 +24,13 @@ CheckBox { name: "plot" label: qsTr("Plot") + info: qsTr("This option generates a customizable survival plot to visualize the estimated survival probabilities over time from your survival analysis. You can choose different transformations of the survival probabilities to display, such as Survival, Risk, Cumulative Hazard, or Complementary Log-Log functions, depending on your analytical needs. The plot allows you to include confidence intervals to assess the precision of the estimates and add a risk table to provide detailed information about the number of subjects at risk and events over time. You can further enhance the plot by adding quantile lines to highlight specific survival times (e.g., median survival time) and adjust the legend position, color palette, and overall theme to suit your preferences.") DropDown { name: "plotType" label: qsTr("Type") + info: qsTr("Select the type of statistic to plot: Survival, Risk, Cumulative Hazard, or Complementary Log-Log.") values: [ { label: qsTr("Survival"), value: "survival"}, @@ -43,6 +45,7 @@ CheckBox name: "plotCi" label: qsTr("Confidence interval") checked: true + info: qsTr("Include confidence intervals in the survival plot to show the variability around the estimates.") } CheckBox @@ -50,12 +53,14 @@ CheckBox name: "plotRiskTable" label: qsTr("Risk table") checked: false + info: qsTr("Add a risk table below the plot to display additional information about the number of subjects at risk over time.") CheckBox { name: "plotRiskTableNumberAtRisk" label: qsTr("Number at risk") checked: true + info: qsTr("Display the number of subjects at risk at each time point in the risk table.") } CheckBox @@ -63,30 +68,35 @@ CheckBox name: "plotRiskTableCumulativeNumberOfObservedEvents" label: qsTr("Cum. number of observed events") checked: true + info: qsTr("Display the cumulative number of observed events (e.g., deaths) at each time point in the risk table.") } CheckBox { name: "plotRiskTableCumulativeNumberOfCensoredObservations" label: qsTr("Cum. number of censored obs.") + info: qsTr("Display the cumulative number of censored observations at each time point in the risk table.") } CheckBox { name: "plotRiskTableNumberOfEventsInTimeInterval" label: qsTr("Number of events in time interval") + info: qsTr("Display the number of events that occurred within each time interval in the risk table.") } CheckBox { name: "plotRiskTableNumberOfCensoredObservationsInTimeInterval" label: qsTr("Number of censored obs. in time interval") + info: qsTr("Display the number of censored observations within each time interval in the risk table.") } CheckBox { name: "plotRiskTableAsASingleLine" label: qsTr("As a single line") + info: qsTr("Combine all selected risk table statistics into a single line for a more compact display.") } } @@ -96,6 +106,7 @@ CheckBox label: qsTr("Add quantile") checked: false childrenOnSameRow: true + info: qsTr("Add a vertical line on the plot at a specified quantile (e.g., median survival time).") DoubleField { @@ -103,6 +114,7 @@ CheckBox defaultValue: 0.5 min: 0 max: 1 + info: qsTr("Specify the quantile value (between 0 and 1) at which to add the vertical line on the plot.") } } @@ -112,6 +124,7 @@ CheckBox name: "plotLegend" enabled: strata.count > 0 label: qsTr("Legend") + info: qsTr("Choose the position of the legend on the plot: Bottom, Right, Left, Top, or None. Only available when Strata variables are specified.") values: [ { label: qsTr("Bottom"), value: "bottom"}, @@ -125,12 +138,14 @@ CheckBox ColorPalette { enabled: strata.count > 0 + info: qsTr("Customize the color palette used in the plot. Only available when Strata variables are specified.") } DropDown { name: "plotTheme" label: qsTr("Theme") + info: qsTr("Select the theme for the plot's appearance: JASP for the default look or ggsurvfit for the ggsurvfit package style.") values: [ { label: qsTr("JASP"), value: "jasp"},