diff --git a/DESCRIPTION b/DESCRIPTION
index 6f6562a2..6bc79bd2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Type: Package
Package: ClinicoPath
Title: Analysis for Clinicopathological Research
-Version: 0.0.1.0011
-Date: 2020-05-04
+Version: 0.0.1.0012
+Date: 2020-05-08
Authors@R:
person(given = "Serdar",
family = "Balci",
@@ -52,14 +52,20 @@ Imports:
epiR,
magrittr,
corrr,
- correlation
+ correlation,
+ RVAideMemoire
Remotes:
+ ddsjoberg/gtsummary,
ndphillips/FFTrees,
easystats/report,
- spgarbet/tangram@0.3.2
+ spgarbet/tangram,
+ cran/rmngb
Suggests:
circlize,
- randomForest
+ randomForest,
+ huxtable,
+ flextable,
+ Hmisc
VignetteBuilder:
knitr
Encoding: UTF-8
diff --git a/NAMESPACE b/NAMESPACE
index 5ca32140..7be2ef0c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,56 +1,47 @@
# Generated by roxygen2: do not edit by hand
-export("%>%")
export(agreement)
export(agreementClass)
export(competingsurvival)
-export(competingsurvivalClass)
export(correlation)
-export(correlationClass)
export(crosstable)
export(crosstableClass)
export(decision)
-export(decisionClass)
export(decisioncalculator)
-export(decisioncalculatorClass)
+export(gtsummary)
+export(gtsummaryClass)
export(icccoeff)
-export(icccoeffClass)
export(multisurvival)
-export(multisurvivalClass)
export(oddsratio)
-export(oddsratioClass)
export(pairchi)
-export(pairchiClass)
export(reportcat)
-export(reportcatClass)
export(roc)
-export(rocClass)
export(statsplot2)
-export(statsplot2Class)
export(summarydata)
-export(summarydataClass)
export(survival)
-export(survivalClass)
export(tableone)
-export(tableoneClass)
export(tree)
-export(treeClass)
export(vartree)
-export(vartreeClass)
+import(RVAideMemoire)
import(caret)
import(dplyr)
import(finalfit)
import(ggalluvial)
import(ggplot2)
import(ggstatsplot)
-import(irr)
+import(gtsummary)
import(jmvcore)
+import(rmngb)
import(survival)
import(survminer)
+import(tangram)
import(vtree)
importFrom(R6,R6Class)
importFrom(caret,confusionMatrix)
importFrom(ggalluvial,StatStratum)
+importFrom(irr,agree)
+importFrom(irr,kappa2)
+importFrom(irr,kappam.fleiss)
importFrom(jmvcore,toNumeric)
importFrom(magrittr,"%$%")
importFrom(magrittr,"%>%")
diff --git a/R/00jmv.R b/R/00jmv.R
index 601f7446..7f5d340e 100644
--- a/R/00jmv.R
+++ b/R/00jmv.R
@@ -255,4 +255,11 @@
`year`=2019,
`title`="rpart.plot: Plot 'rpart' Models: An Enhanced Version of 'plot.rpart'",
`publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=rpart.plot",
- `url`="https://CRAN.R-project.org/package=rpart.plot"))
+ `url`="https://CRAN.R-project.org/package=rpart.plot"),
+ `gtsummary`=list(
+ `type`="software",
+ `author`="Daniel D. Sjoberg, Margie Hannum, Karissa Whiting and Emily C. Zabor",
+ `year`=2020,
+ `title`="gtsummary: Presentation-Ready Data Summary and Analytic Result Tables",
+ `publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=gtsummary",
+ `url`="https://CRAN.R-project.org/package=gtsummary"))
diff --git a/R/agreement.b.R b/R/agreement.b.R
index e5faaf3c..d769a873 100644
--- a/R/agreement.b.R
+++ b/R/agreement.b.R
@@ -1,126 +1,102 @@
#' Interrater Reliability Analysis
-#'
-#' @return
+#' @return Table
#' @export
-#'
-#'
-#'
#' @importFrom R6 R6Class
#' @import jmvcore
-#' @import irr
+#' @importFrom irr kappa2
+#' @importFrom irr kappam.fleiss
+#' @importFrom irr agree
#'
-#'
-
-
-# See \url{http://www.cookbook-r.com/Statistical_analysis/Inter-rater_reliability/#ordinal-data-weighted-kappa}
-
-
-agreementClass <- if (requireNamespace('jmvcore'))
- R6::R6Class("agreementClass",
- inherit = agreementBase,
- private = list(
- .run = function() {
-
- # Data definition ----
-
-
- exct <- self$options$exct
- wght <- self$options$wght
-
- mydata <- self$data
-
- formula <-
- jmvcore::constructFormula(terms = self$options$vars)
-
- myvars <- jmvcore::decomposeFormula(formula = formula)
-
- myvars <- unlist(myvars)
-
- ratings <- mydata %>%
- dplyr::select(myvars)
-
-
- if (is.null(self$options$vars) || length(self$options$vars) < 2) {
- # No variables ----
-
- # todo <- glue::glue(
- # "This function "
- # )
-
- # self$results$todo$setContent(todo)
-
- } else {
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
-
-
- # 2 & categorical ----
-
- if (length(self$options$vars) == 2) {
- # todo <- "Cohen"
-
- # self$results$todo$setContent(todo)
-
-
- xorder <- unlist(lapply(ratings, is.ordered))
-
- if ( wght %in% c("equal", "squared") && !all(xorder == TRUE) )
-stop("Use ordinal variables when using weight argument")
-
- if ( exct == TRUE )
- stop("Use exact argument only >=3 variables")
-
-
- result2 <- irr::kappa2(ratings = ratings,
- weight = wght)
-
- # self$results$text2$setContent(result2)
-
-
- # >=2 & categorical ----
-
-
- } else if (length(self$options$vars) >= 2) {
- # todo <- "kappam.fleiss"
-
- # self$results$todo$setContent(todo)
-
- result2 <- irr::kappam.fleiss(ratings = ratings,
- exact = exct,
- detail = TRUE)
-
- # self$results$text2$setContent(result2)
-
- }
-
-
-
- result <- table(ratings)
-
- self$results$text$setContent(result)
-
-
- result1 <- irr::agree(ratings)
-
- # self$results$text1$setContent(result1)
-
-
- table2 <- self$results$irrtable
- table2$setRow(
- rowNo = 1,
- values = list(
- method = result2[["method"]],
- subjects = result1[["subjects"]],
- raters = result1[["raters"]],
- peragree = result1[["value"]],
- kappa = result2[["value"]],
- z = result2[["statistic"]],
- p = result2[["p.value"]]
- )
- )
-
- }
- }
- ))
+# See
+# \url{http://www.cookbook-r.com/Statistical_analysis/Inter-rater_reliability/#ordinal-data-weighted-kappa}
+
+
+agreementClass <- if (requireNamespace("jmvcore")) R6::R6Class("agreementClass",
+ inherit = agreementBase, private = list(.run = function() {
+ # Data definition ----
+
+
+ exct <- self$options$exct
+ wght <- self$options$wght
+
+ mydata <- self$data
+
+ formula <- jmvcore::constructFormula(terms = self$options$vars)
+
+ myvars <- jmvcore::decomposeFormula(formula = formula)
+
+ myvars <- unlist(myvars)
+
+ ratings <- mydata %>% dplyr::select(myvars)
+
+
+ if (is.null(self$options$vars) || length(self$options$vars) < 2) {
+ # No variables ----
+
+ # todo <- glue::glue( 'This function ' )
+
+ # self$results$todo$setContent(todo)
+
+ } else {
+ if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+
+ # 2 & categorical ----
+
+ if (length(self$options$vars) == 2) {
+ # todo <- 'Cohen'
+
+ # self$results$todo$setContent(todo)
+
+
+ xorder <- unlist(lapply(ratings, is.ordered))
+
+ if (wght %in% c("equal", "squared") && !all(xorder == TRUE)) stop("Use ordinal variables when using weight argument")
+
+ if (exct == TRUE) stop("Use exact argument only >=3 variables")
+
+
+ result2 <- irr::kappa2(ratings = ratings, weight = wght)
+
+ # self$results$text2$setContent(result2)
+
+
+ # >=2 & categorical ----
+
+
+ } else if (length(self$options$vars) >= 2) {
+ # todo <- 'kappam.fleiss'
+
+ # self$results$todo$setContent(todo)
+
+ result2 <- irr::kappam.fleiss(ratings = ratings, exact = exct,
+ detail = TRUE)
+
+ # self$results$text2$setContent(result2)
+
+ }
+
+
+
+ result <- table(ratings)
+
+ self$results$text$setContent(result)
+
+
+ result1 <- irr::agree(ratings)
+
+ # self$results$text1$setContent(result1)
+
+
+ table2 <- self$results$irrtable
+ table2$setRow(rowNo = 1, values = list(method = result2[["method"]],
+ subjects = result1[["subjects"]], raters = result1[["raters"]],
+ peragree = result1[["value"]], kappa = result2[["value"]],
+ z = result2[["statistic"]], p = result2[["p.value"]]))
+
+ }
+
+
+ }))
diff --git a/R/competingsurvival.b.R b/R/competingsurvival.b.R
index 56abe2fa..920460bc 100644
--- a/R/competingsurvival.b.R
+++ b/R/competingsurvival.b.R
@@ -1,7 +1,7 @@
#' Competing Survival Analysis
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/correlation.b.R b/R/correlation.b.R
index 02ad6ee2..525051b4 100644
--- a/R/correlation.b.R
+++ b/R/correlation.b.R
@@ -1,7 +1,7 @@
#' Correlation Analysis
#'
-#' @return
-#' @export
+
+
#'
#'
#' @importFrom R6 R6Class
diff --git a/R/crosstable.b.R b/R/crosstable.b.R
index 26be7142..e9bdefe4 100644
--- a/R/crosstable.b.R
+++ b/R/crosstable.b.R
@@ -1,20 +1,19 @@
#' Cross Table
#'
-#' @return
#' @export
#'
#'
-#'
#' @importFrom R6 R6Class
#' @import jmvcore
+#' @import tangram
#'
crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
"crosstableClass",
inherit = crosstableBase,
private = list(
- .run = function() {
+ .run = function() {
@@ -88,18 +87,41 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
# Tangram Table
+ mydata <- self$data
- style <- self$options$style
+ sty <- jmvcore::composeTerm(components = self$options$sty)
+ gr <- jmvcore::composeTerm(components = self$options$group)
- table3 <-
- tangram::html5(
- tangram::tangram(
- formula, self$data),
- fragment = TRUE,
- inline = style,
- caption = paste0("Cross Table for Dependent ", self$options$group),
- id = "tbl3")
+
+ # table3 <-
+ # tangram::html5(
+ # tangram::tangram(
+ # formula,
+ # mydata),
+ # style = sty,
+ # # caption = paste0("Cross Table for Dependent ", gr),
+ # id = "tbl3")
+
+
+ # table3 <-
+ # tangram::tangram(
+ # Species~Sepal.Length+Sepal.Width+Petal.Length,
+ # iris,
+ # style = 'nejm',
+ # caption = paste0("Cross Table for Dependent "),
+ # id = "tbl3")
+
+
+
+ table3 <- tangram::html5(
+ tangram::tangram(
+ "Species~Sepal.Length+Sepal.Width+Petal.Length",
+ iris
+ ),
+ style = "hmisc",
+ caption = paste0("Cross Table for Dependent "),
+ id = "tbl3")
results3 <- table3
diff --git a/R/crosstable.h.R b/R/crosstable.h.R
index dcd30d2c..a85c4eba 100644
--- a/R/crosstable.h.R
+++ b/R/crosstable.h.R
@@ -8,7 +8,7 @@ crosstableOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
initialize = function(
vars = NULL,
group = NULL,
- style = "nejm.css", ...) {
+ sty = "nejm", ...) {
super$initialize(
package='ClinicoPath',
@@ -27,27 +27,27 @@ crosstableOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
"nominal"),
permitted=list(
"factor"))
- private$..style <- jmvcore::OptionList$new(
- "style",
- style,
+ private$..sty <- jmvcore::OptionList$new(
+ "sty",
+ sty,
options=list(
- "nejm.css",
- "lancet.css",
- "hmisc.css"),
- default="nejm.css")
+ "nejm",
+ "lancet",
+ "hmisc"),
+ default="nejm")
self$.addOption(private$..vars)
self$.addOption(private$..group)
- self$.addOption(private$..style)
+ self$.addOption(private$..sty)
}),
active = list(
vars = function() private$..vars$value,
group = function() private$..group$value,
- style = function() private$..style$value),
+ sty = function() private$..sty$value),
private = list(
..vars = NA,
..group = NA,
- ..style = NA)
+ ..sty = NA)
)
crosstableResults <- if (requireNamespace('jmvcore')) R6::R6Class(
@@ -99,7 +99,7 @@ crosstableBase <- if (requireNamespace('jmvcore')) R6::R6Class(
#' @param data The data as a data frame.
#' @param vars .
#' @param group variable in the column
-#' @param style .
+#' @param sty .
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$text3} \tab \tab \tab \tab \tab a html \cr
@@ -110,7 +110,7 @@ crosstable <- function(
data,
vars,
group,
- style = "nejm.css") {
+ sty = "nejm") {
if ( ! requireNamespace('jmvcore'))
stop('crosstable requires jmvcore to be installed (restart may be required)')
@@ -128,7 +128,7 @@ crosstable <- function(
options <- crosstableOptions$new(
vars = vars,
group = group,
- style = style)
+ sty = sty)
analysis <- crosstableClass$new(
options = options,
diff --git a/R/decision.b.R b/R/decision.b.R
index 0146311c..90fb2ab4 100644
--- a/R/decision.b.R
+++ b/R/decision.b.R
@@ -1,7 +1,7 @@
#' Medical Decision Making
#'
-#' @return
-#' @export
+
+
#'
#'
#'
@@ -11,222 +11,154 @@
#' @import caret
#'
-decisionClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "decisionClass",
- inherit = decisionBase,
- private = list(
- .run = function() {
-
- # TODO
-
- # todo <- glue::glue(
- # "This Module is still under development
- # -
- # - "
- # )
- #
- # self$results$todo$setContent(todo)
-
-
- if (length(self$options$testPositive) + length(self$options$newtest) + length(self$options$goldPositive) + length(self$options$gold) < 4)
- return()
-
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
-
-
-
-
- # Data definition ----
- mydata <- self$data
-
- mydata <- jmvcore::naOmit(mydata)
-
- testPLevel <- jmvcore::constructFormula(terms = self$options$testPositive)
-
- testPLevel <- jmvcore::decomposeFormula(formula = testPLevel)
-
- testPLevel <- unlist(testPLevel)
-
-
- testVariable <- jmvcore::constructFormula(terms = self$options$newtest)
-
- testVariable <- jmvcore::decomposeFormula(formula = testVariable)
-
- testVariable <- unlist(testVariable)
-
-
- goldPLevel <- jmvcore::constructFormula(terms = self$options$goldPositive)
-
- goldPLevel <- jmvcore::decomposeFormula(formula = goldPLevel)
-
- goldPLevel <- unlist(goldPLevel)
-
-
- goldVariable <- jmvcore::constructFormula(terms = self$options$gold)
-
- goldVariable <- jmvcore::decomposeFormula(formula = goldVariable)
-
- goldVariable <- unlist(goldVariable)
-
- mydata[[testVariable]] <- forcats::as_factor(mydata[[testVariable]])
-
- mydata[[goldVariable]] <- forcats::as_factor(mydata[[goldVariable]])
-
- # Table 1 ----
-
- results1 <- mydata %>%
- dplyr::select(.data[[testVariable]], .data[[goldVariable]]) %>%
- table()
-
- self$results$text1$setContent(results1)
-
-
- # Recode ----
-
- mydata2 <- mydata
-
- mydata2 <- mydata2 %>%
- dplyr::mutate(
- testVariable2 =
- dplyr::case_when(
- .data[[testVariable]] == self$options$testPositive ~ "Positive",
- NA ~ NA_character_,
- TRUE ~ "Negative"
- )
- ) %>%
-
- dplyr::mutate(
- goldVariable2 =
- dplyr::case_when(
- .data[[goldVariable]] == self$options$goldPositive ~ "Positive",
- NA ~ NA_character_,
- TRUE ~ "Negative"
- )
- )
-
- mydata2 <- mydata2 %>%
- dplyr::mutate(
- testVariable2 = forcats::fct_relevel(testVariable2, "Positive")
- ) %>%
- dplyr::mutate(
- goldVariable2 = forcats::fct_relevel(goldVariable2, "Positive")
- )
-
-
-
- # Caret ----
-
- conf_table <- table(mydata2[["testVariable2"]], mydata2[["goldVariable2"]])
-
-
- results_caret <- caret::confusionMatrix(conf_table, positive = "Positive")
-
-
- self$results$text2$setContent(results_caret)
-
-
-matrixdetails <- list(
-results_caret[["positive"]],
-results_caret[["table"]],
-results_caret[["overall"]],
-results_caret[["overall"]][["Accuracy"]],
-results_caret[["overall"]][["Kappa"]],
-results_caret[["overall"]][["AccuracyLower"]],
-results_caret[["overall"]][["AccuracyUpper"]],
-results_caret[["overall"]][["AccuracyNull"]],
-results_caret[["overall"]][["AccuracyPValue"]],
-results_caret[["overall"]][["McnemarPValue"]],
-results_caret[["byClass"]],
-results_caret[["byClass"]][["Sensitivity"]],
-results_caret[["byClass"]][["Specificity"]],
-results_caret[["byClass"]][["Pos Pred Value"]],
-results_caret[["byClass"]][["Neg Pred Value"]],
-results_caret[["byClass"]][["Precision"]],
-results_caret[["byClass"]][["Recall"]],
-results_caret[["byClass"]][["F1"]],
-results_caret[["byClass"]][["Prevalence"]],
-results_caret[["byClass"]][["Detection Rate"]],
-results_caret[["byClass"]][["Detection Prevalence"]],
-results_caret[["byClass"]][["Balanced Accuracy"]],
-results_caret[["mode"]],
-results_caret[["dots"]]
-)
-
- # self$results$text3$setContent(matrixdetails)
-
-
- # Individual analysis ----
-
- # sens <- caret::sensitivity(conf_table, positive = "Positive")
-
- # PPV <- caret::posPredValue(conf_table, positive = "Positive")
-
- # summary_caret <- glue::glue("Sensitivity is {sens}.
- # PPV is {PPV}.")
-
- # self$results$text4$setContent(summary_caret)
-
-
- # bdpv ----
- # https://cran.r-project.org/web/packages/bdpv/bdpv.pdf
-
-
-
- # epiR ----
- # https://cran.r-project.org/web/packages/epiR/epiR.pdf
-
-
- # dat <- as.table(
- # matrix(c(670,202,74,640),
- # nrow = 2,
- # byrow = TRUE)
- # )
-
- # colnames(dat) <- c("Dis+","Dis-")
- # rownames(dat) <- c("Test+","Test-")
-
- # rval <- epiR::epi.tests(dat, conf.level = 0.95)
-
- # rval <- list(
- # dat,
- # rval,
- # print(rval),
- # summary(rval)
- # )
-
- # self$results$text5$setContent(rval)
-
-
-
- # Prior Probability ----
-
- # lvs <- c("normal", "abnormal")
- # truth <- factor(rep(lvs, times = c(86, 258)),
- # levels = rev(lvs))
- # pred <- factor(
- # c(
- # rep(lvs, times = c(54, 32)),
- # rep(lvs, times = c(27, 231))),
- # levels = rev(lvs))
- #
- # xtab <- table(pred, truth)
- #
- # confusionMatrix(xtab)
- # confusionMatrix(pred, truth)
- # confusionMatrix(xtab, prevalence = 0.25)
- #
- # ## 3 class example
- #
- # confusionMatrix(iris$Species, sample(iris$Species))
- #
- # newPrior <- c(.05, .8, .15)
- # names(newPrior) <- levels(iris$Species)
- #
- # confusionMatrix(iris$Species, sample(iris$Species))
-
-
-
-
- })
-)
+decisionClass <- if (requireNamespace("jmvcore")) R6::R6Class("decisionClass",
+ inherit = decisionBase, private = list(.run = function() {
+
+ # TODO
+
+ # todo <- glue::glue( 'This Module is still under development - - ' )
+ # self$results$todo$setContent(todo)
+
+
+ if (length(self$options$testPositive) + length(self$options$newtest) +
+ length(self$options$goldPositive) + length(self$options$gold) <
+ 4) return()
+
+ if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+
+
+
+ # Data definition ----
+ mydata <- self$data
+
+ mydata <- jmvcore::naOmit(mydata)
+
+ testPLevel <- jmvcore::constructFormula(terms = self$options$testPositive)
+
+ testPLevel <- jmvcore::decomposeFormula(formula = testPLevel)
+
+ testPLevel <- unlist(testPLevel)
+
+
+ testVariable <- jmvcore::constructFormula(terms = self$options$newtest)
+
+ testVariable <- jmvcore::decomposeFormula(formula = testVariable)
+
+ testVariable <- unlist(testVariable)
+
+
+ goldPLevel <- jmvcore::constructFormula(terms = self$options$goldPositive)
+
+ goldPLevel <- jmvcore::decomposeFormula(formula = goldPLevel)
+
+ goldPLevel <- unlist(goldPLevel)
+
+
+ goldVariable <- jmvcore::constructFormula(terms = self$options$gold)
+
+ goldVariable <- jmvcore::decomposeFormula(formula = goldVariable)
+
+ goldVariable <- unlist(goldVariable)
+
+ mydata[[testVariable]] <- forcats::as_factor(mydata[[testVariable]])
+
+ mydata[[goldVariable]] <- forcats::as_factor(mydata[[goldVariable]])
+
+ # Table 1 ----
+
+ results1 <- mydata %>% dplyr::select(.data[[testVariable]], .data[[goldVariable]]) %>%
+ table()
+
+ self$results$text1$setContent(results1)
+
+
+ # Recode ----
+
+ mydata2 <- mydata
+
+ mydata2 <- mydata2 %>% dplyr::mutate(testVariable2 = dplyr::case_when(.data[[testVariable]] ==
+ self$options$testPositive ~ "Positive", NA ~ NA_character_, TRUE ~
+ "Negative")) %>%
+ dplyr::mutate(goldVariable2 = dplyr::case_when(.data[[goldVariable]] ==
+ self$options$goldPositive ~ "Positive", NA ~ NA_character_, TRUE ~
+ "Negative"))
+
+ mydata2 <- mydata2 %>% dplyr::mutate(testVariable2 = forcats::fct_relevel(testVariable2,
+ "Positive")) %>% dplyr::mutate(goldVariable2 = forcats::fct_relevel(goldVariable2,
+ "Positive"))
+
+
+
+ # Caret ----
+
+ conf_table <- table(mydata2[["testVariable2"]], mydata2[["goldVariable2"]])
+
+
+ results_caret <- caret::confusionMatrix(conf_table, positive = "Positive")
+
+
+ self$results$text2$setContent(results_caret)
+
+
+ matrixdetails <- list(results_caret[["positive"]], results_caret[["table"]],
+ results_caret[["overall"]], results_caret[["overall"]][["Accuracy"]],
+ results_caret[["overall"]][["Kappa"]], results_caret[["overall"]][["AccuracyLower"]],
+ results_caret[["overall"]][["AccuracyUpper"]], results_caret[["overall"]][["AccuracyNull"]],
+ results_caret[["overall"]][["AccuracyPValue"]], results_caret[["overall"]][["McnemarPValue"]],
+ results_caret[["byClass"]], results_caret[["byClass"]][["Sensitivity"]],
+ results_caret[["byClass"]][["Specificity"]], results_caret[["byClass"]][["Pos Pred Value"]],
+ results_caret[["byClass"]][["Neg Pred Value"]], results_caret[["byClass"]][["Precision"]],
+ results_caret[["byClass"]][["Recall"]], results_caret[["byClass"]][["F1"]],
+ results_caret[["byClass"]][["Prevalence"]], results_caret[["byClass"]][["Detection Rate"]],
+ results_caret[["byClass"]][["Detection Prevalence"]], results_caret[["byClass"]][["Balanced Accuracy"]],
+ results_caret[["mode"]], results_caret[["dots"]])
+
+ # self$results$text3$setContent(matrixdetails)
+
+
+ # Individual analysis ----
+
+ # sens <- caret::sensitivity(conf_table, positive = 'Positive')
+
+ # PPV <- caret::posPredValue(conf_table, positive = 'Positive')
+
+ # summary_caret <- glue::glue('Sensitivity is {sens}. PPV is {PPV}.')
+
+ # self$results$text4$setContent(summary_caret)
+
+
+ # bdpv ---- https://cran.r-project.org/web/packages/bdpv/bdpv.pdf
+
+
+
+ # epiR ---- https://cran.r-project.org/web/packages/epiR/epiR.pdf
+
+
+ # dat <- as.table( matrix(c(670,202,74,640), nrow = 2, byrow = TRUE) )
+
+ # colnames(dat) <- c('Dis+','Dis-') rownames(dat) <- c('Test+','Test-')
+
+ # rval <- epiR::epi.tests(dat, conf.level = 0.95)
+
+ # rval <- list( dat, rval, print(rval), summary(rval) )
+
+ # self$results$text5$setContent(rval)
+
+
+
+ # Prior Probability ----
+
+ # lvs <- c('normal', 'abnormal') truth <- factor(rep(lvs, times = c(86,
+ # 258)), levels = rev(lvs)) pred <- factor( c( rep(lvs, times = c(54,
+ # 32)), rep(lvs, times = c(27, 231))), levels = rev(lvs)) xtab <-
+ # table(pred, truth) confusionMatrix(xtab) confusionMatrix(pred, truth)
+ # confusionMatrix(xtab, prevalence = 0.25) ## 3 class example
+ # confusionMatrix(iris$Species, sample(iris$Species)) newPrior <- c(.05,
+ # .8, .15) names(newPrior) <- levels(iris$Species)
+ # confusionMatrix(iris$Species, sample(iris$Species))
+
+
+
+
+ }))
diff --git a/R/decisioncalculator.b.R b/R/decisioncalculator.b.R
index a2deb78d..9d5d9f7c 100644
--- a/R/decisioncalculator.b.R
+++ b/R/decisioncalculator.b.R
@@ -1,7 +1,7 @@
#' Decision Calculator
#'
-#' @return
-#' @export
+
+
#'
#'
#'
@@ -11,199 +11,162 @@
#' @importFrom caret confusionMatrix
#'
-decisioncalculatorClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "decisioncalculatorClass",
- inherit = decisioncalculatorBase,
- private = list(
- .run = function() {
-
-
- # TODO
-
- # todo <- glue::glue(
- # "This Module is still under development
- # -
- # - "
- # )
-
- # self$results$todo$setContent(todo)
-
- TP <- self$options$TP
-
- FP <- self$options$FP
-
- TN <- self$options$TN
-
- FN <- self$options$FN
-
- # table1 <- matrix(c(TP, FP, FN, TN), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("Test Positive", "Test Negative"), c("Gold Positive","Gold Negative")))
- #
- # self$results$text1$setContent(table1)
-
- table2 <- matrix(c(TP, FP, FN, TN), nrow = 2, ncol = 2, byrow = TRUE, dimnames = list(c("Positive", "Negative"), c("Positive","Negative")))
-
- table3 <- as.table(table2)
-
- names(attributes(table3)$dimnames) <- c("Test","Gold Standart")
-
- # Prior Probability ----
-
- pp <- self$options$pp
-
- pprob <- self$options$pprob
-
- if ( pp ) {
- caretresult <- caret::confusionMatrix(table3, prevalence = pprob)
-
- } else {
-
+decisioncalculatorClass <- if (requireNamespace("jmvcore")) R6::R6Class("decisioncalculatorClass",
+ inherit = decisioncalculatorBase, private = list(.run = function() {
+
+
+ # TODO
+
+ # todo <- glue::glue( 'This Module is still under development - - ' )
+
+ # self$results$todo$setContent(todo)
+
+ TP <- self$options$TP
+
+ FP <- self$options$FP
+
+ TN <- self$options$TN
+
+ FN <- self$options$FN
+
+ # table1 <- matrix(c(TP, FP, FN, TN), nrow = 2, ncol = 2, byrow = TRUE,
+ # dimnames = list(c('Test Positive', 'Test Negative'), c('Gold
+ # Positive','Gold Negative'))) self$results$text1$setContent(table1)
+
+ table2 <- matrix(c(TP, FP, FN, TN), nrow = 2, ncol = 2, byrow = TRUE,
+ dimnames = list(c("Positive", "Negative"), c("Positive", "Negative")))
+
+ table3 <- as.table(table2)
+
+ names(attributes(table3)$dimnames) <- c("Test", "Gold Standart")
+
+ # Prior Probability ----
+
+ pp <- self$options$pp
+
+ pprob <- self$options$pprob
+
+ if (pp) {
+ caretresult <- caret::confusionMatrix(table3, prevalence = pprob)
+
+ } else {
+
caretresult <- caret::confusionMatrix(table3)
-
- }
-
- self$results$text2$setContent(caretresult)
-
-
- # Self Calculation
- #
- # https://cran.r-project.org/web/packages/caret/caret.pdf
- # https://online.stat.psu.edu/stat509/node/150/
-
-
- TotalPop <- TP + TN + FP + FN
-
- DiseaseP <- TP + FN
-
- DiseaseN <- TN + FP
-
- TestP <- TP + FP
-
- TestN <- TN + FN
-
- TestT <- TP + TN
-
- TestW <- FP + FN
-
- Sens <- TP / DiseaseP
-
- Spec <- TN / DiseaseN
-
- AccurT <- TestT / TotalPop
-
- PrevalenceD <- DiseaseP / TotalPop
-
- PPV <- TP / TestP
-
- NPV <- TN / TestN
-
-
- if ( pp ) {
- # Known prior probability from population
- PriorProb <- pprob
- } else {
- # From ConfusionMatrix
+
+ }
+
+ self$results$text2$setContent(caretresult)
+
+
+ # Self Calculation https://cran.r-project.org/web/packages/caret/caret.pdf
+ # https://online.stat.psu.edu/stat509/node/150/
+
+
+ TotalPop <- TP + TN + FP + FN
+
+ DiseaseP <- TP + FN
+
+ DiseaseN <- TN + FP
+
+ TestP <- TP + FP
+
+ TestN <- TN + FN
+
+ TestT <- TP + TN
+
+ TestW <- FP + FN
+
+ Sens <- TP/DiseaseP
+
+ Spec <- TN/DiseaseN
+
+ AccurT <- TestT/TotalPop
+
+ PrevalenceD <- DiseaseP/TotalPop
+
+ PPV <- TP/TestP
+
+ NPV <- TN/TestN
+
+
+ if (pp) {
+ # Known prior probability from population
+ PriorProb <- pprob
+ } else {
+ # From ConfusionMatrix
PriorProb <- PrevalenceD
- }
-
-
- PostTestProbDisease <-
- (PriorProb * Sens) /
- ( (PriorProb * Sens) + (( 1 - PriorProb ) * ( 1 - Spec )))
-
-
-
- PostTestProbHealthy <-
- ( (1 - PriorProb) * Spec ) /
- ( ( ( 1- PriorProb ) * Spec) + ( PriorProb * (1 - Sens) ) )
-
-
-
-
- LRP <- Sens / (1 - Spec)
-
- LRN <- (1 - Sens) / Spec
-
-
-
-
-
-
- # Populate Table
- #
-
- manualtable <- self$results$manualtable
- manualtable$setRow(
- rowNo = 1,
- values = list(
- tablename = 'Decision Test Statistics',
- TotalPop = TotalPop,
- DiseaseP = DiseaseP,
- DiseaseN = DiseaseN,
- TestP = TestP,
- TestN = TestN,
- TestT = TestT,
- TestW = TestW,
- Sens = Sens,
- Spec = Spec,
- AccurT = AccurT,
- PrevalenceD = PrevalenceD,
- PPV = PPV,
- NPV = NPV,
- PostTestProbDisease = PostTestProbDisease,
- PostTestProbHealthy = PostTestProbHealthy
- )
- )
-
-
-
-
-
-
-
-
- # Reorganize Table
-
-
-
-# caretresult[["positive"]]
-# caretresult[["table"]]
-# caretresult[["overall"]]
-# caretresult[["overall"]][["Accuracy"]]
-# caretresult[["overall"]][["Kappa"]]
-# caretresult[["overall"]][["AccuracyLower"]]
-# caretresult[["overall"]][["AccuracyUpper"]]
-# caretresult[["overall"]][["AccuracyNull"]]
-# caretresult[["overall"]][["AccuracyPValue"]]
-# caretresult[["overall"]][["McnemarPValue"]]
-# caretresult[["byClass"]]
-# caretresult[["byClass"]][["Sensitivity"]]
-# caretresult[["byClass"]][["Specificity"]]
-# caretresult[["byClass"]][["Pos Pred Value"]]
-# caretresult[["byClass"]][["Neg Pred Value"]]
-# caretresult[["byClass"]][["Precision"]]
-# caretresult[["byClass"]][["Recall"]]
-# caretresult[["byClass"]][["F1"]]
-# caretresult[["byClass"]][["Prevalence"]]
-# caretresult[["byClass"]][["Detection Rate"]]
-# caretresult[["byClass"]][["Detection Prevalence"]]
-# caretresult[["byClass"]][["Balanced Accuracy"]]
-# caretresult[["mode"]]
-# caretresult[["dots"]]
-
-
-
-
- # Write Summary
-
-
-
-
- # use epiR
- #
- #
- #
-
-
-
- })
-)
+ }
+
+
+ PostTestProbDisease <- (PriorProb * Sens)/((PriorProb * Sens) + ((1 -
+ PriorProb) * (1 - Spec)))
+
+
+
+ PostTestProbHealthy <- ((1 - PriorProb) * Spec)/(((1 - PriorProb) *
+ Spec) + (PriorProb * (1 - Sens)))
+
+
+
+
+ LRP <- Sens/(1 - Spec)
+
+ LRN <- (1 - Sens)/Spec
+
+
+
+
+
+
+ # Populate Table
+
+ manualtable <- self$results$manualtable
+ manualtable$setRow(rowNo = 1, values = list(tablename = "Decision Test Statistics",
+ TotalPop = TotalPop, DiseaseP = DiseaseP, DiseaseN = DiseaseN,
+ TestP = TestP, TestN = TestN, TestT = TestT, TestW = TestW, Sens = Sens,
+ Spec = Spec, AccurT = AccurT, PrevalenceD = PrevalenceD, PPV = PPV,
+ NPV = NPV, PostTestProbDisease = PostTestProbDisease, PostTestProbHealthy = PostTestProbHealthy))
+
+
+
+
+
+
+
+
+ # Reorganize Table
+
+
+
+ # caretresult[['positive']] caretresult[['table']]
+ # caretresult[['overall']] caretresult[['overall']][['Accuracy']]
+ # caretresult[['overall']][['Kappa']]
+ # caretresult[['overall']][['AccuracyLower']]
+ # caretresult[['overall']][['AccuracyUpper']]
+ # caretresult[['overall']][['AccuracyNull']]
+ # caretresult[['overall']][['AccuracyPValue']]
+ # caretresult[['overall']][['McnemarPValue']] caretresult[['byClass']]
+ # caretresult[['byClass']][['Sensitivity']]
+ # caretresult[['byClass']][['Specificity']] caretresult[['byClass']][['Pos
+ # Pred Value']] caretresult[['byClass']][['Neg Pred Value']]
+ # caretresult[['byClass']][['Precision']]
+ # caretresult[['byClass']][['Recall']] caretresult[['byClass']][['F1']]
+ # caretresult[['byClass']][['Prevalence']]
+ # caretresult[['byClass']][['Detection Rate']]
+ # caretresult[['byClass']][['Detection Prevalence']]
+ # caretresult[['byClass']][['Balanced Accuracy']] caretresult[['mode']]
+ # caretresult[['dots']]
+
+
+
+
+ # Write Summary
+
+
+
+
+ # use epiR
+
+
+
+ }))
diff --git a/R/decisioncalculator.h.R b/R/decisioncalculator.h.R
index 5a26d88e..f44846ab 100644
--- a/R/decisioncalculator.h.R
+++ b/R/decisioncalculator.h.R
@@ -131,31 +131,38 @@ decisioncalculatorResults <- if (requireNamespace('jmvcore')) R6::R6Class(
list(
`name`="Sens",
`title`="Sensitivity (True Positives among Diseased)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="Spec",
`title`="Specificity (True Negatives among Healthy)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="AccurT",
`title`="Accuracy (True Test Result Ratio)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="PrevalenceD",
`title`="Disease Prevalence in this experimental population",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="PPV",
`title`="Positive Predictive Value (Probability of having disease after a positive test using this experimental population)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="NPV",
`title`="Negative Predictive Value (Probability of being healthy after a negative test using this experimental population)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="PostTestProbDisease",
`title`="Post-test Probability of Having Disease (Probability of having disease after a positive test using known Population Prevalence)",
- `type`="number"),
+ `type`="number",
+ `format`="pc"),
list(
`name`="PostTestProbHealthy",
`title`="Post-test Probability of Being Healthy (Probability of being healthy after a negative test using known Population Prevalence)",
diff --git a/R/gtsummary.b.R b/R/gtsummary.b.R
new file mode 100644
index 00000000..5047cce4
--- /dev/null
+++ b/R/gtsummary.b.R
@@ -0,0 +1,71 @@
+#' Tables via gtsummary
+#'
+#' @return
+#' @export
+#'
+#' @import gtsummary
+
+gtsummaryClass <- if (requireNamespace('jmvcore')) R6::R6Class(
+ "gtsummaryClass",
+ inherit = gtsummaryBase,
+ private = list(
+ .run = function() {
+
+
+ # gtsummary
+
+ # myvars <- jmvcore::constructFormula(terms = self$options$vars)
+ # myvars <- jmvcore::decomposeFormula(formula = myvars)
+ # myvars <- unlist(myvars)
+ # mytableone2 <- self$data %>%
+ # dplyr::select(myvars)
+ # mytableone2 <- gtsummary::tbl_summary(mytableone2)
+ # self$results$text2$setContent(mytableone2)
+
+
+ # trial <- gtsummary::trial
+
+ gtsum1 <-
+ gtsummary::tbl_summary(data = iris)
+
+ # gtsum1 <- trial[c("trt", "age", "grade")] %>%
+ # gtsummary::tbl_summary(data = ., by = trt, missing = "no") %>%
+ # gtsummary::modify_header(stat_by =
+ # gt::md("**{level}** N = {n} ({style_percent(p)}%)")) %>%
+ # gtsummary::add_n() %>%
+ # gtsummary::bold_labels() %>%
+ # gtsummary::as_gt() %>%
+ # gt::tab_spanner(columns = gt::starts_with("stat_"),
+ # gt::md("**Chemotherapy Treatment**"))
+
+
+ gtsum1 <- gtsummary::as_kable_extra(gtsum1)
+
+ # gtsum1 <- gtsummary::as_gt(gtsum1)
+
+ # gtsum1 <- gtsummary::as_flextable(gtsum1)
+
+ # gtsum1 <- gtsummary::as_kable(gtsum1)
+
+
+ # gtsum1 <- kableExtra::kable(gtsum1, format = "html")
+
+ self$results$gtsum1$setContent(gtsum1)
+
+ # self$results$gtsum1$setContent(gtsum1)
+
+
+ # self$results$gtsum1pre$setContent(gtsum1)
+
+
+
+
+
+ # gtsum1html <- knitr::kable(x = gtsum1, format = "html")
+ #
+ # self$results$gtsum1html$setContent(gtsum1html)
+
+ # TRUE
+
+ })
+)
diff --git a/R/gtsummary.h.R b/R/gtsummary.h.R
new file mode 100644
index 00000000..20acab9f
--- /dev/null
+++ b/R/gtsummary.h.R
@@ -0,0 +1,138 @@
+
+# This file is automatically generated, you probably don't want to edit this
+
+gtsummaryOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
+ "gtsummaryOptions",
+ inherit = jmvcore::Options,
+ public = list(
+ initialize = function(
+ dep = NULL,
+ group = NULL,
+ alt = "notequal",
+ varEq = TRUE, ...) {
+
+ super$initialize(
+ package='ClinicoPath',
+ name='gtsummary',
+ requiresData=TRUE,
+ ...)
+
+ private$..dep <- jmvcore::OptionVariable$new(
+ "dep",
+ dep)
+ private$..group <- jmvcore::OptionVariable$new(
+ "group",
+ group)
+ private$..alt <- jmvcore::OptionList$new(
+ "alt",
+ alt,
+ options=list(
+ "notequal",
+ "onegreater",
+ "twogreater"),
+ default="notequal")
+ private$..varEq <- jmvcore::OptionBool$new(
+ "varEq",
+ varEq,
+ default=TRUE)
+
+ self$.addOption(private$..dep)
+ self$.addOption(private$..group)
+ self$.addOption(private$..alt)
+ self$.addOption(private$..varEq)
+ }),
+ active = list(
+ dep = function() private$..dep$value,
+ group = function() private$..group$value,
+ alt = function() private$..alt$value,
+ varEq = function() private$..varEq$value),
+ private = list(
+ ..dep = NA,
+ ..group = NA,
+ ..alt = NA,
+ ..varEq = NA)
+)
+
+gtsummaryResults <- if (requireNamespace('jmvcore')) R6::R6Class(
+ inherit = jmvcore::Group,
+ active = list(
+ gtsum1 = function() private$.items[["gtsum1"]]),
+ private = list(),
+ public=list(
+ initialize=function(options) {
+ super$initialize(
+ options=options,
+ name="",
+ title="Tables via gtsummary")
+ self$add(jmvcore::Html$new(
+ options=options,
+ name="gtsum1",
+ title="Tables via gtsummary"))}))
+
+gtsummaryBase <- if (requireNamespace('jmvcore')) R6::R6Class(
+ "gtsummaryBase",
+ inherit = jmvcore::Analysis,
+ public = list(
+ initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
+ super$initialize(
+ package = 'ClinicoPath',
+ name = 'gtsummary',
+ version = c(1,0,0),
+ options = options,
+ results = gtsummaryResults$new(options=options),
+ data = data,
+ datasetId = datasetId,
+ analysisId = analysisId,
+ revision = revision,
+ pause = NULL,
+ completeWhenFilled = FALSE,
+ requiresMissings = FALSE)
+ }))
+
+#' Tables via gtsummary
+#'
+#'
+#' @param data .
+#' @param dep .
+#' @param group .
+#' @param alt .
+#' @param varEq .
+#' @return A results object containing:
+#' \tabular{llllll}{
+#' \code{results$gtsum1} \tab \tab \tab \tab \tab a html \cr
+#' }
+#'
+#' @export
+gtsummary <- function(
+ data,
+ dep,
+ group,
+ alt = "notequal",
+ varEq = TRUE) {
+
+ if ( ! requireNamespace('jmvcore'))
+ stop('gtsummary requires jmvcore to be installed (restart may be required)')
+
+ if ( ! missing(dep)) dep <- jmvcore::resolveQuo(jmvcore::enquo(dep))
+ if ( ! missing(group)) group <- jmvcore::resolveQuo(jmvcore::enquo(group))
+ if (missing(data))
+ data <- jmvcore::marshalData(
+ parent.frame(),
+ `if`( ! missing(dep), dep, NULL),
+ `if`( ! missing(group), group, NULL))
+
+
+ options <- gtsummaryOptions$new(
+ dep = dep,
+ group = group,
+ alt = alt,
+ varEq = varEq)
+
+ analysis <- gtsummaryClass$new(
+ options = options,
+ data = data)
+
+ analysis$run()
+
+ analysis$results
+}
diff --git a/R/icccoeff.b.R b/R/icccoeff.b.R
index 37598f51..063af734 100644
--- a/R/icccoeff.b.R
+++ b/R/icccoeff.b.R
@@ -1,8 +1,8 @@
#' Interclass Correlation Coefficient
#'
#' Also see \url{http://www.cookbook-r.com/Statistical_analysis/Inter-rater_reliability/#ordinal-data-weighted-kappa}
-#' @return
-#' @export
+
+
#'
#'
#'
@@ -13,16 +13,11 @@
-icccoeffClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "icccoeffClass",
- inherit = icccoeffBase,
- private = list(
- .run = function() {
-
-
-
- #
- #
-
- })
-)
+icccoeffClass <- if (requireNamespace("jmvcore")) R6::R6Class("icccoeffClass",
+ inherit = icccoeffBase, private = list(.run = function() {
+
+
+
+ #
+
+ }))
diff --git a/R/multisurvival.b.R b/R/multisurvival.b.R
index 08e9a5e5..4e5cb0a9 100644
--- a/R/multisurvival.b.R
+++ b/R/multisurvival.b.R
@@ -1,7 +1,7 @@
#' Multivariate Survival Analysis
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/oddsratio.b.R b/R/oddsratio.b.R
index 6c87e8c5..07972644 100644
--- a/R/oddsratio.b.R
+++ b/R/oddsratio.b.R
@@ -1,7 +1,7 @@
#' Odds Ratio Table and Plot
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/pairchi.b.R b/R/pairchi.b.R
index 4d6a4cf1..32272413 100644
--- a/R/pairchi.b.R
+++ b/R/pairchi.b.R
@@ -1,44 +1,637 @@
#' Pairwise Chi-Square Test
#'
-#' @return
-#' @export
-#'
-#'
-#'
#' @importFrom R6 R6Class
#' @import jmvcore
-#'
+#' @import RVAideMemoire
+#' @import rmngb
+
+
+pairchiClass <-
+ if (requireNamespace("jmvcore")) R6::R6Class("pairchiClass",
+inherit = pairchiBase, private = list(
+
+# TODO ----
+
+# todo <- glue::glue("This Module is still under development
+# -
+# -
+# ")
+#
+# self$results$todo$setContent(todo)
+#
+#
+# if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+# Functions to be used ----
+
+# RVAideMemoire::chisq.multcomp() RVAideMemoire::fisher.multcomp()
+
+# rmngb::pairwise.chisq.test(x, ...) rmngb::pairwise.fisher.test(x, ...)
+
+
+ #### Init + run functions ----
+ .init=function() {
+
+ rowVarName <- self$options$rows
+ colVarName <- self$options$cols
+ layerNames <- self$options$layers
+ countsName <- self$options$counts
+
+ freqs <- self$results$freqs
+ chiSq <- self$results$chiSq
+ nom <- self$results$nom
+ odds <- self$results$odds
+ gamma <- self$results$gamma
+ taub <- self$results$taub
+
+ data <- private$.cleanData()
+
+ reversed <- rev(layerNames)
+ for (i in seq_along(reversed)) {
+ layer <- reversed[[i]]
+ freqs$addColumn(name=layer, type='text', combineBelow=TRUE)
+ chiSq$addColumn(index=i, name=layer, type='text', combineBelow=TRUE)
+ odds$addColumn(index=i, name=layer, type='text', combineBelow=TRUE)
+ nom$addColumn(index=i, name=layer, type='text', combineBelow=TRUE)
+ gamma$addColumn(index=i, name=layer, type='text', combineBelow=TRUE)
+ taub$addColumn(index=i, name=layer, type='text', combineBelow=TRUE)
+ }
+
+ # add the row column, containing the row variable
+ # fill in dots, if no row variable specified
+
+ if ( ! is.null(rowVarName))
+ title <- rowVarName
+ else
+ title <- '.'
+
+ freqs$addColumn(
+ name=title,
+ title=title,
+ type='text')
+
+ # add the column columns (from the column variable)
+ # fill in dots, if no column variable specified
+
+ if ( ! is.null(colVarName)) {
+ superTitle <- colVarName
+ levels <- base::levels(data[[colVarName]])
+ }
+ else {
+ superTitle <- '.'
+ levels <- c('.', '.')
+ }
+
+ subNames <- c('[count]', '[expected]', '[pcRow]', '[pcCol]', '[pcTot]')
+ subTitles <- c('Observed', 'Expected', '% within row', '% within column', '% of total')
+ visible <- c('(obs)', '(exp)', '(pcRow)', '(pcCol)', '(pcTot)')
+ types <- c('integer', 'number', 'number', 'number', 'number')
+ formats <- c('', '', 'pc', 'pc', 'pc')
+
+ # iterate over the sub rows
+
+ for (j in seq_along(subNames)) {
+ subName <- subNames[[j]]
+ if (subName == '[count]')
+ v <- '(obs && (exp || pcRow || pcCol || pcTot))'
+ else
+ v <- visible[j]
+
+ freqs$addColumn(
+ name=paste0('type', subName),
+ title='',
+ type='text',
+ visible=v)
+ }
+
+ for (i in seq_along(levels)) {
+ level <- levels[[i]]
+
+ for (j in seq_along(subNames)) {
+ subName <- subNames[[j]]
+ freqs$addColumn(
+ name=paste0(i, subName),
+ title=level,
+ superTitle=superTitle,
+ type=types[j],
+ format=formats[j],
+ visible=visible[j])
+ }
+ }
+
+ # add the Total column
+
+ if (self$options$obs) {
+ freqs$addColumn(
+ name='.total[count]',
+ title='Total',
+ type='integer')
+ }
+
+ if (self$options$exp) {
+ freqs$addColumn(
+ name='.total[exp]',
+ title='Total',
+ type='number')
+ }
+
+ if (self$options$pcRow) {
+ freqs$addColumn(
+ name='.total[pcRow]',
+ title='Total',
+ type='number',
+ format='pc')
+ }
+
+ if (self$options$pcCol) {
+ freqs$addColumn(
+ name='.total[pcCol]',
+ title='Total',
+ type='number',
+ format='pc')
+ }
+
+ if (self$options$pcTot) {
+ freqs$addColumn(
+ name='.total[pcTot]',
+ title='Total',
+ type='number',
+ format='pc')
+ }
+
+ # populate the first column with levels of the row variable
+
+ values <- list()
+ for (i in seq_along(subNames))
+ values[[paste0('type', subNames[i])]] <- subTitles[i]
+
+ rows <- private$.grid(data=data, incRows=TRUE)
+
+ nextIsNewGroup <- TRUE
+
+ for (i in seq_len(nrow(rows))) {
+
+ for (name in colnames(rows)) {
+ value <- as.character(rows[i, name])
+ if (value == '.total')
+ value <- 'Total'
+ values[[name]] <- value
+ }
+
+ key <- paste0(rows[i,], collapse='`')
+ freqs$addRow(rowKey=key, values=values)
+
+ if (nextIsNewGroup) {
+ freqs$addFormat(rowNo=i, 1, Cell.BEGIN_GROUP)
+ nextIsNewGroup <- FALSE
+ }
+
+ if (as.character(rows[i, name]) == '.total') {
+ freqs$addFormat(rowNo=i, 1, Cell.BEGIN_END_GROUP)
+ nextIsNewGroup <- TRUE
+ if (i > 1)
+ freqs$addFormat(rowNo=i - 1, 1, Cell.END_GROUP)
+ }
+ }
+
+ rows <- private$.grid(data=data, incRows=FALSE)
+ values <- list()
+
+ if (length(rows) == 0) {
+
+ chiSq$addRow(rowKey=1, values=list())
+ nom$addRow(rowKey=1, values=list())
+ odds$addRow(rowKey=1, values=list())
+ gamma$addRow(rowKey=1, values=list())
+ taub$addRow(rowKey=1, values=list())
+
+ } else {
+
+ for (i in seq_len(nrow(rows))) {
+
+ for (name in dimnames(rows)[[2]]) {
+ value <- as.character(rows[i, name])
+ if (value == '.total')
+ value <- 'Total'
+ values[[name]] <- value
+ }
+
+ chiSq$addRow(rowKey=i, values=values)
+ nom$addRow(rowKey=i, values=values)
+ odds$addRow(rowKey=i, values=values)
+ gamma$addRow(rowKey=i, values=values)
+ taub$addRow(rowKey=i, values=values)
+ }
+ }
+
+ ciText <- paste0(self$options$ciWidth, '% Confidence Intervals')
+ odds$getColumn('cil[lo]')$setSuperTitle(ciText)
+ odds$getColumn('ciu[lo]')$setSuperTitle(ciText)
+ odds$getColumn('cil[o]')$setSuperTitle(ciText)
+ odds$getColumn('ciu[o]')$setSuperTitle(ciText)
+ odds$getColumn('cil[rr]')$setSuperTitle(ciText)
+ odds$getColumn('ciu[rr]')$setSuperTitle(ciText)
+ gamma$getColumn('cil')$setSuperTitle(ciText)
+ gamma$getColumn('ciu')$setSuperTitle(ciText)
+
+ },
+ .run=function() {
+
+ rowVarName <- self$options$rows
+ colVarName <- self$options$cols
+ countsName <- self$options$counts
+
+ if (is.null(rowVarName) || is.null(colVarName))
+ return()
+
+ data <- private$.cleanData()
+
+ if (nlevels(data[[rowVarName]]) < 2)
+ jmvcore::reject("Row variable '{}' contains less than 2 levels", code='', rowVarName)
+ if (nlevels(data[[colVarName]]) < 2)
+ jmvcore::reject("Column variable '{}' contains less than 2 levels", code='', colVarName)
+
+ if ( ! is.null(countsName)) {
+ countCol <- data[[countsName]]
+ if (any(countCol < 0, na.rm=TRUE))
+ jmvcore::reject('Counts may not be negative')
+ if (any(is.infinite(countCol)))
+ jmvcore::reject('Counts may not be infinite')
+ }
+
+ freqs <- self$results$freqs
+ chiSq <- self$results$chiSq
+ nom <- self$results$nom
+ odds <- self$results$odds
+ gamma <- self$results$gamma
+ taub <- self$results$taub
+
+ freqRowNo <- 1
+ othRowNo <- 1
+
+ mats <- private$.matrices(data)
+
+ nRows <- base::nlevels(data[[rowVarName]])
+ nCols <- base::nlevels(data[[colVarName]])
+ nCells <- nRows * nCols
+
+ ciWidth <- self$options$ciWidth / 100
+
+ for (mat in mats) {
+
+ suppressWarnings({
+
+ test <- try(chisq.test(mat, correct=FALSE))
+ corr <- try(chisq.test(mat, correct=TRUE))
+ asso <- vcd::assocstats(mat)
+ gamm <- vcdExtra::GKgamma(mat)
+ n <- sum(mat)
+
+ if (base::inherits(test, 'try-error'))
+ exp <- mat
+ else
+ exp <- test$expected
+
+ if (self$options$taub) {
+ df <- as.data.frame(as.table(mat))
+ v1 <- rep(as.numeric(df[[1]]), df$Freq)
+ v2 <- rep(as.numeric(df[[2]]), df$Freq)
+
+ # this can be slow
+ tau <- try(cor.test(v1, v2, method='kendall', conf.level=ciWidth))
+ }
+
+ lor <- NULL
+ fish <- NULL
+ if (all(dim(mat) == 2)) {
+ fish <- stats::fisher.test(mat, conf.level=ciWidth)
+ lor <- vcd::loddsratio(mat)
+ rr <- private$.relativeRisk(mat)
+ }
+
+ }) # suppressWarnings
+
+ total <- sum(mat)
+ colTotals <- apply(mat, 2, sum)
+ rowTotals <- apply(mat, 1, sum)
+
+ for (rowNo in seq_len(nRows)) {
+
+ values <- mat[rowNo,]
+ rowTotal <- sum(values)
+
+ pcRow <- values / rowTotal
+
+ values <- as.list(values)
+ names(values) <- paste0(1:nCols, '[count]')
+ values[['.total[count]']] <- rowTotal
+
+ expValues <- exp[rowNo,]
+ expValues <- as.list(expValues)
+ names(expValues) <- paste0(1:nCols, '[expected]')
+ expValues[['.total[exp]']] <- sum(exp[rowNo,])
+
+ pcRow <- as.list(pcRow)
+ names(pcRow) <- paste0(1:nCols, '[pcRow]')
+ pcRow[['.total[pcRow]']] <- 1
+
+ pcCol <- as.list(mat[rowNo,] / colTotals)
+ names(pcCol) <- paste0(1:nCols, '[pcCol]')
+ pcCol[['.total[pcCol]']] <- unname(rowTotals[rowNo] / total)
+
+ pcTot <- as.list(mat[rowNo,] / total)
+ names(pcTot) <- paste0(1:nCols, '[pcTot]')
+ pcTot[['.total[pcTot]']] <- sum(mat[rowNo,] / total)
+
+ values <- c(values, expValues, pcRow, pcCol, pcTot)
+
+ freqs$setRow(rowNo=freqRowNo, values=values)
+ freqRowNo <- freqRowNo + 1
+ }
+
+ values <- apply(mat, 2, sum)
+ rowTotal <- sum(values)
+ values <- as.list(values)
+ names(values) <- paste0(1:nCols, '[count]')
+ values[['.total[count]']] <- rowTotal
+
+ expValues <- apply(mat, 2, sum)
+ expValues <- as.list(expValues)
+ names(expValues) <- paste0(1:nCols, '[expected]')
+
+ pcRow <- apply(mat, 2, sum) / rowTotal
+ pcRow <- as.list(pcRow)
+ names(pcRow) <- paste0(1:nCols, '[pcRow]')
+
+ pcCol <- rep(1, nCols)
+ pcCol <- as.list(pcCol)
+ names(pcCol) <- paste0(1:nCols, '[pcCol]')
+
+ pcTot <- apply(mat, 2, sum) / total
+ pcTot <- as.list(pcTot)
+ names(pcTot) <- paste0(1:nCols, '[pcTot]')
+
+ expValues[['.total[exp]']] <- total
+ pcRow[['.total[pcRow]']] <- 1
+ pcCol[['.total[pcCol]']] <- 1
+ pcTot[['.total[pcTot]']] <- 1
+
+ values <- c(values, expValues, pcRow, pcCol, pcTot)
+
+ freqs$setRow(rowNo=freqRowNo, values=values)
+ freqRowNo <- freqRowNo + 1
+
+ # populate chi squared table
+
+ if (base::inherits(test, 'try-error')) {
+ values <- list(
+ `value[chiSq]`=NaN,
+ `df[chiSq]`='',
+ `p[chiSq]`='',
+ `value[chiSqCorr]`=NaN,
+ `df[chiSqCorr]`='',
+ `p[chiSqCorr]`='',
+ `value[likeRat]`=NaN,
+ `df[likeRat]`='',
+ `p[likeRat]`='',
+ `value[fisher]`=NaN,
+ `p[fisher]`='',
+ `value[N]`=n)
+ } else {
+
+ if (is.null(fish)) {
+ fishE <- NaN
+ fishP <- ''
+ } else {
+ fishE <- fish$estimate
+ fishP <- fish$p.value
+ }
+
+ values <- list(
+ `value[chiSq]`=unname(test$statistic),
+ `df[chiSq]`=unname(test$parameter),
+ `p[chiSq]`=unname(test$p.value),
+ `value[chiSqCorr]`=unname(corr$statistic),
+ `df[chiSqCorr]`=unname(corr$parameter),
+ `p[chiSqCorr]`=unname(corr$p.value),
+ `value[likeRat]`=asso$chisq_tests['Likelihood Ratio', 'X^2'],
+ `df[likeRat]`=asso$chisq_tests['Likelihood Ratio', 'df'],
+ `p[likeRat]`=asso$chisq_tests['Likelihood Ratio', 'P(> X^2)'],
+ `value[fisher]`=fishE,
+ `p[fisher]`=fishP,
+ `value[N]`=n)
+ }
+
+ chiSq$setRow(rowNo=othRowNo, values=values)
+
+ if (is.null(fish))
+ chiSq$addFootnote(rowNo=othRowNo, 'value[fisher]', 'Available for 2x2 tables only')
+
+ values <- list(
+ `v[cont]`=asso$contingency,
+ `v[phi]`=ifelse(is.na(asso$phi), NaN, asso$phi),
+ `v[cra]`=asso$cramer)
+ nom$setRow(rowNo=othRowNo, values=values)
+
+ values <- list(
+ gamma=gamm$gamma,
+ se=gamm$sigma,
+ cil=gamm$CI[1],
+ ciu=gamm$CI[2])
+ gamma$setRow(rowNo=othRowNo, values=values)
+
+ if (self$options$taub) {
+ if (base::inherits(tau, 'try-error') || is.na(tau$estimate))
+ values <- list(taub=NaN, t='', p='')
+ else
+ values <- list(
+ taub=tau$estimate,
+ t=unname(tau$statistic),
+ p=tau$p.value)
+ taub$setRow(rowNo=othRowNo, values=values)
+ }
+
+ if ( ! is.null(lor)) {
+ ci <- confint(lor, level=ciWidth)
+ odds$setRow(rowNo=othRowNo, list(
+ `v[lo]`=unname(lor[[1]]),
+ `cil[lo]`=ci[1],
+ `ciu[lo]`=ci[2],
+ `v[o]`=exp(unname(lor[[1]])),
+ `cil[o]`=exp(ci[1]),
+ `ciu[o]`=exp(ci[2]),
+ `v[rr]`=rr$rr,
+ `cil[rr]`=rr$lower,
+ `ciu[rr]`=rr$upper))
+
+ } else {
+ odds$setRow(rowNo=othRowNo, list(
+ `v[lo]`=NaN, `cil[lo]`='', `ciu[lo]`='',
+ `v[o]`=NaN, `cil[o]`='', `ciu[o]`='',
+ `v[rr]`=NaN, `cil[rr]`='', `ciu[rr]`=''))
+ odds$addFootnote(rowNo=othRowNo, 'v[lo]', 'Available for 2x2 tables only')
+ odds$addFootnote(rowNo=othRowNo, 'v[o]', 'Available for 2x2 tables only')
+ odds$addFootnote(rowNo=othRowNo, 'v[rr]', 'Available for 2x2 tables only')
+ }
+
+ othRowNo <- othRowNo + 1
+ }
+
+ },
+
+ #### Helper functions ----
+ .cleanData = function() {
+
+ data <- self$data
+
+ rowVarName <- self$options$rows
+ colVarName <- self$options$cols
+ layerNames <- self$options$layers
+ countsName <- self$options$counts
+
+ if ( ! is.null(rowVarName))
+ data[[rowVarName]] <- as.factor(data[[rowVarName]])
+ if ( ! is.null(colVarName))
+ data[[colVarName]] <- as.factor(data[[colVarName]])
+ for (layerName in layerNames)
+ data[[layerName]] <- as.factor(data[[layerName]])
+ if ( ! is.null(countsName))
+ data[[countsName]] <- toNumeric(data[[countsName]])
+
+ data
+ },
+ .matrices=function(data) {
+
+ matrices <- list()
+
+ rowVarName <- self$options$rows
+ colVarName <- self$options$cols
+ layerNames <- self$options$layers
+ countsName <- self$options$counts
+
+ if (length(layerNames) == 0) {
+
+ subData <- jmvcore::select(data, c(rowVarName, colVarName))
+
+ if (is.null(countsName))
+ .COUNTS <- rep(1, nrow(subData))
+ else
+ .COUNTS <- jmvcore::toNumeric(data[[countsName]])
+
+ matrices <- list(ftable(xtabs(.COUNTS ~ ., data=subData)))
+
+ } else {
+
+ layerData <- jmvcore::select(data, layerNames)
+ dataList <- do.call(split, list(data, layerData))
+
+ tables <- lapply(dataList, function(x) {
+
+ xTemp <- jmvcore::select(x, c(rowVarName, colVarName))
+
+ if (is.null(countsName))
+ .COUNTS <- rep(1, nrow(xTemp))
+ else
+ .COUNTS <- jmvcore::toNumeric(x[[countsName]])
+
+ ftable(xtabs(.COUNTS ~ ., data=xTemp))
+ })
+
+ rows <- private$.grid(data=data, incRows=FALSE)
+
+ expand <- list()
+
+ for (layerName in layerNames)
+ expand[[layerName]] <- c(base::levels(data[[layerName]]))
+
+ tableNames <- rev(expand.grid(expand))
+
+ matrices <- list()
+ for (i in seq_along(rows[,1])) {
+
+ indices <- c()
+ for (j in seq_along(tableNames[,1])) {
+
+ row <- as.character(unlist((rows[i,])))
+ tableName <- as.character(unlist(tableNames[j,]))
+
+ if (all(row == tableName | row == '.total'))
+ indices <- c(indices, j)
+ }
+
+ matrices[[i]] <- Reduce("+", tables[indices])
+ }
+
+ }
+
+ matrices
+ },
+ .grid=function(data, incRows=FALSE) {
+
+ rowVarName <- self$options$rows
+ layerNames <- self$options$layers
+
+ expand <- list()
+
+ if (incRows) {
+ if (is.null(rowVarName))
+ expand[['.']] <- c('.', '. ', 'Total')
+ else
+ expand[[rowVarName]] <- c(base::levels(data[[rowVarName]]), '.total')
+ }
+ for (layerName in layerNames)
+ expand[[layerName]] <- c(base::levels(data[[layerName]]), '.total')
-pairchiClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "pairchiClass",
- inherit = pairchiBase,
- private = list(
- .run = function() {
+ rows <- rev(expand.grid(expand))
+ rows
+ },
+ .relativeRisk = function(mat) {
+ # https://en.wikipedia.org/wiki/Relative_risk#Tests
- # TODO
+ dims <- dim(mat)
- todo <- glue::glue(
- "This Module is still under development
- -
- -
- "
- )
+ if (dims[1] > 2 || dims[2] > 2)
+ return(NULL)
- self$results$todo$setContent(todo)
+ ciWidth <- self$options$ciWidth
+ tail <- (100 - ciWidth) / 200
+ z <- qnorm(tail, lower.tail = FALSE)
+ a <- mat[1,1]
+ b <- mat[1,2]
+ c <- mat[2,1]
+ d <- mat[2,2]
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
+ p1 <- a / (a + b)
+ p2 <- c / (c + d)
+ m <- log(p1 / p2)
+ s <- sqrt((b / (a*(a+b))) + (d / (c*(c+d))))
+ lower <- exp(m - z*s)
+ upper <- exp(m + z*s)
+ rr <- p1 / p2
- # RVAideMemoire::chisq.multcomp()
- # RVAideMemoire::fisher.multcomp()
- # rmngb::pairwise.chisq.test(x, ...)
- # rmngb::pairwise.fisher.test(x, ...)
+ return(list(rr=rr, lower=lower, upper=upper))
+ },
+ .sourcifyOption = function(option) {
+ if (option$name %in% c('rows', 'cols', 'counts'))
+ return('')
+ super$.sourcifyOption(option)
+ },
+ .formula=function() {
+ rhs <- list()
+ if ( ! is.null(self$options$rows)) {
+ rhs[[1]] <- self$options$rows
+ if ( ! is.null(self$options$cols)) {
+ rhs[[2]] <- self$options$cols
+ rhs <- c(rhs, self$options$layers)
+ }
+ }
+ jmvcore:::composeFormula(self$options$counts, list(rhs))
})
)
diff --git a/R/pairchi.h.R b/R/pairchi.h.R
index 369bf31f..ef60267d 100644
--- a/R/pairchi.h.R
+++ b/R/pairchi.h.R
@@ -6,10 +6,28 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
inherit = jmvcore::Options,
public = list(
initialize = function(
- dep = NULL,
- group = NULL,
- alt = "notequal",
- varEq = TRUE, ...) {
+ rows = NULL,
+ cols = NULL,
+ counts = NULL,
+ layers = NULL,
+ chiSq = TRUE,
+ chiSqCorr = FALSE,
+ likeRat = FALSE,
+ fisher = FALSE,
+ contCoef = FALSE,
+ phiCra = FALSE,
+ logOdds = FALSE,
+ odds = FALSE,
+ relRisk = FALSE,
+ ci = TRUE,
+ ciWidth = 95,
+ gamma = FALSE,
+ taub = FALSE,
+ obs = TRUE,
+ exp = FALSE,
+ pcRow = FALSE,
+ pcCol = FALSE,
+ pcTot = FALSE, ...) {
super$initialize(
package='ClinicoPath',
@@ -17,62 +35,464 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
requiresData=TRUE,
...)
- private$..dep <- jmvcore::OptionVariable$new(
- "dep",
- dep)
- private$..group <- jmvcore::OptionVariable$new(
- "group",
- group)
- private$..alt <- jmvcore::OptionList$new(
- "alt",
- alt,
- options=list(
- "notequal",
- "onegreater",
- "twogreater"),
- default="notequal")
- private$..varEq <- jmvcore::OptionBool$new(
- "varEq",
- varEq,
+ private$..rows <- jmvcore::OptionVariable$new(
+ "rows",
+ rows,
+ suggested=list(
+ "nominal",
+ "ordinal"),
+ permitted=list(
+ "factor"))
+ private$..cols <- jmvcore::OptionVariable$new(
+ "cols",
+ cols,
+ suggested=list(
+ "nominal",
+ "ordinal"),
+ permitted=list(
+ "factor"))
+ private$..counts <- jmvcore::OptionVariable$new(
+ "counts",
+ counts,
+ suggested=list(
+ "continuous"),
+ permitted=list(
+ "numeric"),
+ default=NULL)
+ private$..layers <- jmvcore::OptionVariables$new(
+ "layers",
+ layers,
+ default=NULL,
+ permitted=list(
+ "factor"))
+ private$..chiSq <- jmvcore::OptionBool$new(
+ "chiSq",
+ chiSq,
default=TRUE)
+ private$..chiSqCorr <- jmvcore::OptionBool$new(
+ "chiSqCorr",
+ chiSqCorr,
+ default=FALSE)
+ private$..likeRat <- jmvcore::OptionBool$new(
+ "likeRat",
+ likeRat,
+ default=FALSE)
+ private$..fisher <- jmvcore::OptionBool$new(
+ "fisher",
+ fisher,
+ default=FALSE)
+ private$..contCoef <- jmvcore::OptionBool$new(
+ "contCoef",
+ contCoef,
+ default=FALSE)
+ private$..phiCra <- jmvcore::OptionBool$new(
+ "phiCra",
+ phiCra,
+ default=FALSE)
+ private$..logOdds <- jmvcore::OptionBool$new(
+ "logOdds",
+ logOdds,
+ default=FALSE)
+ private$..odds <- jmvcore::OptionBool$new(
+ "odds",
+ odds,
+ default=FALSE)
+ private$..relRisk <- jmvcore::OptionBool$new(
+ "relRisk",
+ relRisk,
+ default=FALSE)
+ private$..ci <- jmvcore::OptionBool$new(
+ "ci",
+ ci,
+ default=TRUE)
+ private$..ciWidth <- jmvcore::OptionNumber$new(
+ "ciWidth",
+ ciWidth,
+ min=50,
+ max=99.9,
+ default=95)
+ private$..gamma <- jmvcore::OptionBool$new(
+ "gamma",
+ gamma,
+ default=FALSE)
+ private$..taub <- jmvcore::OptionBool$new(
+ "taub",
+ taub,
+ default=FALSE)
+ private$..obs <- jmvcore::OptionBool$new(
+ "obs",
+ obs,
+ default=TRUE)
+ private$..exp <- jmvcore::OptionBool$new(
+ "exp",
+ exp,
+ default=FALSE)
+ private$..pcRow <- jmvcore::OptionBool$new(
+ "pcRow",
+ pcRow,
+ default=FALSE)
+ private$..pcCol <- jmvcore::OptionBool$new(
+ "pcCol",
+ pcCol,
+ default=FALSE)
+ private$..pcTot <- jmvcore::OptionBool$new(
+ "pcTot",
+ pcTot,
+ default=FALSE)
- self$.addOption(private$..dep)
- self$.addOption(private$..group)
- self$.addOption(private$..alt)
- self$.addOption(private$..varEq)
+ self$.addOption(private$..rows)
+ self$.addOption(private$..cols)
+ self$.addOption(private$..counts)
+ self$.addOption(private$..layers)
+ self$.addOption(private$..chiSq)
+ self$.addOption(private$..chiSqCorr)
+ self$.addOption(private$..likeRat)
+ self$.addOption(private$..fisher)
+ self$.addOption(private$..contCoef)
+ self$.addOption(private$..phiCra)
+ self$.addOption(private$..logOdds)
+ self$.addOption(private$..odds)
+ self$.addOption(private$..relRisk)
+ self$.addOption(private$..ci)
+ self$.addOption(private$..ciWidth)
+ self$.addOption(private$..gamma)
+ self$.addOption(private$..taub)
+ self$.addOption(private$..obs)
+ self$.addOption(private$..exp)
+ self$.addOption(private$..pcRow)
+ self$.addOption(private$..pcCol)
+ self$.addOption(private$..pcTot)
}),
active = list(
- dep = function() private$..dep$value,
- group = function() private$..group$value,
- alt = function() private$..alt$value,
- varEq = function() private$..varEq$value),
+ rows = function() private$..rows$value,
+ cols = function() private$..cols$value,
+ counts = function() private$..counts$value,
+ layers = function() private$..layers$value,
+ chiSq = function() private$..chiSq$value,
+ chiSqCorr = function() private$..chiSqCorr$value,
+ likeRat = function() private$..likeRat$value,
+ fisher = function() private$..fisher$value,
+ contCoef = function() private$..contCoef$value,
+ phiCra = function() private$..phiCra$value,
+ logOdds = function() private$..logOdds$value,
+ odds = function() private$..odds$value,
+ relRisk = function() private$..relRisk$value,
+ ci = function() private$..ci$value,
+ ciWidth = function() private$..ciWidth$value,
+ gamma = function() private$..gamma$value,
+ taub = function() private$..taub$value,
+ obs = function() private$..obs$value,
+ exp = function() private$..exp$value,
+ pcRow = function() private$..pcRow$value,
+ pcCol = function() private$..pcCol$value,
+ pcTot = function() private$..pcTot$value),
private = list(
- ..dep = NA,
- ..group = NA,
- ..alt = NA,
- ..varEq = NA)
+ ..rows = NA,
+ ..cols = NA,
+ ..counts = NA,
+ ..layers = NA,
+ ..chiSq = NA,
+ ..chiSqCorr = NA,
+ ..likeRat = NA,
+ ..fisher = NA,
+ ..contCoef = NA,
+ ..phiCra = NA,
+ ..logOdds = NA,
+ ..odds = NA,
+ ..relRisk = NA,
+ ..ci = NA,
+ ..ciWidth = NA,
+ ..gamma = NA,
+ ..taub = NA,
+ ..obs = NA,
+ ..exp = NA,
+ ..pcRow = NA,
+ ..pcCol = NA,
+ ..pcTot = NA)
)
pairchiResults <- if (requireNamespace('jmvcore')) R6::R6Class(
inherit = jmvcore::Group,
active = list(
- todo = function() private$.items[["todo"]],
- text = function() private$.items[["text"]]),
+ freqs = function() private$.items[["freqs"]],
+ chiSq = function() private$.items[["chiSq"]],
+ odds = function() private$.items[["odds"]],
+ nom = function() private$.items[["nom"]],
+ gamma = function() private$.items[["gamma"]],
+ taub = function() private$.items[["taub"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
- title="Pairwise Chi-Square Test")
- self$add(jmvcore::Html$new(
+ title="Paired Samples Contingency Tables")
+ self$add(jmvcore::Table$new(
+ options=options,
+ name="freqs",
+ title="Contingency Tables",
+ columns=list(),
+ clearWith=list(
+ "rows",
+ "cols",
+ "counts",
+ "layers")))
+ self$add(jmvcore::Table$new(
+ options=options,
+ name="chiSq",
+ title="\u03C7\u00B2 Tests",
+ clearWith=list(
+ "rows",
+ "cols",
+ "counts",
+ "layers"),
+ columns=list(
+ list(
+ `name`="test[chiSq]",
+ `title`="",
+ `type`="text",
+ `content`="\u03C7\u00B2",
+ `visible`="(chiSq)"),
+ list(
+ `name`="value[chiSq]",
+ `title`="Value",
+ `visible`="(chiSq)"),
+ list(
+ `name`="df[chiSq]",
+ `title`="df",
+ `type`="integer",
+ `visible`="(chiSq)"),
+ list(
+ `name`="p[chiSq]",
+ `title`="p",
+ `type`="number",
+ `format`="zto,pvalue",
+ `visible`="(chiSq)"),
+ list(
+ `name`="test[chiSqCorr]",
+ `title`="",
+ `type`="text",
+ `content`="\u03C7\u00B2 continuity correction",
+ `visible`="(chiSqCorr)"),
+ list(
+ `name`="value[chiSqCorr]",
+ `title`="Value",
+ `visible`="(chiSqCorr)"),
+ list(
+ `name`="df[chiSqCorr]",
+ `title`="df",
+ `type`="integer",
+ `visible`="(chiSqCorr)"),
+ list(
+ `name`="p[chiSqCorr]",
+ `title`="p",
+ `type`="number",
+ `format`="zto,pvalue",
+ `visible`="(chiSqCorr)"),
+ list(
+ `name`="test[likeRat]",
+ `title`="",
+ `type`="text",
+ `content`="Likelihood ratio",
+ `visible`="(likeRat)",
+ `refs`="vcd"),
+ list(
+ `name`="value[likeRat]",
+ `title`="Value",
+ `visible`="(likeRat)"),
+ list(
+ `name`="df[likeRat]",
+ `title`="df",
+ `type`="integer",
+ `visible`="(likeRat)"),
+ list(
+ `name`="p[likeRat]",
+ `title`="p",
+ `type`="number",
+ `format`="zto,pvalue",
+ `visible`="(likeRat)"),
+ list(
+ `name`="test[fisher]",
+ `title`="",
+ `type`="text",
+ `content`="Fisher's exact test",
+ `visible`="(fisher)"),
+ list(
+ `name`="value[fisher]",
+ `title`="Value",
+ `visible`="(fisher)"),
+ list(
+ `name`="p[fisher]",
+ `title`="p",
+ `type`="number",
+ `format`="zto,pvalue",
+ `visible`="(fisher)"),
+ list(
+ `name`="test[N]",
+ `title`="",
+ `type`="text",
+ `content`="N"),
+ list(
+ `name`="value[N]",
+ `title`="Value",
+ `type`="integer"))))
+ self$add(jmvcore::Table$new(
options=options,
- name="todo",
- title="To Do"))
- self$add(jmvcore::Preformatted$new(
+ name="odds",
+ title="Comparative Measures",
+ visible="(logOdds || odds || relRisk)",
+ clearWith=list(
+ "rows",
+ "cols",
+ "counts",
+ "layers",
+ "ciWidth"),
+ columns=list(
+ list(
+ `name`="t[lo]",
+ `title`="",
+ `type`="text",
+ `content`="Log odds ratio",
+ `visible`="(logOdds)",
+ `refs`="vcd"),
+ list(
+ `name`="v[lo]",
+ `title`="Value",
+ `visible`="(logOdds)"),
+ list(
+ `name`="cil[lo]",
+ `title`="Lower",
+ `superTitle`="Confidence Intervals",
+ `visible`="(logOdds && ci)"),
+ list(
+ `name`="ciu[lo]",
+ `title`="Upper",
+ `superTitle`="Confidence Intervals",
+ `visible`="(logOdds && ci)"),
+ list(
+ `name`="t[o]",
+ `title`="",
+ `type`="text",
+ `content`="Odds ratio",
+ `visible`="(odds)"),
+ list(
+ `name`="v[o]",
+ `title`="Value",
+ `visible`="(odds)"),
+ list(
+ `name`="cil[o]",
+ `title`="Lower",
+ `superTitle`="Confidence Intervals",
+ `visible`="(odds && ci)"),
+ list(
+ `name`="ciu[o]",
+ `title`="Upper",
+ `superTitle`="Confidence Intervals",
+ `visible`="(odds && ci)"),
+ list(
+ `name`="t[rr]",
+ `title`="",
+ `type`="text",
+ `content`="Relative risk",
+ `visible`="(relRisk)"),
+ list(
+ `name`="v[rr]",
+ `title`="Value",
+ `visible`="(relRisk)"),
+ list(
+ `name`="cil[rr]",
+ `title`="Lower",
+ `superTitle`="Confidence Intervals",
+ `visible`="(relRisk && ci)"),
+ list(
+ `name`="ciu[rr]",
+ `title`="Upper",
+ `superTitle`="Confidence Intervals",
+ `visible`="(relRisk && ci)"))))
+ self$add(jmvcore::Table$new(
options=options,
- name="text",
- title="Pairwise Chi-Square Test"))}))
+ name="nom",
+ title="Nominal",
+ visible="(contCoef || phiCra)",
+ columns=list(
+ list(
+ `name`="t[cont]",
+ `title`="",
+ `type`="text",
+ `content`="Contingency coefficient",
+ `visible`="(contCoef)"),
+ list(
+ `name`="v[cont]",
+ `title`="Value",
+ `visible`="(contCoef)"),
+ list(
+ `name`="t[phi]",
+ `title`="",
+ `type`="text",
+ `content`="Phi-coefficient",
+ `visible`="(phiCra)"),
+ list(
+ `name`="v[phi]",
+ `title`="Value",
+ `visible`="(phiCra)"),
+ list(
+ `name`="t[cra]",
+ `title`="",
+ `type`="text",
+ `content`="Cramer's V",
+ `visible`="(phiCra)"),
+ list(
+ `name`="v[cra]",
+ `title`="Value",
+ `visible`="(phiCra)"))))
+ self$add(jmvcore::Table$new(
+ options=options,
+ name="gamma",
+ title="Gamma",
+ visible="(gamma)",
+ refs="vcdExtra",
+ clearWith=list(
+ "rows",
+ "cols",
+ "counts",
+ "layers"),
+ columns=list(
+ list(
+ `name`="gamma",
+ `title`="Gamma"),
+ list(
+ `name`="se",
+ `title`="Standard Error"),
+ list(
+ `name`="cil",
+ `title`="Lower",
+ `superTitle`="Confidence Intervals"),
+ list(
+ `name`="ciu",
+ `title`="Upper",
+ `superTitle`="Confidence Intervals"))))
+ self$add(jmvcore::Table$new(
+ options=options,
+ name="taub",
+ title="Kendall's Tau-b",
+ visible="(taub)",
+ clearWith=list(
+ "rows",
+ "cols",
+ "counts",
+ "layers"),
+ columns=list(
+ list(
+ `name`="taub",
+ `title`="Kendall's Tau-B"),
+ list(
+ `name`="t",
+ `title`="t"),
+ list(
+ `name`="p",
+ `title`="p",
+ `type`="number",
+ `format`="zto,pvalue"))))}))
pairchiBase <- if (requireNamespace('jmvcore')) R6::R6Class(
"pairchiBase",
@@ -90,54 +510,211 @@ pairchiBase <- if (requireNamespace('jmvcore')) R6::R6Class(
analysisId = analysisId,
revision = revision,
pause = NULL,
- completeWhenFilled = FALSE,
+ completeWhenFilled = TRUE,
requiresMissings = FALSE)
}))
#' Pairwise Chi-Square Test
#'
-#' Function for Pairwise Chi-Square Test Analysis.
+#' The X² test of association (not to be confused with the X² goodness of fit)
+#' is used to test whether two categorical variables are independent or
+#' associated. If the p-value is low, it suggests the variables are not
+#' independent, and that there is a relationship between the two variables.
+#'
#'
#' @examples
-#' \dontrun{
-#' # example will be added
-#'}
-#' @param data The data as a data frame.
-#' @param dep .
-#' @param group .
-#' @param alt .
-#' @param varEq .
+#' data('HairEyeColor')
+#' dat <- as.data.frame(HairEyeColor)
+#'
+#' contTables(formula = Freq ~ Hair:Eye, dat)
+#'
+#' #
+#' # CONTINGENCY TABLES
+#' #
+#' # Contingency Tables
+#' # -----------------------------------------------------
+#' # Hair Brown Blue Hazel Green Total
+#' # -----------------------------------------------------
+#' # Black 68 20 15 5 108
+#' # Brown 119 84 54 29 286
+#' # Red 26 17 14 14 71
+#' # Blond 7 94 10 16 127
+#' # Total 220 215 93 64 592
+#' # -----------------------------------------------------
+#' #
+#' #
+#' # X² Tests
+#' # -------------------------------
+#' # Value df p
+#' # -------------------------------
+#' # X² 138 9 < .001
+#' # N 592
+#' # -------------------------------
+#' #
+#'
+#' # Alternatively, omit the left of the formula (`Freq`) if each row
+#' # represents a single observation:
+#'
+#' contTables(formula = ~ Hair:Eye, dat)
+#'
+#' @param data the data as a data frame
+#' @param rows the variable to use as the rows in the contingency table (not
+#' necessary when providing a formula, see the examples)
+#' @param cols the variable to use as the columns in the contingency table
+#' (not necessary when providing a formula, see the examples)
+#' @param counts the variable to use as the counts in the contingency table
+#' (not necessary when providing a formula, see the examples)
+#' @param layers the variables to use to split the contingency table (not
+#' necessary when providing a formula, see the examples)
+#' @param chiSq \code{TRUE} (default) or \code{FALSE}, provide X²
+#' @param chiSqCorr \code{TRUE} or \code{FALSE} (default), provide X² with
+#' continuity correction
+#' @param likeRat \code{TRUE} or \code{FALSE} (default), provide the
+#' likelihood ratio
+#' @param fisher \code{TRUE} or \code{FALSE} (default), provide Fisher's exact
+#' test
+#' @param contCoef \code{TRUE} or \code{FALSE} (default), provide the
+#' contingency coefficient
+#' @param phiCra \code{TRUE} or \code{FALSE} (default), provide Phi and
+#' Cramer's V
+#' @param logOdds \code{TRUE} or \code{FALSE} (default), provide the log odds
+#' ratio (only available for 2x2 tables)
+#' @param odds \code{TRUE} or \code{FALSE} (default), provide the odds ratio
+#' (only available for 2x2 tables)
+#' @param relRisk \code{TRUE} or \code{FALSE} (default), provide the relative
+#' risk (only available for 2x2 tables)
+#' @param ci \code{TRUE} or \code{FALSE} (default), provide confidence
+#' intervals for the comparative measures
+#' @param ciWidth a number between 50 and 99.9 (default: 95), width of the
+#' confidence intervals to provide
+#' @param gamma \code{TRUE} or \code{FALSE} (default), provide gamma
+#' @param taub \code{TRUE} or \code{FALSE} (default), provide Kendall's tau-b
+#' @param obs \code{TRUE} or \code{FALSE} (default), provide the observed
+#' counts
+#' @param exp \code{TRUE} or \code{FALSE} (default), provide the expected
+#' counts
+#' @param pcRow \code{TRUE} or \code{FALSE} (default), provide row percentages
+#' @param pcCol \code{TRUE} or \code{FALSE} (default), provide column
+#' percentages
+#' @param pcTot \code{TRUE} or \code{FALSE} (default), provide total
+#' percentages
+#' @param formula (optional) the formula to use, see the examples
#' @return A results object containing:
#' \tabular{llllll}{
-#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
-#' \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
+#' \code{results$freqs} \tab \tab \tab \tab \tab a table of proportions \cr
+#' \code{results$chiSq} \tab \tab \tab \tab \tab a table of X² test results \cr
+#' \code{results$odds} \tab \tab \tab \tab \tab a table of comparative measures \cr
+#' \code{results$nom} \tab \tab \tab \tab \tab a table of the 'nominal' test results \cr
+#' \code{results$gamma} \tab \tab \tab \tab \tab a table of the gamma test results \cr
+#' \code{results$taub} \tab \tab \tab \tab \tab a table of the Kendall's tau-b test results \cr
#' }
#'
+#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
+#'
+#' \code{results$freqs$asDF}
+#'
+#' \code{as.data.frame(results$freqs)}
+#'
#' @export
pairchi <- function(
data,
- dep,
- group,
- alt = "notequal",
- varEq = TRUE) {
+ rows,
+ cols,
+ counts = NULL,
+ layers = NULL,
+ chiSq = TRUE,
+ chiSqCorr = FALSE,
+ likeRat = FALSE,
+ fisher = FALSE,
+ contCoef = FALSE,
+ phiCra = FALSE,
+ logOdds = FALSE,
+ odds = FALSE,
+ relRisk = FALSE,
+ ci = TRUE,
+ ciWidth = 95,
+ gamma = FALSE,
+ taub = FALSE,
+ obs = TRUE,
+ exp = FALSE,
+ pcRow = FALSE,
+ pcCol = FALSE,
+ pcTot = FALSE,
+ formula) {
if ( ! requireNamespace('jmvcore'))
stop('pairchi requires jmvcore to be installed (restart may be required)')
- if ( ! missing(dep)) dep <- jmvcore::resolveQuo(jmvcore::enquo(dep))
- if ( ! missing(group)) group <- jmvcore::resolveQuo(jmvcore::enquo(group))
+ if ( ! missing(formula)) {
+ if (missing(counts))
+ counts <- jmvcore::marshalFormula(
+ formula=formula,
+ data=`if`( ! missing(data), data, NULL),
+ from='lhs',
+ type='vars',
+ subset='1')
+ if (missing(rows))
+ rows <- jmvcore::marshalFormula(
+ formula=formula,
+ data=`if`( ! missing(data), data, NULL),
+ from='rhs',
+ type='vars',
+ subset='1')
+ if (missing(cols))
+ cols <- jmvcore::marshalFormula(
+ formula=formula,
+ data=`if`( ! missing(data), data, NULL),
+ from='rhs',
+ type='vars',
+ subset='2')
+ if (missing(layers))
+ layers <- jmvcore::marshalFormula(
+ formula=formula,
+ data=`if`( ! missing(data), data, NULL),
+ from='rhs',
+ type='vars',
+ subset='3:')
+ }
+
+ if ( ! missing(rows)) rows <- jmvcore::resolveQuo(jmvcore::enquo(rows))
+ if ( ! missing(cols)) cols <- jmvcore::resolveQuo(jmvcore::enquo(cols))
+ if ( ! missing(counts)) counts <- jmvcore::resolveQuo(jmvcore::enquo(counts))
+ if ( ! missing(layers)) layers <- jmvcore::resolveQuo(jmvcore::enquo(layers))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
- `if`( ! missing(dep), dep, NULL),
- `if`( ! missing(group), group, NULL))
+ `if`( ! missing(rows), rows, NULL),
+ `if`( ! missing(cols), cols, NULL),
+ `if`( ! missing(counts), counts, NULL),
+ `if`( ! missing(layers), layers, NULL))
+ for (v in rows) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
+ for (v in cols) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
+ for (v in layers) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- pairchiOptions$new(
- dep = dep,
- group = group,
- alt = alt,
- varEq = varEq)
+ rows = rows,
+ cols = cols,
+ counts = counts,
+ layers = layers,
+ chiSq = chiSq,
+ chiSqCorr = chiSqCorr,
+ likeRat = likeRat,
+ fisher = fisher,
+ contCoef = contCoef,
+ phiCra = phiCra,
+ logOdds = logOdds,
+ odds = odds,
+ relRisk = relRisk,
+ ci = ci,
+ ciWidth = ciWidth,
+ gamma = gamma,
+ taub = taub,
+ obs = obs,
+ exp = exp,
+ pcRow = pcRow,
+ pcCol = pcCol,
+ pcTot = pcTot)
analysis <- pairchiClass$new(
options = options,
diff --git a/R/reportcat.b.R b/R/reportcat.b.R
index 8e904c1d..0bb5e767 100644
--- a/R/reportcat.b.R
+++ b/R/reportcat.b.R
@@ -1,7 +1,7 @@
#' Summary of Categorical Variables
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/roc.b.R b/R/roc.b.R
index a9a9884f..d8c54664 100644
--- a/R/roc.b.R
+++ b/R/roc.b.R
@@ -1,7 +1,7 @@
#' ROC Analysis
#'
-#' @return
-#' @export
+
+
#'
#'
#'
@@ -10,30 +10,23 @@
#'
-rocClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "rocClass",
- inherit = rocBase,
- private = list(
- .run = function() {
-
-
-
- # TODO
-
- todo <- glue::glue(
- "This Module is still under development
+rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase,
+ private = list(.run = function() {
+
+
+
+ # TODO
+
+ todo <- glue::glue("This Module is still under development
-
-
- "
- )
-
- self$results$todo$setContent(todo)
-
-
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
-
-
-
- })
-)
+ ")
+
+ self$results$todo$setContent(todo)
+
+
+ if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+
+
+ }))
diff --git a/R/statsplot2.b.R b/R/statsplot2.b.R
index 349f5f00..83300d34 100644
--- a/R/statsplot2.b.R
+++ b/R/statsplot2.b.R
@@ -1,7 +1,7 @@
#' Plots and Graphs Based on Variable Types
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/summarydata.b.R b/R/summarydata.b.R
index 4368d371..1523ec1c 100644
--- a/R/summarydata.b.R
+++ b/R/summarydata.b.R
@@ -1,7 +1,7 @@
#' Summary of Continuous Variables
#'
-#' @return
-#' @export
+
+
#'
#'
#'
@@ -10,84 +10,68 @@
#' @importFrom purrr map
#'
-summarydataClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "summarydataClass",
- inherit = summarydataBase,
- private = list(
- .run = function() {
-
- if (length(self$options$vars) == 0) {
- todo <- "
+summarydataClass <- if (requireNamespace("jmvcore")) R6::R6Class("summarydataClass",
+ inherit = summarydataBase, private = list(.run = function() {
+
+ if (length(self$options$vars) == 0) {
+ todo <- "
Welcome to ClinicoPath
This tool will help you to write descriptive statistics for numeric variables.
Please cite the packages and jamovi using references below.
"
-
- html <- self$results$todo
- html$setContent(todo)
- return()
-
- } else {
- todo <- ""
- html <- self$results$todo
- html$setContent(todo)
-
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
-
-
+
+ html <- self$results$todo
+ html$setContent(todo)
+ return()
+
+ } else {
+ todo <- ""
+ html <- self$results$todo
+ html$setContent(todo)
+
+ if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+
mydata <- self$data
-
+
myvars <- jmvcore::constructFormula(terms = self$options$vars)
-
+
myvars <- jmvcore::decomposeFormula(formula = myvars)
-
+
myvars <- unlist(myvars)
-
+
# mysummary function
mysummary <- function(myvar) {
-
- mean_x <- round(mean(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE), digits = 1)
-
- sd_x <- round(sd(x = jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE), digits = 1)
-
- median_x <- round(median(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE), digits = 1)
-
- min_x <- round(min(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE), digits = 1)
-
- max_x <- round(max(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE), digits = 1)
-
- print(
- paste0(
- "Mean of ",
- myvar,
- " is: ",
- mean_x,
- " \u00B1 ",
- sd_x,
- ". (Median: ",
- median_x,
- " [Min: ",
- min_x,
- " - ",
- "Max: ",
- max_x,
- "])",
- collapse = " "
- )
- )
+
+ mean_x <- round(mean(jmvcore::toNumeric(mydata[[myvar]]),
+ na.rm = TRUE), digits = 1)
+
+ sd_x <- round(sd(x = jmvcore::toNumeric(mydata[[myvar]]),
+ na.rm = TRUE), digits = 1)
+
+ median_x <- round(median(jmvcore::toNumeric(mydata[[myvar]]),
+ na.rm = TRUE), digits = 1)
+
+ min_x <- round(min(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE),
+ digits = 1)
+
+ max_x <- round(max(jmvcore::toNumeric(mydata[[myvar]]), na.rm = TRUE),
+ digits = 1)
+
+ print(paste0("Mean of ", myvar, " is: ", mean_x, " ± ", sd_x,
+ ". (Median: ", median_x, " [Min: ", min_x, " - ", "Max: ",
+ max_x, "])", collapse = " "))
}
-
+
results <- purrr::map(.x = myvars, .f = mysummary)
-
+
results <- unlist(results)
-
+
self$results$text$setContent(results)
-
- }
-
-
- })
-)
+
+ }
+
+
+ }))
diff --git a/R/survival.b.R b/R/survival.b.R
index 91456f44..0dd9c48e 100644
--- a/R/survival.b.R
+++ b/R/survival.b.R
@@ -1,7 +1,7 @@
#' Survival Analysis
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/R/tableone.b.R b/R/tableone.b.R
index 2b8ced99..5b60668b 100644
--- a/R/tableone.b.R
+++ b/R/tableone.b.R
@@ -1,9 +1,7 @@
#' Table One
#'
-#' @return
-#' @export
+#' @return Table
#'
-#'
#'
#' @importFrom R6 R6Class
#' @importFrom jmvcore toNumeric
@@ -11,14 +9,11 @@
#'
-tableoneClass <- if (requireNamespace('jmvcore')) R6::R6Class(
- "tableoneClass",
- inherit = tableoneBase,
- private = list(
- .run = function() {
-
- if (length(self$options$vars) == 0) {
- todo <- "
+tableoneClass <- if (requireNamespace("jmvcore")) R6::R6Class("tableoneClass",
+ inherit = tableoneBase, private = list(.run = function() {
+
+ if (length(self$options$vars) == 0) {
+ todo <- "
Welcome to ClinicoPath
This tool will help you form a Table One, which is almost always used in clinicopathological research manuscripts.
@@ -27,29 +22,26 @@ tableoneClass <- if (requireNamespace('jmvcore')) R6::R6Class(
This tool uses tableone package. Please cite the packages and jamovi using references below.
"
-
- html <- self$results$todo
- html$setContent(todo)
- return()
-
- } else {
-
- todo <- ""
- html <- self$results$todo
- html$setContent(todo)
-
- if (nrow(self$data) == 0)
- stop('Data contains no (complete) rows')
-
-
- mytableone <- self$data %>%
- tableone::CreateTableOne(data = .)
-
+
+ html <- self$results$todo
+ html$setContent(todo)
+ return()
+
+ } else {
+
+ todo <- ""
+ html <- self$results$todo
+ html$setContent(todo)
+
+ if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+
+ mytableone <- self$data %>% tableone::CreateTableOne(data = .)
+
# results
-
+
self$results$text1$setContent(mytableone)
-
-
- }
- })
-)
+
+
+ }
+ }))
diff --git a/R/tree.b.R b/R/tree.b.R
index 05f78687..7573b813 100644
--- a/R/tree.b.R
+++ b/R/tree.b.R
@@ -1,9 +1,9 @@
#' Decision Tree
#'
-#' @return
-#' @export
+
+
+#'
#'
-#'
#'
#' @importFrom R6 R6Class
#' @importFrom jmvcore toNumeric
@@ -50,6 +50,30 @@ treeClass <- if (requireNamespace('jmvcore')) R6::R6Class(
+ # from https://forum.jamovi.org/viewtopic.php?f=2&t=1287
+ # library(caret)
+ # library(partykit)
+ # detach("package:partykit", unload=TRUE)
+ # library(party)
+
+ # Conditional Trees
+
+ # set.seed(3456)
+ # model <- train(
+ # yvar ~ .,
+ # data = df,
+ # method = 'ctree2',
+ # trControl = trainControl("cv", number = 10, classProbs = FALSE),
+ # tuneGrid = expand.grid(maxdepth = 3, mincriterion = 0.95)
+ # )
+ # plot(model$finalModel)
+ #
+ # t(sapply(unique(where(model$finalModel)), function(x) {
+ # n <- nodes(model$finalModel, x)[[1]]
+ # yvar <- df[as.logical(n$weights), "yvar"]
+ # cbind.data.frame("Node" = as.integer(x),
+ # psych::describe(yvar, quant=c(.25,.50,.75), skew = FALSE))
+ # }))
diff --git a/R/utils-pipe.R b/R/utils-pipe.R
index d9bc1808..7df07f6b 100644
--- a/R/utils-pipe.R
+++ b/R/utils-pipe.R
@@ -5,7 +5,7 @@
#' @name %>%
#' @rdname pipe
#' @keywords internal
-#' @export
+
#' @importFrom magrittr %>%
#' @usage lhs \%>\% rhs
NULL
diff --git a/R/vartree.b.R b/R/vartree.b.R
index 790e5509..9275027a 100644
--- a/R/vartree.b.R
+++ b/R/vartree.b.R
@@ -1,7 +1,7 @@
#' Variable Tree
#'
-#' @return
-#' @export
+
+
#'
#'
#'
diff --git a/README.Rmd b/README.Rmd
index a9aa5aa7..c877c5af 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -80,8 +80,13 @@ https://osf.io/9szud/
+---
+
+
## Screenshots of Module
+---
+
### Descriptives
#### TableOne
@@ -102,21 +107,38 @@ https://osf.io/9szud/
+#### Variable Tree
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+---
+
### Comparisons
-#### Cross Table
+#### Cross Tables
+
+
+##### Tables via arsenal, finalfit, gtsummary
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-#### GGStatsPlot
+
+#### Pairwise Chi-Square Tests
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+#### Graphs and Plots
@@ -125,9 +147,11 @@ https://osf.io/9szud/
+---
+
### Survival
-#### Univariate Survival Analysis
+#### Survival Analysis
@@ -154,33 +178,90 @@ https://osf.io/9szud/
+
+
+
+
#### Odds Ratio Table and Plot
+#### Competing Survival
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+
+---
+
+
+### Agreement
+
+
+#### Interrater Reliability
+
+
+
+
+
+#### ICC coefficients
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+---
+
### Decision
#### Medical Decision
+
+
+
+
+#### Decision Calculator
+
+
+
+
+
+#### Decision Tree
+
+##### explore
+
+
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-
+
-#### Decision Calculator
+##### FFTrees
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+
+
+
+##### rpart
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-
+
+
+#### ROC
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+---
+
### Correlation
#### Correlation
@@ -188,12 +269,11 @@ https://osf.io/9szud/
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-### Agreement
-#### Interrater Intrarater Reliability
-🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+---
+
diff --git a/README.md b/README.md
index 2978e4bb..2e203277 100644
--- a/README.md
+++ b/README.md
@@ -60,8 +60,12 @@ DOI 10.17605/OSF.IO/9SZUD
+-----
+
## Screenshots of Module
+-----
+
### Descriptives
#### TableOne
@@ -76,23 +80,41 @@ DOI 10.17605/OSF.IO/9SZUD
+#### Variable Tree
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+-----
+
### Comparisons
-#### Cross Table
+#### Cross Tables
+
+
-#### GGStatsPlot
+##### Tables via arsenal, finalfit, gtsummary
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+#### Pairwise Chi-Square Tests
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+#### Graphs and Plots
+-----
+
### Survival
-#### Univariate Survival Analysis
+#### Survival Analysis
@@ -106,34 +128,72 @@ DOI 10.17605/OSF.IO/9SZUD
+
+
#### Odds Ratio Table and Plot
-### Decision
+#### Competing Survival
-#### Medical Decision
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+-----
+
+### Agreement
+
+#### Interrater Reliability
+
+
+
+#### ICC coefficients
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+-----
+
+### Decision
+
+#### Medical Decision
+
#### Decision Calculator
+
+
+#### Decision Tree
+
+##### explore
+
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-
+
-### Correlation
+##### FFTrees
-#### Correlation
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+
+
+##### rpart
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-### Agreement
+
+
+#### ROC
+
+🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
-#### Interrater Intrarater Reliability
+-----
+
+### Correlation
+
+#### Correlation
🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+-----
+
## Installation in R
@@ -236,7 +296,7 @@ Badge](https://depshield.sonatype.org/badges/sbalci/ClinicoPathJamoviModule/deps
version](https://img.shields.io/badge/GitHub-0.0.1.1000-orange.svg?style=flat-square)](https://github.com/sbalci/clinicopathjamovimodule/)
[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
-[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
+[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
](https://github.com/sbalci/clinicopathjamovimodule/)
[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
-[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
+[](https://github.com/sbalci/clinicopathjamovimodule/commits/master)
![GitHub last
diff --git a/codemeta.json b/codemeta.json
index 2cb0a6ba..2917aef0 100644
--- a/codemeta.json
+++ b/codemeta.json
@@ -11,7 +11,7 @@
"relatedLink": "https://sbalci.github.io/ClinicoPathJamoviModule/",
"issueTracker": "\n https://github.com/sbalci/ClinicoPathJamoviModule/issues/",
"license": "https://spdx.org/licenses/GPL-3.0",
- "version": "0.0.1.11",
+ "version": "0.0.1.12",
"programmingLanguage": {
"@type": "ComputerLanguage",
"name": "R",
@@ -64,6 +64,42 @@
"url": "https://cran.r-project.org"
},
"sameAs": "https://CRAN.R-project.org/package=randomForest"
+ },
+ {
+ "@type": "SoftwareApplication",
+ "identifier": "huxtable",
+ "name": "huxtable",
+ "provider": {
+ "@id": "https://cran.r-project.org",
+ "@type": "Organization",
+ "name": "Comprehensive R Archive Network (CRAN)",
+ "url": "https://cran.r-project.org"
+ },
+ "sameAs": "https://CRAN.R-project.org/package=huxtable"
+ },
+ {
+ "@type": "SoftwareApplication",
+ "identifier": "flextable",
+ "name": "flextable",
+ "provider": {
+ "@id": "https://cran.r-project.org",
+ "@type": "Organization",
+ "name": "Comprehensive R Archive Network (CRAN)",
+ "url": "https://cran.r-project.org"
+ },
+ "sameAs": "https://CRAN.R-project.org/package=flextable"
+ },
+ {
+ "@type": "SoftwareApplication",
+ "identifier": "Hmisc",
+ "name": "Hmisc",
+ "provider": {
+ "@id": "https://cran.r-project.org",
+ "@type": "Organization",
+ "name": "Comprehensive R Archive Network (CRAN)",
+ "url": "https://cran.r-project.org"
+ },
+ "sameAs": "https://CRAN.R-project.org/package=Hmisc"
}
],
"softwareRequirements": [
@@ -433,6 +469,18 @@
"url": "https://cran.r-project.org"
},
"sameAs": "https://CRAN.R-project.org/package=correlation"
+ },
+ {
+ "@type": "SoftwareApplication",
+ "identifier": "RVAideMemoire",
+ "name": "RVAideMemoire",
+ "provider": {
+ "@id": "https://cran.r-project.org",
+ "@type": "Organization",
+ "name": "Comprehensive R Archive Network (CRAN)",
+ "url": "https://cran.r-project.org"
+ },
+ "sameAs": "https://CRAN.R-project.org/package=RVAideMemoire"
}
],
"releaseNotes": "https://github.com/sbalci/ClinicoPathJamoviModule/blob/master/NEWS.md",
@@ -463,6 +511,6 @@
"survival-analysis",
"natural-language-summaries"
],
- "fileSize": "13471.052KB",
+ "fileSize": "16896.02KB",
"readme": "https://github.com/sbalci/ClinicoPathJamoviModule/blob/master/README.md"
}
diff --git a/docs/404.html b/docs/404.html
index a690413c..0e24a390 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -71,7 +71,7 @@
ClinicoPath
- 0.0.1.0010
+ 0.0.1.0012
@@ -108,6 +108,9 @@
Motivation
+
+ ClinicoPath Package Report, by pkgnet
+
diff --git a/docs/LICENSE.html b/docs/LICENSE.html
index 4e5cc732..406eebfc 100644
--- a/docs/LICENSE.html
+++ b/docs/LICENSE.html
@@ -71,7 +71,7 @@
ClinicoPath
- 0.0.1.0010
+ 0.0.1.0012
@@ -108,6 +108,9 @@
Motivation
+
+ ClinicoPath Package Report, by pkgnet
+
diff --git a/docs/articles/data-preperation.html b/docs/articles/data-preperation.html
index f59a7a9f..87c1b492 100644
--- a/docs/articles/data-preperation.html
+++ b/docs/articles/data-preperation.html
@@ -31,7 +31,7 @@
ClinicoPath
- 0.0.1.0010
+ 0.0.1.0012
@@ -68,6 +68,9 @@
Motivation
+
+ ClinicoPath Package Report, by pkgnet
+
@@ -134,6 +137,8 @@ Data Preperation for Clinicopathology Histopathology Pathology
#> Warning: replacing previous import 'dplyr::select' by 'jmvcore::select' when
#> loading 'ClinicoPath'
#> Warning: replacing previous import 'caret::cluster' by 'survival::cluster' when
+#> loading 'ClinicoPath'
+#> Warning: replacing previous import 'dplyr::add_row' by 'tangram::add_row' when
#> loading 'ClinicoPath'