From ab7b788dd0607af708f8dcb60b5a1be350941919 Mon Sep 17 00:00:00 2001 From: cyk0315 Date: Thu, 15 Feb 2024 13:58:05 +0900 Subject: [PATCH 1/3] fix: error in anova --- R/forestglm.R | 65 +++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/R/forestglm.R b/R/forestglm.R index a87f165..10d7a01 100644 --- a/R/forestglm.R +++ b/R/forestglm.R @@ -43,15 +43,15 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, family = "binomial", decimal.estimate = 2, decimal.percent = 1, decimal.pvalue = 3) { . <- NULL - + if (length(formula[[3]]) > 1) stop("Formula must contains only 1 independent variable") if (any(class(data) == "survey.design" & !is.null(var_subgroup))) { if (is.numeric(data$variables[[var_subgroup]])) stop("var_subgroup must categorical.") } else if (any(class(data) == "data.frame" & !is.null(var_subgroup))) { if (is.numeric(data[[var_subgroup]])) stop("var_subgroup must categorical.") } - - + + ## functions with error possible_table <- purrr::possibly(table, NA) possible_prop.table <- purrr::possibly(function(x) { @@ -69,20 +69,20 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, possible_rowone <- purrr::possibly(function(x) { x[2, ] }, NA) - + 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, 1, length(levels(data[[xlabel]])) - 1) ) var_cov <- setdiff(var_cov, c(as.character(formula[[3]]), var_subgroup)) family.svyglm <- gaussian() if (family == "binomial") family.svyglm <- quasibinomial() - + 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::svyglm(formula, design = data, x = T, family = family.svyglm) # if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.") @@ -90,34 +90,34 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, model <- stats::glm(formula, data = data, x = T, family = family) # if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.") } - - + + Point.Estimate <- round(stats::coef(model), decimal.estimate)[2] CI <- round(stats::confint(model)[2, ], decimal.estimate) if (family == "binomial") { Point.Estimate <- round(exp(stats::coef(model)), decimal.estimate)[2] CI <- round(exp(stats::confint(model)[2, ]), decimal.estimate) } - - - + + + # if (length(Point.Estimate) > 1){ # stop("Formula must contain 1 independent variable only.") # } - - - + + + # event <- model$y # prop <- round(prop.table(table(event, model$x[, 1]), 2)[2, ] * 100, decimal.percent) pv <- round(tail(summary(model)$coefficients[2, ], 1), decimal.pvalue) - + data.frame(Variable = "Overall", Count = length(model$y), Percent = 100, `Point Estimate` = Point.Estimate, Lower = CI[1], Upper = CI[2]) %>% dplyr::mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out - + if (family == "binomial") { names(out)[4] <- "OR" } - + return(out) } else if (length(var_subgroup) >= 2 | any(grepl(var_subgroup, formula))) { stop("Please input correct subgroup variable.") @@ -136,9 +136,14 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, 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.") - model.int <- survey::svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep = ""), deparse(formula))), design = data, family = family.svyglm) - - + data.design<-data + if(family=='binomial'){ + model.int <- survey::svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep = ""), deparse(formula))), design = data.design, family = quasibinomial()) + } + else{ + model.int <- survey::svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep = ""), deparse(formula))), design = data.design, family = gaussian()) + + } if (sum(grepl(":", names(coef(model.int)))) > 1) { pv_anova <- anova(model.int, method = "Wald") pv_int <- round(pv_anova[[length(pv_anova)]][[7]], decimal.pvalue) @@ -161,17 +166,17 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, 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 (sum(grepl(":", names(coef(model.int)))) > 1) { pv_anova <- anova(model.int, test = "Chisq") pv_int <- round(pv_anova[nrow(pv_anova), 5], decimal.pvalue) } - + Count <- as.vector(table(data[[var_subgroup]])) } - - - + + + Estimate <- model %>% purrr::map("coefficients", .default = NA) %>% purrr::map_dbl(2, .default = NA) @@ -185,18 +190,18 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, Point.Estimate <- round(exp(Estimate), decimal.estimate) CI <- round(exp(CI0), decimal.estimate) } - + model %>% purrr::map(possible_pv) %>% purrr::map_dbl(~ round(., decimal.pvalue)) -> pv - - + + data.frame(Variable = paste(" ", label_val), Count = Count, Percent = round(Count / sum(Count) * 100, decimal.percent), "Point Estimate" = Point.Estimate, Lower = CI[, 1], Upper = CI[, 2]) %>% dplyr::mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out if (family == "binomial") { names(out)[4] <- "OR" } - + return(rbind(c(var_subgroup, rep(NA, ncol(out) - 2), ifelse(pv_int >= 0.001, pv_int, "<0.001")), out)) } } From 871a39b43ca6f55bcc46d8c7b6d79552c4cc4d9a Mon Sep 17 00:00:00 2001 From: cyk0315 Date: Thu, 15 Feb 2024 13:58:24 +0900 Subject: [PATCH 2/3] fix: error in anova --- R/forestglm.R | 55 +++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/R/forestglm.R b/R/forestglm.R index 10d7a01..725fe5a 100644 --- a/R/forestglm.R +++ b/R/forestglm.R @@ -43,15 +43,15 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, family = "binomial", decimal.estimate = 2, decimal.percent = 1, decimal.pvalue = 3) { . <- NULL - + if (length(formula[[3]]) > 1) stop("Formula must contains only 1 independent variable") if (any(class(data) == "survey.design" & !is.null(var_subgroup))) { if (is.numeric(data$variables[[var_subgroup]])) stop("var_subgroup must categorical.") } else if (any(class(data) == "data.frame" & !is.null(var_subgroup))) { if (is.numeric(data[[var_subgroup]])) stop("var_subgroup must categorical.") } - - + + ## functions with error possible_table <- purrr::possibly(table, NA) possible_prop.table <- purrr::possibly(function(x) { @@ -69,20 +69,20 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, possible_rowone <- purrr::possibly(function(x) { x[2, ] }, NA) - + 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, 1, length(levels(data[[xlabel]])) - 1) ) var_cov <- setdiff(var_cov, c(as.character(formula[[3]]), var_subgroup)) family.svyglm <- gaussian() if (family == "binomial") family.svyglm <- quasibinomial() - + 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::svyglm(formula, design = data, x = T, family = family.svyglm) # if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.") @@ -90,34 +90,34 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, model <- stats::glm(formula, data = data, x = T, family = family) # if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.") } - - + + Point.Estimate <- round(stats::coef(model), decimal.estimate)[2] CI <- round(stats::confint(model)[2, ], decimal.estimate) if (family == "binomial") { Point.Estimate <- round(exp(stats::coef(model)), decimal.estimate)[2] CI <- round(exp(stats::confint(model)[2, ]), decimal.estimate) } - - - + + + # if (length(Point.Estimate) > 1){ # stop("Formula must contain 1 independent variable only.") # } - - - + + + # event <- model$y # prop <- round(prop.table(table(event, model$x[, 1]), 2)[2, ] * 100, decimal.percent) pv <- round(tail(summary(model)$coefficients[2, ], 1), decimal.pvalue) - + data.frame(Variable = "Overall", Count = length(model$y), Percent = 100, `Point Estimate` = Point.Estimate, Lower = CI[1], Upper = CI[2]) %>% dplyr::mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out - + if (family == "binomial") { names(out)[4] <- "OR" } - + return(out) } else if (length(var_subgroup) >= 2 | any(grepl(var_subgroup, formula))) { stop("Please input correct subgroup variable.") @@ -142,7 +142,6 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, } else{ model.int <- survey::svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep = ""), deparse(formula))), design = data.design, family = gaussian()) - } if (sum(grepl(":", names(coef(model.int)))) > 1) { pv_anova <- anova(model.int, method = "Wald") @@ -166,17 +165,17 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, 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 (sum(grepl(":", names(coef(model.int)))) > 1) { pv_anova <- anova(model.int, test = "Chisq") pv_int <- round(pv_anova[nrow(pv_anova), 5], decimal.pvalue) } - + Count <- as.vector(table(data[[var_subgroup]])) } - - - + + + Estimate <- model %>% purrr::map("coefficients", .default = NA) %>% purrr::map_dbl(2, .default = NA) @@ -190,18 +189,18 @@ TableSubgroupGLM <- function(formula, var_subgroup = NULL, var_cov = NULL, data, Point.Estimate <- round(exp(Estimate), decimal.estimate) CI <- round(exp(CI0), decimal.estimate) } - + model %>% purrr::map(possible_pv) %>% purrr::map_dbl(~ round(., decimal.pvalue)) -> pv - - + + data.frame(Variable = paste(" ", label_val), Count = Count, Percent = round(Count / sum(Count) * 100, decimal.percent), "Point Estimate" = Point.Estimate, Lower = CI[, 1], Upper = CI[, 2]) %>% dplyr::mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out if (family == "binomial") { names(out)[4] <- "OR" } - + return(rbind(c(var_subgroup, rep(NA, ncol(out) - 2), ifelse(pv_int >= 0.001, pv_int, "<0.001")), out)) } } From cb1f2127cf2216225942f3468385cdcde7723946 Mon Sep 17 00:00:00 2001 From: cyk0315 Date: Thu, 15 Feb 2024 14:09:41 +0900 Subject: [PATCH 3/3] 1.1.6 --- DESCRIPTION | 4 ++-- NEWS.md | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3b85b78..1b7d341 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jstable Title: Create Tables from Different Types of Regression -Version: 1.1.5 -Date: 2024-02-02 +Version: 1.1.6 +Date: 2024-02-15 Authors@R: c(person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), person("Zarathu", role = c("cph", "fnd")), person("Yoonkyoung","Jeon", role = c("aut")) diff --git a/NEWS.md b/NEWS.md index 94ef9b7..935c85f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# jstable 1.1.6 + +* Bugfix `TableSubgroupGLM`: thanks for `weisx2022` + # jstable 1.1.5 * Bugfix `TableSubgroupCox`: thanks for `ciciing`