From d7dfb7270f357fa6116b60509721e1490f8d4611 Mon Sep 17 00:00:00 2001 From: sbalci Date: Wed, 6 Dec 2023 22:05:10 +0300 Subject: [PATCH] update cross tables with labelledData function --- R/crosstable.b.R | 205 ++++++++++++++++++++++++++++++++------- R/vartree.b.R | 135 +++++++++++++++++++++++--- jamovi/crosstable.r.yaml | 9 ++ jamovi/vartree.r.yaml | 4 +- 4 files changed, 305 insertions(+), 48 deletions(-) diff --git a/R/crosstable.b.R b/R/crosstable.b.R index a653d7bd..a71a9663 100644 --- a/R/crosstable.b.R +++ b/R/crosstable.b.R @@ -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() { @@ -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 ---- @@ -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) @@ -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, @@ -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 <- @@ -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) diff --git a/R/vartree.b.R b/R/vartree.b.R index 906ae208..7a52565a 100644 --- a/R/vartree.b.R +++ b/R/vartree.b.R @@ -19,6 +19,86 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( # , + # 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)] + + + percvar <- + names(all_labels)[all_labels == self$options$percvar] + + summaryvar <- + names(all_labels)[all_labels == self$options$summaryvar] + + follow <- + names(all_labels)[all_labels == self$options$follow] + + prunebelow <- + names(all_labels)[all_labels == self$options$prunebelow] + + + + return(list( + "mydata" = mydata + , "myvars" = myvars + , "percvar" = percvar + , "summaryvar" = summaryvar + , "follow" = follow + , "prunebelow" = prunebelow + + )) + + + } + , @@ -47,18 +127,39 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( if (nrow(self$data) == 0) stop("Data contains no (complete) rows") - # Read Data ---- + # Read Labelled Data ---- + + cleaneddata <- private$.labelData() + + mydata <- cleaneddata$mydata + myvars <- cleaneddata$myvars + percvar <- cleaneddata$percvar + summaryvar <- cleaneddata$summaryvar + + # self$results$r_cleaneddata$setContent(cleaneddata) + + + # formulaDependent <- jmvcore::constructFormula(terms = dependent_variable_name_from_label) + + # formulaExplanatory <- jmvcore::composeTerms(listOfComponents = explanatory_variable_names) + + + + # Read Labelled Variables ---- + + + # myvars <- self$options$vars + # percvar <- self$options$percvar + # summaryvar <- self$options$summaryvar + - mydata <- self$data # Read Arguments ---- horizontal <- self$options$horizontal sline <- self$options$sline mytitle <- self$options$mytitle - myvars <- self$options$vars - percvar <- self$options$percvar - summaryvar <- self$options$summaryvar + # Default Arguments ---- @@ -156,13 +257,15 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( # Prepare Formula ---- - formula <- jmvcore::constructFormula(terms = self$options$vars) + # formula <- jmvcore::constructFormula(terms = self$options$vars) - myvars1 <- jmvcore::decomposeFormula(formula = formula) + # myvars1 <- jmvcore::decomposeFormula(formula = formula) - myvars1 <- unlist(myvars1) + # myvars1 <- unlist(myvars1) - myvars1 <- paste0(myvars1, collapse = " ") + # myvars1 <- paste0(myvars1, collapse = " ") + + myvars1 <- myvars # myvars2 <- self$options$vars @@ -172,7 +275,7 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( # Percentage Variable ---- if ( !is.null(self$options$percvar) ) { - percvar <- self$options$percvar + # percvar <- self$options$percvar xsummary <- paste0(percvar,"=", self$options$percvarLevel #, "\n%pct%" ) @@ -187,7 +290,7 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( # Continuous Variable for Summaries ---- if ( !is.null(self$options$summaryvar) ) { - summaryvar <- self$options$summaryvar + # summaryvar <- self$options$summaryvar summarylocation <- self$options$summarylocation @@ -214,7 +317,11 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( if ( !is.null(self$options$prunebelow) ) { - prunebelow <- self$options$prunebelow + # prunebelow <- self$options$prunebelow + + prunebelow <- cleaneddata$prunebelow + + prunebelow <- jmvcore::composeTerm(prunebelow) pruneLevel1 <- self$options$pruneLevel1 @@ -232,7 +339,9 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class( if ( !is.null(self$options$follow) ) { - follow <- self$options$follow + follow <- cleaneddata$follow + + # follow <- self$options$follow follow <- jmvcore::composeTerm(follow) followLevel1 <- self$options$followLevel1 diff --git a/jamovi/crosstable.r.yaml b/jamovi/crosstable.r.yaml index e3bc5962..e3c23a01 100644 --- a/jamovi/crosstable.r.yaml +++ b/jamovi/crosstable.r.yaml @@ -21,6 +21,15 @@ items: - sty + # - name: r_cleaneddata + # title: Cleaned Data + # type: Preformatted + # clearWith: + # - vars + # - group + # - sty + + # - name: tablearsenal_output # title: tablearsenal_output # type: Html diff --git a/jamovi/vartree.r.yaml b/jamovi/vartree.r.yaml index 04a2e32e..ca4e6a5d 100644 --- a/jamovi/vartree.r.yaml +++ b/jamovi/vartree.r.yaml @@ -19,7 +19,9 @@ items: # title: "Deneme" # type: Html - + # - name: r_cleaneddata + # title: Cleaned Data + # type: Preformatted - name: text2 title: Pattern Table