From 26d0f9de5753b6e758a6fd1ee78dac27d1b16b08 Mon Sep 17 00:00:00 2001 From: Sebastian Jentschke Date: Tue, 9 Jul 2024 23:43:14 +0200 Subject: [PATCH] Added function Transform (Reduce Skewness) --- DESCRIPTION | 2 +- R/globals.R | 13 +- R/jttransformvars.b.R | 66 +++++++++ R/jttransformvars.h.R | 250 ++++++++++++++++++++++++++++++++++ jamovi/0000.yaml | 11 +- jamovi/jttransformvars.a.yaml | 86 ++++++++++++ jamovi/jttransformvars.r.yaml | 27 ++++ jamovi/jttransformvars.u.yaml | 67 +++++++++ 8 files changed, 516 insertions(+), 6 deletions(-) create mode 100644 R/jttransformvars.b.R create mode 100644 R/jttransformvars.h.R create mode 100644 jamovi/jttransformvars.a.yaml create mode 100644 jamovi/jttransformvars.r.yaml create mode 100644 jamovi/jttransformvars.u.yaml diff --git a/DESCRIPTION b/DESCRIPTION index 6ddc1bf..ca09010 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jTransform Title: "jTransform: Functions for Common Data Set Transformations" Type: Package -Version: 0.3.2 +Version: 0.3.3 Authors@R: c(person(given = "Sebastian", family = "Jentschke", role = c("aut", "cre"), email = "sebastian.jentschke@uib.no", comment = c(ORCID = "0000-0003-2576-5432")), person(given = "Marcello", family = "Gallucci", role = c("aut"), email = "mcfanda@gmail.com", comment = c(ORCID = "0000-0003-3546-0093"))) diff --git a/R/globals.R b/R/globals.R index c80a012..1058e7d 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,6 +1,6 @@ if (getRversion() >= "2.15.1") { utils::globalVariables(c("maxRow", "maxCol", "useIdx", "vldExt", "fmtVrI", "fmtAdC", "fmtAdR", "fmtFsC", "hlpCrt", "hlpArC", "hlpL2W", "hlpMrg", - "hlpRpl", "hlpSrc", "hlpSrt", "hlpXps", "hlpW2L", "genSep", "genNSS", "genNSA", "dtlSep", "dtlNSS", "dtlNSA")) + "hlpRpl", "hlpSrc", "hlpSrt", "hlpW2L", "hlpXfV", "hlpXps", "genSep", "genNSS", "genNSA", "dtlSep", "dtlNSS", "dtlNSA")) } # variable definitions @@ -44,9 +44,6 @@ hlpSrt <- paste("Please assign one or more variables to the variable box \"Var "variables appear in the variable box determines after which variable is sorted first (one could, e.g., first sort", "after gender and afterwards after age). Variables are sorted in \"Ascending\" order (as default), but you can change", "the order if desired.") -hlpXps <- paste("Please assign up to one variable to the variable box \"Column Names for the Output\" (this variable might contain names of trials", - "or questionnaire items). If you leave the box empty, generic variable names are generated (\"V_...\"). The variables to become rows", - "in your output data set have to be assigned to \"Variables To Be Transposed\".") hlpW2L <- paste("When transforming a data set from wide to long format, you first need determine how the name of the variables that you would like", "to transform is build up: It can either contain the different (e.g., experimental) conditions in the name and those conditions", "are separated by a specific character (e.g., \"cond1_condA_conda\" with \"_\" being that character) or the names either don't contain", @@ -54,6 +51,14 @@ hlpW2L <- paste("When transforming a data set from wide to long format, you fi "(simple)\" permit only one condition / index variable, \"Non-sep. (advanced)\" several conditions and target variables. More detailed", "instructions are given in the next paragraph and you can check using the two output tables (the first containing a data preview,", "the second an overview over how the repeated measurement levels - i.e., the original variables - were converted).") +hlpXfV <- c(paste("Please assign at least one variable to at least one of the variable boxes indicating what (approximate) degree (moderate, strong, extreme", + "and kind (postive or negative) of skewness this variable has. For moderately skewed variables, a square-root-transformation is used, for", + "strongly skewed variables, a logarithic transformation, and for severly skewed variables an inversion. If necessary, a constant is added", + "(automatically) in order to avoid the transformation returning NA-values."), + "NB: The transformations work only for numeric variables (integer or decimal); please adjust the measure / data type if necessary.") +hlpXps <- paste("Please assign up to one variable to the variable box \"Column Names for the Output\" (this variable might contain names of trials", + "or questionnaire items). If you leave the box empty, generic variable names are generated (\"V_...\"). The variables to become rows", + "in your output data set have to be assigned to \"Variables To Be Transposed\".") genSep <- c(paste("Please assign the variables that identify participant (or another measurement unit; e.g., a number or an ID) to \"Variables that", "Identify the Same Unit\", and those that are unique to an unit but not an identifier (e.g., gender, age group) to \"Variables NOT", "To Be Transformed\". If no variable that identifies a participant is given, such variable will be created (and named \"ID\"). Then", diff --git a/R/jttransformvars.b.R b/R/jttransformvars.b.R new file mode 100644 index 0000000..ef912e3 --- /dev/null +++ b/R/jttransformvars.b.R @@ -0,0 +1,66 @@ + +# This file is a generated template, your changes will not be overwritten + +jtTransformVarsClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( + "jtTransformVarsClass", + inherit = jtTransformVarsBase, + private = list( + .xfmDta = NULL, + .inpDta = NULL, + + .init = function() { + if (private$.chkVar()) { + private$.xfmDta <- do.call(jmvReadWrite::transform_vars_omv, private$.crrArg()) + # resize / prepare the output table (prpPvw in utils.R) + prpPvw(crrTbl = self$results$pvwDta, dtaFrm = private$.xfmDta, colFst = private$.colFst()) + } else { + # reset the output table (rstPvw in utils.R) + rstPvw(crrTbl = self$results$pvwDta) + } + }, + + .run = function() { + # check whether there are at least two variables in varOrd and that the data set has at least one row + if (private$.chkVar() && dim(self$data)[1] >= 1) { + # if “Create” was pressed (btnCrt == TRUE), open a new jamovi session with the data + if (self$options$btnCrt) { + do.call(jmvReadWrite::transform_vars_omv, private$.crrArg()[-2]) + # if not, show the variable list and how to use “Create” as general information + # and create a preview of the data (crtInf and fllPvw in utils.R) + } else { + crtInf(crrInf = self$results$genInf, dtaFrm = private$.xfmDta, hlpMsg = hlpCrt) + fllPvw(crrTbl = self$results$pvwDta, dtaFrm = private$.xfmDta) + } + } else { + # show getting started as general information (crtInf in utils.R) + crtInf(crrInf = self$results$genInf, hlpMsg = hlpXfV) + } + }, + + .chkVar = function() { + (length(self$options$posSqr) >= 1 || length(self$options$negSqr) >= 1 || + length(self$options$posLog) >= 1 || length(self$options$negLog) >= 1 || + length(self$options$posInv) >= 1 || length(self$options$negInv) >= 1) + }, + + .colFst = function() { + c(setdiff(names(private$.xfmDta), names(private$.inpDta)), names(private$.inpDta)) + }, + + .crrArg = function() { + if (!is.null(self$data) && dim(self$data)[1] > 0) private$.inpDta <- self$data else private$.inpDta <- self$readDataset() + crrXfm <- setNames(lapply(c("posSqr", "negSqr", "posLog", "negLog", "posInv", "negInv"), function(x) self$options[[x]]), + c("posSqr", "negSqr", "posLog", "negLog", "posInv", "negInv")) + list(dtaInp = private$.inpDta, fleOut = NULL, varXfm = crrXfm) + } + + ), + + public = list( + + asSource = function() { + if (private$.chkVar()) fmtSrc("jmvReadWrite::arrange_cols_omv", private$.crrArg()[c(-1, -2)]) + } + + ) +) diff --git a/R/jttransformvars.h.R b/R/jttransformvars.h.R new file mode 100644 index 0000000..cadffaf --- /dev/null +++ b/R/jttransformvars.h.R @@ -0,0 +1,250 @@ + +# This file is automatically generated, you probably don't want to edit this + +jtTransformVarsOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( + "jtTransformVarsOptions", + inherit = jmvcore::Options, + public = list( + initialize = function( + varAll = NULL, + posSqr = NULL, + negSqr = NULL, + posLog = NULL, + negLog = NULL, + posInv = NULL, + negInv = NULL, + btnCrt = FALSE, ...) { + + super$initialize( + package="jTransform", + name="jtTransformVars", + requiresData=TRUE, + ...) + + private$..varAll <- jmvcore::OptionVariables$new( + "varAll", + varAll, + hidden=TRUE, + permitted=list( + "numeric", + "factor", + "id"), + default=NULL) + private$..posSqr <- jmvcore::OptionVariables$new( + "posSqr", + posSqr, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..negSqr <- jmvcore::OptionVariables$new( + "negSqr", + negSqr, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..posLog <- jmvcore::OptionVariables$new( + "posLog", + posLog, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..negLog <- jmvcore::OptionVariables$new( + "negLog", + negLog, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..posInv <- jmvcore::OptionVariables$new( + "posInv", + posInv, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..negInv <- jmvcore::OptionVariables$new( + "negInv", + negInv, + suggested=list( + "continuous"), + permitted=list( + "numeric")) + private$..btnCrt <- jmvcore::OptionAction$new( + "btnCrt", + btnCrt, + default=FALSE) + + self$.addOption(private$..varAll) + self$.addOption(private$..posSqr) + self$.addOption(private$..negSqr) + self$.addOption(private$..posLog) + self$.addOption(private$..negLog) + self$.addOption(private$..posInv) + self$.addOption(private$..negInv) + self$.addOption(private$..btnCrt) + }), + active = list( + varAll = function() private$..varAll$value, + posSqr = function() private$..posSqr$value, + negSqr = function() private$..negSqr$value, + posLog = function() private$..posLog$value, + negLog = function() private$..negLog$value, + posInv = function() private$..posInv$value, + negInv = function() private$..negInv$value, + btnCrt = function() private$..btnCrt$value), + private = list( + ..varAll = NA, + ..posSqr = NA, + ..negSqr = NA, + ..posLog = NA, + ..negLog = NA, + ..posInv = NA, + ..negInv = NA, + ..btnCrt = NA) +) + +jtTransformVarsResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( + "jtTransformVarsResults", + inherit = jmvcore::Group, + active = list( + genInf = function() private$.items[["genInf"]], + pvwDta = function() private$.items[["pvwDta"]]), + private = list(), + public=list( + initialize=function(options) { + super$initialize( + options=options, + name="", + title="Transform (Reduce Skewness)") + self$add(jmvcore::Html$new( + options=options, + name="genInf", + clearWith=list( + "varOrd", + "blnAll", + "btnCrt"))) + self$add(jmvcore::Table$new( + options=options, + name="pvwDta", + title="Data Preview", + refs=list( + "jTransform", + "jmvReadWrite"), + clearWith=list( + "varOrd", + "blnAll"), + rows=1, + columns=list( + list( + `name`="fstCol", + `title`=""))))})) + +jtTransformVarsBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( + "jtTransformVarsBase", + inherit = jmvcore::Analysis, + public = list( + initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) { + super$initialize( + package = "jTransform", + name = "jtTransformVars", + version = c(1,0,0), + options = options, + results = jtTransformVarsResults$new(options=options), + data = data, + datasetId = datasetId, + analysisId = analysisId, + revision = revision, + pause = NULL, + completeWhenFilled = TRUE, + requiresMissings = FALSE, + weightsSupport = 'auto') + })) + +#' Transform (Reduce Skewness) +#' +#' Create New (Computed) Variables, Aiming At Reducing Deviations From A +#' Normal Distribution +#' +#' @examples +#' \donttest{ +#' # the function is a wrapper for jmvReadWrite::transform_vars_omv +#' # please use that function when in R (or in Rj) +#' # for more information: https://sjentsch.github.io/jmvReadWrite +#'} +#' @param data . +#' @param varAll . +#' @param posSqr . +#' @param negSqr . +#' @param posLog . +#' @param negLog . +#' @param posInv . +#' @param negInv . +#' @param btnCrt . +#' @return A results object containing: +#' \tabular{llllll}{ +#' \code{results$genInf} \tab \tab \tab \tab \tab a html \cr +#' \code{results$pvwDta} \tab \tab \tab \tab \tab a table \cr +#' } +#' +#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example: +#' +#' \code{results$pvwDta$asDF} +#' +#' \code{as.data.frame(results$pvwDta)} +#' +#' @export +jtTransformVars <- function( + data, + varAll = NULL, + posSqr, + negSqr, + posLog, + negLog, + posInv, + negInv, + btnCrt = FALSE) { + + if ( ! requireNamespace("jmvcore", quietly=TRUE)) + stop("jtTransformVars requires jmvcore to be installed (restart may be required)") + + if ( ! missing(varAll)) varAll <- jmvcore::resolveQuo(jmvcore::enquo(varAll)) + if ( ! missing(posSqr)) posSqr <- jmvcore::resolveQuo(jmvcore::enquo(posSqr)) + if ( ! missing(negSqr)) negSqr <- jmvcore::resolveQuo(jmvcore::enquo(negSqr)) + if ( ! missing(posLog)) posLog <- jmvcore::resolveQuo(jmvcore::enquo(posLog)) + if ( ! missing(negLog)) negLog <- jmvcore::resolveQuo(jmvcore::enquo(negLog)) + if ( ! missing(posInv)) posInv <- jmvcore::resolveQuo(jmvcore::enquo(posInv)) + if ( ! missing(negInv)) negInv <- jmvcore::resolveQuo(jmvcore::enquo(negInv)) + if (missing(data)) + data <- jmvcore::marshalData( + parent.frame(), + `if`( ! missing(varAll), varAll, NULL), + `if`( ! missing(posSqr), posSqr, NULL), + `if`( ! missing(negSqr), negSqr, NULL), + `if`( ! missing(posLog), posLog, NULL), + `if`( ! missing(negLog), negLog, NULL), + `if`( ! missing(posInv), posInv, NULL), + `if`( ! missing(negInv), negInv, NULL)) + + + options <- jtTransformVarsOptions$new( + varAll = varAll, + posSqr = posSqr, + negSqr = negSqr, + posLog = posLog, + negLog = negLog, + posInv = posInv, + negInv = negInv, + btnCrt = btnCrt) + + analysis <- jtTransformVarsClass$new( + options = options, + data = data) + + analysis$run() + + analysis$results +} + diff --git a/jamovi/0000.yaml b/jamovi/0000.yaml index cb251ce..823100d 100644 --- a/jamovi/0000.yaml +++ b/jamovi/0000.yaml @@ -1,7 +1,7 @@ --- title: 'jTransform: Functions for Common Data Set Transformations' name: jTransform -version: 0.3.2 +version: 0.3.3 jms: '1.0' authors: - Sebastian Jentschke @@ -74,6 +74,15 @@ analyses: menuSubgroup: jTransform menuTitle: Merge (Add Columns) description: Add Columns (From Other Data Sets) + - title: Transform (Reduce Skewness) + name: jtTransformVars + ns: jTransform + menuGroup: Data + menuSubgroup: jTransform + menuTitle: Transform (Reduce Skewness) + description: >- + Create New (Computed) Variables, Aiming At Reducing Deviations From A + Normal Distribution datasets: - name: example4jtTranspose path: example4jtTranspose.omv diff --git a/jamovi/jttransformvars.a.yaml b/jamovi/jttransformvars.a.yaml new file mode 100644 index 0000000..49f6543 --- /dev/null +++ b/jamovi/jttransformvars.a.yaml @@ -0,0 +1,86 @@ +--- +name: jtTransformVars +title: Transform (Reduce Skewness) +menuGroup: Data +menuSubgroup: jTransform +version: '1.0.0' +jas: '1.2' + +description: + main: Create New (Computed) Variables, Aiming At Reducing Deviations From A Normal Distribution + R: + dontrun: true + usage: | + # the function is a wrapper for jmvReadWrite::transform_vars_omv + # please use that function when in R (or in Rj) + # for more information: https://sjentsch.github.io/jmvReadWrite + +completeWhenFilled: true + +options: + - name: data + type: Data + + - name: varAll + type: Variables + hidden: true + permitted: + - numeric + - factor + - id + default: + + - name: posSqr + title: Moderate positive skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: negSqr + title: Moderate negative skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: posLog + title: Strong positive skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: negLog + title: Strong negative skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: posInv + title: Extreme positive skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: negInv + title: Extreme negative skewness + type: Variables + suggested: + - continuous + permitted: + - numeric + + - name: btnCrt + type: Action + title: Create + default: false + +... diff --git a/jamovi/jttransformvars.r.yaml b/jamovi/jttransformvars.r.yaml new file mode 100644 index 0000000..462a126 --- /dev/null +++ b/jamovi/jttransformvars.r.yaml @@ -0,0 +1,27 @@ +--- +name: jtTransformVars +title: Transform (Reduce Skewness) +jrs: '1.1' + +items: + - name: genInf + type: Html + clearWith: [ varOrd, blnAll, btnCrt ] + + - name: pvwDta + type: Table + title: "Data Preview" + refs: [ jTransform, jmvReadWrite ] + clearWith: [ varOrd, blnAll ] + rows: 1 + columns: + - name: fstCol + title: "" + +# take away btnCrt from genInf once Actions is working +# - name: opnDta +# type: Actions +# Table,Group,Array,Image,Preformatted,Html,State,Property,Output +# clearWith: [ btnCrt ] + +... diff --git a/jamovi/jttransformvars.u.yaml b/jamovi/jttransformvars.u.yaml new file mode 100644 index 0000000..fb25472 --- /dev/null +++ b/jamovi/jttransformvars.u.yaml @@ -0,0 +1,67 @@ +title: Transform (Reduce Skewness) +name: jtTransformVars +jus: '3.0' +stage: 0 +compilerMode: tame + +events: + loaded: './varAll::loaded' + remoteDataChanged: './varAll::dataChanged' + +children: + - type: VariableSupplier + permitted: + - numeric + persistentItems: true + stretchFactor: 1 + children: + - type: TargetLayoutBox + label: Moderate positive skewness + children: + - type: VariablesListBox + name: posSqr + height: smallest + isTarget: true + - type: TargetLayoutBox + label: Moderate negative skewness + children: + - type: VariablesListBox + name: negSqr + height: smallest + isTarget: true + - type: TargetLayoutBox + label: Strong positive skewness + children: + - type: VariablesListBox + name: posLog + height: smallest + isTarget: true + - type: TargetLayoutBox + label: Strong negative skewness + children: + - type: VariablesListBox + name: negLog + height: smallest + isTarget: true + - type: TargetLayoutBox + label: Extreme positive skewness + children: + - type: VariablesListBox + name: posInv + height: smallest + isTarget: true + - type: TargetLayoutBox + label: Extreme negative skewness + children: + - type: VariablesListBox + name: negInv + height: smallest + isTarget: true + + - type: LayoutBox + style: inline + margin: large + horizontalAlignment: right + children: + - type: ActionButton + name: btnCrt