Skip to content

Commit

Permalink
update
Browse files Browse the repository at this point in the history
  • Loading branch information
@sbalci
sbalci committed Dec 6, 2023
1 parent 61a3c90 commit db8c8d0
Show file tree
Hide file tree
Showing 18 changed files with 443 additions and 85 deletions.
9 changes: 5 additions & 4 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Type: Package
Package: ClinicoPathDescriptives
Title: Descriptives Functions for Clinicopathological Research
Version: 0.0.2.07
Date: 2023-07-02
Version: 0.0.2.08
Date: 2023-12-06
Authors@R:
person(given = "Serdar",
family = "Balci",
Expand All @@ -23,7 +23,7 @@ BugReports:
https://github.com/sbalci/ClinicoPathJamoviModule/issues/
License: GPL-3
Depends:
R (>= 4.0.0)
R (>= 4.1.0)
Imports:
dplyr,
magrittr,
Expand All @@ -48,7 +48,8 @@ Imports:
DiagrammeRsvg,
rsvg,
shiny,
gtsummary
gtsummary,
gtExtras
Remotes:
nbarrowman/vtree@ffa53d4ea5050fa9b26918f4bb30595e91a0f489
Encoding: UTF-8
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,5 +13,6 @@ import(ggplot2)
import(jmvcore)
importFrom(R6,R6Class)
importFrom(dplyr,inner_join)
importFrom(gtExtras,gt_plt_summary)
importFrom(jmvcore,toNumeric)
importFrom(magrittr,"%>%")
205 changes: 171 additions & 34 deletions R/crosstable.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,96 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
"crosstableClass",
inherit = crosstableBase,
private = list(


# labelData ----

.labelData = function() {


# Prepare data for analysis
mydata <- self$data

## Get rownames to data
# mydata$rownames <- rownames(mydata)

## Correct variable names and labels
# Get original variable names
original_names <- names(mydata)

# Save original names as a named vector where the names are the original names,
# and the values are the labels you want to set, which are also the original names.
labels <- setNames(original_names, original_names)

# Clean variable names
mydata <- mydata %>% janitor::clean_names()

# Now apply the labels to the cleaned names.
# Since the variable names have been cleaned, you must match the labels to the cleaned names.
# The labels vector should have names that are the cleaned names and values that are the original names.
corrected_labels <-
setNames(original_names, names(mydata))

# Apply the corrected labels
mydata <- labelled::set_variable_labels(.data = mydata,
.labels = corrected_labels)

# Retrieve all variable labels
all_labels <- labelled::var_label(mydata)

# # Retrieve the variable name from the label
# # Tek değişken için
# dependent_variable_name_from_label <-
# names(all_labels)[all_labels == self$options$outcome]
#
# # Retrieve the variable names vector from the label vector
# # Birden fazla değişkenler için
# labels <- self$options$explanatory
#
# explanatory_variable_names <-
# names(all_labels)[match(labels, all_labels)]


myvars <- self$options$vars
myvars <-
names(all_labels)[match(myvars, all_labels)]


mygroup <-
names(all_labels)[all_labels == self$options$group]


return(list(
"mydata" = mydata
, "myvars" = myvars
, "mygroup" = mygroup
))


}
,























.run = function() {

Expand Down Expand Up @@ -64,22 +154,62 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(

if (nrow(self$data) == 0) stop("Data contains no (complete) rows")





# Read Labelled Data ----

cleaneddata <- private$.labelData()

mydata <- cleaneddata$mydata
myvars <- cleaneddata$myvars
mygroup <- cleaneddata$mygroup



# Prepare Data ----

mydata <- self$data
# mydata <- self$data

# formulaR <- jmvcore::constructFormula(terms = self$options$vars)
# formulaL <- jmvcore::constructFormula(terms = self$options$group)

formula <- jmvcore::constructFormula(
terms = self$options$vars,
dep = self$options$group)
terms = myvars, #self$options$vars,
dep = mygroup #self$options$group
)


# formula <- paste(formulaL, '~', formulaR)
formula <- as.formula(formula)


# self$results$r_cleaneddata$setContent(
# list(
# "mydata" = head(mydata)
# , "myvars" = myvars
# , "mygroup" = mygroup
# , "formula" = formula
# , "names" = names(mydata)
# , "mygroup2" = mydata[[mygroup]][1:10]
#
# ))
















# Exclude NA ----

Expand Down Expand Up @@ -134,7 +264,8 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
# https://finalfit.org/reference/summary_factorlist.html


myvars <- jmvcore::composeTerm(components = self$options$vars)
myvars <- jmvcore::composeTerm(components = myvars #self$options$vars
)

myvars <- jmvcore::decomposeTerm(term = myvars)

Expand All @@ -144,7 +275,7 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
mydata %>%
finalfit::summary_factorlist(
.data = .,
dependent = self$options$group,
dependent = mygroup, #self$options$group,
explanatory = myvars,
total_col = TRUE,
p = TRUE,
Expand Down Expand Up @@ -223,34 +354,39 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(

tablegtsummary <-
gtsummary::tbl_summary(data = mydata,
by = self$options$group,
statistic = list(
gtsummary::all_continuous() ~ "{mean} ({sd})",
gtsummary::all_categorical() ~ "{n} / {N} ({p}%)"
),
digits = gtsummary::all_continuous() ~ 2,
missing_text = "(Missing)"

) %>%
gtsummary::modify_header(
update = gtsummary::all_stat_cols() ~ structure("**{level}** N = {n} ({style_percent(p)}%)", class = "from_markdown")
# stat_by =
# gt::md("**{level}** N = {n} ({style_percent(p)}%)")
) %>%
gtsummary::add_n(x = .) %>%
gtsummary::add_overall() %>%
gtsummary::bold_labels(x = .) %>%
gtsummary::add_p(x = .,
pvalue_fun =
purrr::partial(
gtsummary::style_pvalue,
digits = 2)
) %>%
gtsummary::add_q()
# %>%
# gtsummary::bold_labels() %>%
# gtsummary::bold_levels() %>%
# gtsummary::bold_p()
by = mygroup
)



# , #self$options$group,
# statistic = list(
# gtsummary::all_continuous() ~ "{mean} ({sd})",
# gtsummary::all_categorical() ~ "{n} / {N} ({p}%)"
# ),
# digits = gtsummary::all_continuous() ~ 2,
# missing_text = "(Missing)"
#
# ) %>%
# gtsummary::modify_header(
# update = gtsummary::all_stat_cols() ~ structure("**{level}** N = {n} ({style_percent(p)}%)", class = "from_markdown")
# # stat_by =
# # gt::md("**{level}** N = {n} ({style_percent(p)}%)")
# ) %>%
# gtsummary::add_n(x = .) %>%
# gtsummary::add_overall() %>%
# gtsummary::bold_labels(x = .) %>%
# gtsummary::add_p(x = .,
# pvalue_fun =
# purrr::partial(
# gtsummary::style_pvalue,
# digits = 2)
# ) %>%
# gtsummary::add_q()
# # %>%
# # gtsummary::bold_labels() %>%
# # gtsummary::bold_levels() %>%
# # gtsummary::bold_p()


tablegtsummary <-
Expand Down Expand Up @@ -283,7 +419,8 @@ crosstableClass <- if (requireNamespace('jmvcore')) R6::R6Class(
style = sty,
caption = paste0(
"Cross Table for Dependent ",
self$options$group),
mygroup #self$options$group
),
id = "tbl3")

self$results$tablestyle4$setContent(tabletangram)
Expand Down
12 changes: 11 additions & 1 deletion R/reportcat.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
#' @importFrom R6 R6Class
#' @import jmvcore
#' @importFrom magrittr %>%
#' @importFrom gtExtras gt_plt_summary
#'

reportcatClass <- if (requireNamespace('jmvcore')) R6::R6Class(
Expand Down Expand Up @@ -188,8 +189,17 @@ reportcatClass <- if (requireNamespace('jmvcore')) R6::R6Class(



plot_mydata <- mydata %>%
gtExtras::gt_plt_summary()

print_plot_mydata <- print(plot_mydata)

plot_mydata <- htmltools::HTML(print_plot_mydata[["children"]][[2]])

})
self$results$text1$setContent(plot_mydata)

}


)
)
11 changes: 9 additions & 2 deletions R/reportcat.h.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,8 @@ reportcatResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
inherit = jmvcore::Group,
active = list(
todo = function() private$.items[["todo"]],
text = function() private$.items[["text"]]),
text = function() private$.items[["text"]],
text1 = function() private$.items[["text1"]]),
private = list(),
public=list(
initialize=function(options) {
Expand All @@ -46,6 +47,7 @@ reportcatResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
title="Summary of Categorical Variables",
refs=list(
"report",
"gtExtras",
"ClinicoPathJamoviModule"))
self$add(jmvcore::Html$new(
options=options,
Expand All @@ -56,7 +58,11 @@ reportcatResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
self$add(jmvcore::Preformatted$new(
options=options,
name="text",
title=""))}))
title=""))
self$add(jmvcore::Html$new(
options=options,
name="text1",
title="Categorical Data"))}))

reportcatBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"reportcatBase",
Expand Down Expand Up @@ -94,6 +100,7 @@ reportcatBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
#' \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$text1} \tab \tab \tab \tab \tab a html \cr
#' }
#'
#' @export
Expand Down
21 changes: 21 additions & 0 deletions R/summarydata.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
#'
#' @importFrom R6 R6Class
#' @import jmvcore
#' @importFrom magrittr %>%
#' @importFrom gtExtras gt_plt_summary
#'

summarydataClass <- if (requireNamespace("jmvcore")) R6::R6Class("summarydataClass",
Expand Down Expand Up @@ -110,6 +112,25 @@ summarydataClass <- if (requireNamespace("jmvcore")) R6::R6Class("summarydataCla
self$results$text$setContent(results)





plot_mydata <- mydata %>%
gtExtras::gt_plt_summary()


print_plot_mydata <- print(plot_mydata)

plot_mydata <- htmltools::HTML(print_plot_mydata[["children"]][[2]])

self$results$text1$setContent(plot_mydata)







}


Expand Down
Loading

0 comments on commit db8c8d0

Please sign in to comment.