Skip to content

Commit

Permalink
Added function Transform (Reduce Skewness)
Browse files Browse the repository at this point in the history
  • Loading branch information
sjentsch committed Jul 9, 2024
1 parent 310ea63 commit 26d0f9d
Show file tree
Hide file tree
Showing 8 changed files with 516 additions and 6 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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")))
Expand Down
13 changes: 9 additions & 4 deletions R/globals.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -44,16 +44,21 @@ 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",
"all conditions or no separating character. Depending on the structure of the variable names, choose one of the tabs (\"Non-sep.",
"(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",
Expand Down
66 changes: 66 additions & 0 deletions R/jttransformvars.b.R
Original file line number Diff line number Diff line change
@@ -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)])
}

)
)
250 changes: 250 additions & 0 deletions R/jttransformvars.h.R
Original file line number Diff line number Diff line change
@@ -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
}

11 changes: 10 additions & 1 deletion jamovi/0000.yaml
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 26d0f9d

Please sign in to comment.