Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix forestcox #16

Merged
merged 3 commits into from
Feb 2, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,9 +1,10 @@
Package: jstable
Title: Create Tables from Different Types of Regression
Version: 1.1.4
Date: 2024-01-05
Version: 1.1.5
Date: 2024-02-02
Authors@R: c(person("Jinseob", "Kim", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")),
person("Zarathu", role = c("cph", "fnd"))
person("Zarathu", role = c("cph", "fnd")),
person("Yoonkyoung","Jeon", role = c("aut"))
)
Description: Create regression tables from generalized linear model(GLM), generalized estimating equation(GEE), generalized linear mixed-effects model(GLMM), Cox proportional hazards model, survey-weighted generalized linear model(svyglm) and survey-weighted Cox model results for publication.
Depends: R (>= 3.4.0)
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# jstable 1.1.5

* Bugfix `TableSubgroupCox`: thanks for `ciciing`

# jstable 1.1.4

* Fix: confidence interval calculation in `svyglm` ( thanks for `cyk0315`)
Expand Down
49 changes: 29 additions & 20 deletions R/forestcox.R
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@
#' @importFrom survey svycoxph regTermTest
#' @importFrom stats confint coefficients
#' @importFrom utils tail


TableSubgroupCox <- function(formula, var_subgroup = NULL, var_cov = NULL, data, time_eventrate = 3 * 365, decimal.hr = 2, decimal.percent = 1, decimal.pvalue = 3) {
. <- NULL
Expand Down Expand Up @@ -84,28 +85,39 @@ TableSubgroupCox <- function(formula, var_subgroup = NULL, var_cov = NULL, data,
xlabel <- setdiff(as.character(formula)[[3]], "+")[1]

ncoef <- ifelse(any(class(data) == "survey.design"), ifelse(length(levels(data$variables[[xlabel]])) <= 2, 1, length(levels(data$variables[[xlabel]])) - 1),
ifelse(length(levels(data[[xlabel]])) <= 2, 1, length(levels(data[[xlabel]])) - 1)
ifelse(length(levels(data[[xlabel]])) <= 2||is.numeric(data[[xlabel]]), 1, length(levels(data[[xlabel]])) - 1)
)

if (is.null(var_subgroup)) {

if (!is.null(var_cov)) {
formula <- as.formula(paste0(deparse(formula), " + ", paste(var_cov, collapse = "+")))
}
if (any(class(data) == "survey.design")) {
model <- survey::svycoxph(formula, design = data, x = T)
# if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
if(is.numeric(data[[xlabel]])){
prop<-NULL
}
else{
res.kap <- survey::svykm(formula.km, design = data)
prop <- round(100 * sapply(res.kap, function(x) {
1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]
}), decimal.percent)
names(prop) <- model$xlevels[[1]]
}
} else {
model <- survival::coxph(formula, data = data, x = TRUE)
# if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
if(is.numeric(data[[xlabel]])){
prop<-NULL
}
else{
res.kap <- survival::survfit(formula.km, data = data)
res.kap.times <- summary(res.kap, times = time_eventrate, extend = T)
prop <- round(100 * (1 - res.kap.times[["surv"]]), decimal.percent)
names(prop) <- model$xlevels[[1]]
}
# out.kap <- paste(res.kap.times[["n.event"]], " (", round(100 * (1 - res.kap.times[["surv"]]), decimal.percent), ")", sep = "")
}

Expand Down Expand Up @@ -191,32 +203,33 @@ TableSubgroupCox <- function(formula, var_subgroup = NULL, var_cov = NULL, data,
names() -> label_val
xlev <- survival::coxph(formula, data = data)$xlevels
model.int <- possible_coxph(as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula))), data = data)
if (!is.numeric(data[[xlabel]])) {
res.kap.times <- data %>%
filter(!is.na(get(var_subgroup))) %>%
split(.[[var_subgroup]]) %>%
purrr::map(~ survival::survfit(formula.km, data = .)) %>%
purrr::map(~ summary(., times = time_eventrate, extend = T))
prop <- res.kap.times %>%
purrr::map(~ round(100 * (1 - .[["surv"]]), decimal.percent)) %>%
dplyr::bind_cols() %>%
t()
colnames(prop) <- xlev[[1]]
} else {
prop <- NULL
}
if (sum(grepl(":", names(coef(model.int)))) == 1) {
pvs_int <- model.int %>%
summary() %>%
coefficients()
pv_int <- round(pvs_int[nrow(pvs_int), ncol(pvs_int)], decimal.pvalue)
# if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
if (!is.numeric(data[[xlabel]])) {
res.kap.times <- data %>%
filter(!is.na(get(var_subgroup))) %>%
split(.[[var_subgroup]]) %>%
purrr::map(~ survival::survfit(formula.km, data = .)) %>%
purrr::map(~ summary(., times = time_eventrate, extend = T))
prop <- res.kap.times %>%
purrr::map(~ round(100 * (1 - .[["surv"]]), decimal.percent)) %>%
dplyr::bind_cols() %>%
t()
colnames(prop) <- xlev[[1]]
} else {
prop <- NULL
}

} else {
model.int$call$formula <- as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula)))
model.int$call$data <- as.name("data")
pv_anova <- anova(model.int)
pv_int <- round(pv_anova[nrow(pv_anova), 4], decimal.pvalue)
prop <- NULL

}
}

Expand Down Expand Up @@ -255,9 +268,6 @@ TableSubgroupCox <- function(formula, var_subgroup = NULL, var_cov = NULL, data,
}
}




#' @title TableSubgroupMultiCox: Multiple sub-group analysis table for Cox/svycox model.
#' @description Multiple sub-group analysis table for Cox/svycox model.
#' @param formula formula with survival analysis.
Expand Down Expand Up @@ -302,7 +312,6 @@ TableSubgroupCox <- function(formula, var_subgroup = NULL, var_cov = NULL, data,
#' @importFrom magrittr %>%
#' @importFrom dplyr bind_rows


TableSubgroupMultiCox <- function(formula, var_subgroups = NULL, var_cov = NULL, data, time_eventrate = 3 * 365, decimal.hr = 2, decimal.percent = 1, decimal.pvalue = 3, line = F) {
. <- NULL
out.all <- TableSubgroupCox(formula, var_subgroup = NULL, var_cov = var_cov, data = data, time_eventrate = time_eventrate, decimal.hr = decimal.hr, decimal.percent = decimal.percent, decimal.pvalue = decimal.pvalue)
Expand Down
Loading