From bd58ee4380f7206b3f7589d79463a5116d588616 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 31 May 2023 18:28:17 +0200 Subject: [PATCH 01/22] implement jaspScale --- DESCRIPTION | 2 ++ NAMESPACE | 18 ++++++++++ R/column-types.R | 81 +++++++++++++++++++++++++++++++++++++++++++++ man/column-types.Rd | 21 ++++++++++++ 4 files changed, 122 insertions(+) create mode 100644 R/column-types.R create mode 100644 man/column-types.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 8bd657d..8e4116e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,6 +24,7 @@ Imports: officer, pkgbuild, plyr, + pillar, qgraph, ragg, R6, @@ -34,6 +35,7 @@ Imports: rvg, svglite, systemfonts, + vctrs, withr Remotes: jasp-stats/jaspGraphs diff --git a/NAMESPACE b/NAMESPACE index dd2be29..4daee29 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ S3method(decodeplot,jaspGraphsPlot) S3method(decodeplot,patchwork) S3method(decodeplot,qgraph) S3method(decodeplot,recordedplot) +S3method(format,jaspScale) S3method(gsubInteractionSymbol,character) S3method(gsubInteractionSymbol,list) S3method(ifElse,character) @@ -30,6 +31,17 @@ S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) +S3method(vec_cast,double.jaspScale) +S3method(vec_cast,integer.jaspScale) +S3method(vec_cast,jaspScale.double) +S3method(vec_cast,jaspScale.integer) +S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_ptype2,double.jaspScale) +S3method(vec_ptype2,integer.jaspScale) +S3method(vec_ptype2,jaspScale.double) +S3method(vec_ptype2,jaspScale.integer) +S3method(vec_ptype2,jaspScale.jaspScale) +S3method(vec_ptype_abbr,jaspScale) S3method(zScores,factor) S3method(zScores,numeric) export("%setOrRetrieve%") @@ -60,6 +72,7 @@ export(VovkSellkeMPR) export(VovkSellkeMPROneSided) export(YeoJohnson) export(addRenvBeforeAfterDispatch) +export(asJaspScale) export(assignFunctionInPackage) export(betaDist) export(binomDist) @@ -92,6 +105,7 @@ export(interactionSymbol) export(invBoxCox) export(invFishZ) export(invLogit) +export(isJaspScale) export(isRecomputed) export(isTryError) export(jaspColumnR) @@ -100,6 +114,7 @@ export(jaspFormula) export(jaspFormulaRhs) export(jaspQmlSourceR) export(jaspResultsCalledFromJasp) +export(jaspScale) export(logNormDist) export(logit) export(makeJaspFormula) @@ -122,4 +137,7 @@ export(v) export(weibullDist) export(zScores) importFrom(stats,na.omit) +importFrom(vctrs,vec_cast) +importFrom(vctrs,vec_ptype2) +importFrom(vctrs,vec_ptype_abbr) useDynLib(jaspBase, .registration=TRUE) diff --git a/R/column-types.R b/R/column-types.R new file mode 100644 index 0000000..b5246ba --- /dev/null +++ b/R/column-types.R @@ -0,0 +1,81 @@ +#' @name column-types +#' @rdname column-types +#' @importFrom vctrs vec_ptype2 vec_cast vec_ptype_abbr +#' @title JASP Column Types +#' +#' @description Columns types in JASP. +#' @param x the main object for which the operation is done +NULL + + +# jaspScale ----- +newJaspScale <- function(x = double()) { + if (!rlang::is_double(x)) { + rlang::abort("`x` must be a double vector.") + } + vctrs::new_vctr(x, class = "jaspScale") +} + + +#' @rdname column-types +#' @export +jaspScale <- function(x = double()) { + x <- vctrs::vec_cast(x, double()) + newJaspScale(x) +} + +#' @rdname column-types +#' @export +isJaspScale <- function(x) { + inherits(x, "jaspScale") +} + +#' @export +vec_ptype_abbr.jaspScale <- function(x, ...) { + return("jspScl") +} + +#' @export +format.jaspScale <- function(x, ...) { + x <- vctrs::vec_data(x) + miss <- is.na(x) + infty <- is.infinite(x) + valid <- !miss# & !infty + + out <- rep(NA_character_, vctrs::vec_size(x)) + out[valid] <- format(x[valid], ...) + #out[miss] <- NA + out[infty] <- ifelse(x[infty] > 0, "\u221E", "-\u221E") + + return(out) +} + +#' @rdname column-types +#' @export +asJaspScale <- function(x, ...) { + vctrs::vec_cast(x, newJaspScale()) +} + +## Coercion +#' @export +vec_ptype2.jaspScale.jaspScale <- function(x, y, ...) newJaspScale() +#' @export +vec_ptype2.jaspScale.double <- function(x, y, ...) numeric() +#' @export +vec_ptype2.double.jaspScale <- function(x, y, ...) numeric() +#' @export +vec_ptype2.jaspScale.integer <- function(x, y, ...) numeric() +#' @export +vec_ptype2.integer.jaspScale <- function(x, y, ...) numeric() + +## Casting +#' @export +vec_cast.jaspScale.jaspScale <- function(x, to, ...) x +#' @export +vec_cast.jaspScale.double <- function(x, to, ...) jaspScale(x) +#' @export +vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +#' @export +vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) +#' @export +vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() diff --git a/man/column-types.Rd b/man/column-types.Rd new file mode 100644 index 0000000..b0d3425 --- /dev/null +++ b/man/column-types.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/column-types.R +\name{column-types} +\alias{column-types} +\alias{jaspScale} +\alias{isJaspScale} +\alias{asJaspScale} +\title{JASP Column Types} +\usage{ +jaspScale(x = double()) + +isJaspScale(x) + +asJaspScale(x, ...) +} +\arguments{ +\item{x}{the main object for which the operation is done} +} +\description{ +Columns types in JASP. +} From 9edc43809ef9e654e72b503917bc5b3c3c917300 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 31 May 2023 21:56:01 +0200 Subject: [PATCH 02/22] implement jaspOrdinal --- NAMESPACE | 17 ++++++++ R/column-types.R | 96 ++++++++++++++++++++++++++++++++++++++++++++- man/column-types.Rd | 9 +++++ 3 files changed, 121 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 4daee29..fd1d016 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ S3method(decodeplot,jaspGraphsPlot) S3method(decodeplot,patchwork) S3method(decodeplot,qgraph) S3method(decodeplot,recordedplot) +S3method(format,jaspOrdinal) S3method(format,jaspScale) S3method(gsubInteractionSymbol,character) S3method(gsubInteractionSymbol,list) @@ -26,21 +27,33 @@ S3method(ifElse,factor) S3method(ifElse,integer) S3method(ifElse,numeric) S3method(ifElse,ordered) +S3method(obj_print_footer,jaspOrdinal) S3method(print,jaspObjR) S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) +S3method(vec_cast,double.jaspOrdinal) S3method(vec_cast,double.jaspScale) +S3method(vec_cast,integer.jaspOrdinal) S3method(vec_cast,integer.jaspScale) +S3method(vec_cast,jaspOrdinal.double) +S3method(vec_cast,jaspOrdinal.integer) +S3method(vec_cast,jaspOrdinal.jaspOrdinal) S3method(vec_cast,jaspScale.double) S3method(vec_cast,jaspScale.integer) S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_ptype2,double.jaspOrdinal) S3method(vec_ptype2,double.jaspScale) +S3method(vec_ptype2,integer.jaspOrdinal) S3method(vec_ptype2,integer.jaspScale) +S3method(vec_ptype2,jaspOrdinal.double) +S3method(vec_ptype2,jaspOrdinal.integer) +S3method(vec_ptype2,jaspOrdinal.jaspOrdinal) S3method(vec_ptype2,jaspScale.double) S3method(vec_ptype2,jaspScale.integer) S3method(vec_ptype2,jaspScale.jaspScale) +S3method(vec_ptype_abbr,jaspOrdinal) S3method(vec_ptype_abbr,jaspScale) S3method(zScores,factor) S3method(zScores,numeric) @@ -72,6 +85,7 @@ export(VovkSellkeMPR) export(VovkSellkeMPROneSided) export(YeoJohnson) export(addRenvBeforeAfterDispatch) +export(asJaspOrdinal) export(asJaspScale) export(assignFunctionInPackage) export(betaDist) @@ -105,6 +119,7 @@ export(interactionSymbol) export(invBoxCox) export(invFishZ) export(invLogit) +export(isJaspOrdinal) export(isJaspScale) export(isRecomputed) export(isTryError) @@ -112,6 +127,7 @@ export(jaspColumnR) export(jaspDeps) export(jaspFormula) export(jaspFormulaRhs) +export(jaspOrdinal) export(jaspQmlSourceR) export(jaspResultsCalledFromJasp) export(jaspScale) @@ -137,6 +153,7 @@ export(v) export(weibullDist) export(zScores) importFrom(stats,na.omit) +importFrom(vctrs,obj_print_footer) importFrom(vctrs,vec_cast) importFrom(vctrs,vec_ptype2) importFrom(vctrs,vec_ptype_abbr) diff --git a/R/column-types.R b/R/column-types.R index b5246ba..58ab382 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -1,6 +1,6 @@ #' @name column-types #' @rdname column-types -#' @importFrom vctrs vec_ptype2 vec_cast vec_ptype_abbr +#' @importFrom vctrs vec_ptype2 vec_cast vec_ptype_abbr obj_print_footer #' @title JASP Column Types #' #' @description Columns types in JASP. @@ -79,3 +79,97 @@ vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.doubl vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) #' @export vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() + + +newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { + if (!rlang::is_integer(x) || !rlang::is_integer(values) || !rlang::is_character(labels)) { + rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") + } + + if (!all(x %in% values)) { + rlang::abort("`values` must be a superset of `x`.") + } + + if (length(values) != length(labels)) { + rlangs::abort("`values` and `labels` must be of equal length.") + } + + vctrs::new_vctr(x, values = values, labels = labels, class = "jaspOrdinal") +} + +#' @rdname column-types +#' @export +jaspOrdinal <- function(x = integer(), values = sort(unique(x)), labels = values) { + x <- vctrs::vec_cast(x, integer()) + values <- vctrs::vec_cast(values, integer()) + labels <- as.character(labels) + + newJaspOrdinal(x, values, labels) +} + +#' @rdname column-types +#' @export +isJaspOrdinal <- function(x) { + inherits(x, "jaspOrdinal") +} + +#' @export +vec_ptype_abbr.jaspOrdinal <- function(x, ...) { + return("jspOrd") +} + +#' @export +format.jaspOrdinal <- function(x, ...) { + values <- attr(x, "values") + labels <- attr(x, "labels") + x <- vctrs::vec_data(x) + + + valid <- !is.na(x) + + out <- rep(NA_character_, vctrs::vec_size(x)) + out[valid] <- sprintf("%s(%i)", labels[values[x[valid]]], x[valid]) + + return(out) +} + +#' @export +obj_print_footer.jaspOrdinal <- function(x, ...) { + val <- attr(x, "values") + lab <- attr(x, "labels") + + out <- paste(sprintf("%s(%i)", lab, val), collapse = " < ") + cat("Labels(Values):", out) +} + +#' @rdname column-types +#' @export +asJaspOrdinal <- function(x, ...) { + vctrs::vec_cast(x, newJaspOrdinal()) +} + + + +## Coercion +#' @export +vec_ptype2.jaspOrdinal.jaspOrdinal <- function(x, y, ...) newJaspOrdinal() +#' @export +vec_ptype2.jaspOrdinal.double <- function(x, y, ...) numeric() +#' @export +vec_ptype2.double.jaspOrdinal <- function(x, y, ...) numeric() +#' @export +vec_ptype2.jaspOrdinal.integer <- function(x, y, ...) numeric() +#' @export +vec_ptype2.integer.jaspOrdinal <- function(x, y, ...) numeric() + +## Casting +#' @export +vec_cast.jaspOrdinal.jaspOrdinal <- function(x, to, ...) x +#' @export +vec_cast.jaspOrdinal.double <- function(x, to, ...) jaspOrdinal(x, ...) +#' @export +vec_cast.double.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +#' @export +vec_cast.jaspOrdinal.integer <- function(x, to, ...) jaspOrdinal(x, ...) +#' @export +vec_cast.integer.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() diff --git a/man/column-types.Rd b/man/column-types.Rd index b0d3425..a3d2e18 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -5,6 +5,9 @@ \alias{jaspScale} \alias{isJaspScale} \alias{asJaspScale} +\alias{jaspOrdinal} +\alias{isJaspOrdinal} +\alias{asJaspOrdinal} \title{JASP Column Types} \usage{ jaspScale(x = double()) @@ -12,6 +15,12 @@ jaspScale(x = double()) isJaspScale(x) asJaspScale(x, ...) + +jaspOrdinal(x = integer(), values = sort(unique(x)), labels = values) + +isJaspOrdinal(x) + +asJaspOrdinal(x, ...) } \arguments{ \item{x}{the main object for which the operation is done} From 58149fe9bfa74f8e4c6dfa648ffc4e4c6bb4f635 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 31 May 2023 22:02:17 +0200 Subject: [PATCH 03/22] implement jaspNominal --- NAMESPACE | 16 +++++++++ R/column-types.R | 86 +++++++++++++++++++++++++++++++++++++++++++-- man/column-types.Rd | 9 +++++ 3 files changed, 109 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index fd1d016..02a5e84 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ S3method(decodeplot,jaspGraphsPlot) S3method(decodeplot,patchwork) S3method(decodeplot,qgraph) S3method(decodeplot,recordedplot) +S3method(format,jaspNominal) S3method(format,jaspOrdinal) S3method(format,jaspScale) S3method(gsubInteractionSymbol,character) @@ -27,32 +28,44 @@ S3method(ifElse,factor) S3method(ifElse,integer) S3method(ifElse,numeric) S3method(ifElse,ordered) +S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) S3method(print,jaspObjR) S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) +S3method(vec_cast,double.jaspNominal) S3method(vec_cast,double.jaspOrdinal) S3method(vec_cast,double.jaspScale) +S3method(vec_cast,integer.jaspNominal) S3method(vec_cast,integer.jaspOrdinal) S3method(vec_cast,integer.jaspScale) +S3method(vec_cast,jaspNominal.double) +S3method(vec_cast,jaspNominal.integer) +S3method(vec_cast,jaspNominal.jaspNominal) S3method(vec_cast,jaspOrdinal.double) S3method(vec_cast,jaspOrdinal.integer) S3method(vec_cast,jaspOrdinal.jaspOrdinal) S3method(vec_cast,jaspScale.double) S3method(vec_cast,jaspScale.integer) S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_ptype2,double.jaspNominal) S3method(vec_ptype2,double.jaspOrdinal) S3method(vec_ptype2,double.jaspScale) +S3method(vec_ptype2,integer.jaspNominal) S3method(vec_ptype2,integer.jaspOrdinal) S3method(vec_ptype2,integer.jaspScale) +S3method(vec_ptype2,jaspNominal.double) +S3method(vec_ptype2,jaspNominal.integer) +S3method(vec_ptype2,jaspNominal.jaspNominal) S3method(vec_ptype2,jaspOrdinal.double) S3method(vec_ptype2,jaspOrdinal.integer) S3method(vec_ptype2,jaspOrdinal.jaspOrdinal) S3method(vec_ptype2,jaspScale.double) S3method(vec_ptype2,jaspScale.integer) S3method(vec_ptype2,jaspScale.jaspScale) +S3method(vec_ptype_abbr,jaspNominal) S3method(vec_ptype_abbr,jaspOrdinal) S3method(vec_ptype_abbr,jaspScale) S3method(zScores,factor) @@ -85,6 +98,7 @@ export(VovkSellkeMPR) export(VovkSellkeMPROneSided) export(YeoJohnson) export(addRenvBeforeAfterDispatch) +export(asJaspNominal) export(asJaspOrdinal) export(asJaspScale) export(assignFunctionInPackage) @@ -119,6 +133,7 @@ export(interactionSymbol) export(invBoxCox) export(invFishZ) export(invLogit) +export(isJaspNominal) export(isJaspOrdinal) export(isJaspScale) export(isRecomputed) @@ -127,6 +142,7 @@ export(jaspColumnR) export(jaspDeps) export(jaspFormula) export(jaspFormulaRhs) +export(jaspNominal) export(jaspOrdinal) export(jaspQmlSourceR) export(jaspResultsCalledFromJasp) diff --git a/R/column-types.R b/R/column-types.R index 58ab382..7554f0b 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -81,6 +81,7 @@ vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() +# jaspOrdinal ---- newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { if (!rlang::is_integer(x) || !rlang::is_integer(values) || !rlang::is_character(labels)) { rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") @@ -148,8 +149,6 @@ asJaspOrdinal <- function(x, ...) { vctrs::vec_cast(x, newJaspOrdinal()) } - - ## Coercion #' @export vec_ptype2.jaspOrdinal.jaspOrdinal <- function(x, y, ...) newJaspOrdinal() @@ -173,3 +172,86 @@ vec_cast.double.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.dou vec_cast.jaspOrdinal.integer <- function(x, to, ...) jaspOrdinal(x, ...) #' @export vec_cast.integer.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() + + +# jaspNominal ---- +newJaspNominal <- function(x = integer(), values = integer(), labels = character()) { + if (!rlang::is_integer(x) || !rlang::is_integer(values) || !rlang::is_character(labels)) { + rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") + } + + if (!all(x %in% values)) { + rlang::abort("`values` must be a superset of `x`.") + } + + if (length(values) != length(labels)) { + rlangs::abort("`values` and `labels` must be of equal length.") + } + + vctrs::new_vctr(x, values = values, labels = labels, class = "jaspNominal") +} + +#' @rdname column-types +#' @export +jaspNominal <- function(x = integer(), values = sort(unique(x)), labels = values) { + x <- vctrs::vec_cast(x, integer()) + values <- vctrs::vec_cast(values, integer()) + labels <- as.character(labels) + + newJaspNominal(x, values, labels) +} + +#' @rdname column-types +#' @export +isJaspNominal <- function(x) { + inherits(x, "jaspNominal") +} + +#' @export +vec_ptype_abbr.jaspNominal <- function(x, ...) { + return("jspNom") +} + +#' @export +format.jaspNominal <- function(x, ...) { + format.jaspOrdinal(x, ...) +} + +#' @export +obj_print_footer.jaspNominal <- function(x, ...) { + val <- attr(x, "values") + lab <- attr(x, "labels") + + out <- paste(sprintf("%s(%i)", lab, val), collapse = ", ") + cat("Labels(Values):", out) +} + +#' @rdname column-types +#' @export +asJaspNominal <- function(x, ...) { + vctrs::vec_cast(x, newJaspOrdinal()) +} + +## Coercion +#' @export +vec_ptype2.jaspNominal.jaspNominal <- function(x, y, ...) newjaspNominal() +#' @export +vec_ptype2.jaspNominal.double <- function(x, y, ...) numeric() +#' @export +vec_ptype2.double.jaspNominal <- function(x, y, ...) numeric() +#' @export +vec_ptype2.jaspNominal.integer <- function(x, y, ...) numeric() +#' @export +vec_ptype2.integer.jaspNominal <- function(x, y, ...) numeric() + +## Casting +#' @export +vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) x +#' @export +vec_cast.jaspNominal.double <- function(x, to, ...) jaspNominal(x, ...) +#' @export +vec_cast.double.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +#' @export +vec_cast.jaspNominal.integer <- function(x, to, ...) jaspNominal(x, ...) +#' @export +vec_cast.integer.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() diff --git a/man/column-types.Rd b/man/column-types.Rd index a3d2e18..71b4830 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -8,6 +8,9 @@ \alias{jaspOrdinal} \alias{isJaspOrdinal} \alias{asJaspOrdinal} +\alias{jaspNominal} +\alias{isJaspNominal} +\alias{asJaspNominal} \title{JASP Column Types} \usage{ jaspScale(x = double()) @@ -21,6 +24,12 @@ jaspOrdinal(x = integer(), values = sort(unique(x)), labels = values) isJaspOrdinal(x) asJaspOrdinal(x, ...) + +jaspNominal(x = integer(), values = sort(unique(x)), labels = values) + +isJaspNominal(x) + +asJaspNominal(x, ...) } \arguments{ \item{x}{the main object for which the operation is done} From ac3a0a93b21fea0bbc5b0ce585c4743272cca26b Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Thu, 1 Jun 2023 17:19:06 +0200 Subject: [PATCH 04/22] redo jaspOrdinal --- NAMESPACE | 4 ++++ R/column-types.R | 53 +++++++++++++++++++++++++++++++----------------- 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 02a5e84..5f70c09 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,9 +47,13 @@ S3method(vec_cast,jaspNominal.jaspNominal) S3method(vec_cast,jaspOrdinal.double) S3method(vec_cast,jaspOrdinal.integer) S3method(vec_cast,jaspOrdinal.jaspOrdinal) +S3method(vec_cast,jaspOrdinal.ordered) S3method(vec_cast,jaspScale.double) S3method(vec_cast,jaspScale.integer) S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_cast,jaspScale.ordered) +S3method(vec_cast,ordered.jaspOrdinal) +S3method(vec_cast,ordered.jaspScale) S3method(vec_ptype2,double.jaspNominal) S3method(vec_ptype2,double.jaspOrdinal) S3method(vec_ptype2,double.jaspScale) diff --git a/R/column-types.R b/R/column-types.R index 7554f0b..e1d1fc1 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -79,7 +79,13 @@ vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.doubl vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) #' @export vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() - +#' @export +vec_cast.jaspScale.ordered <- function(x, to, ...) jaspScale(as.numeric(as.character(x))) +#' @export +vec_cast.ordered.jaspScale <- function(x, to, ...) { + print("hallo1") + vctrs::vec_data(x) |> as.ordered() +} # jaspOrdinal ---- newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { @@ -87,15 +93,11 @@ newJaspOrdinal <- function(x = integer(), values = integer(), labels = character rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") } - if (!all(x %in% values)) { - rlang::abort("`values` must be a superset of `x`.") - } - - if (length(values) != length(labels)) { - rlangs::abort("`values` and `labels` must be of equal length.") - } - - vctrs::new_vctr(x, values = values, labels = labels, class = "jaspOrdinal") + ord <- ordered(x, levels = values, labels = labels) + attr(ord, "values") <- values + class(ord) <- c("jaspOrdinal", "vctrs_vctr", class(ord)) + return(ord) + #vctrs::new_vctr(ordered(x, levels = values, labels = labels), values = values, class = "jaspOrdinal") } #' @rdname column-types @@ -121,15 +123,14 @@ vec_ptype_abbr.jaspOrdinal <- function(x, ...) { #' @export format.jaspOrdinal <- function(x, ...) { - values <- attr(x, "values") - labels <- attr(x, "labels") + labels <- attr(x, "levels") x <- vctrs::vec_data(x) valid <- !is.na(x) out <- rep(NA_character_, vctrs::vec_size(x)) - out[valid] <- sprintf("%s(%i)", labels[values[x[valid]]], x[valid]) + out[valid] <- labels[x[valid]] return(out) } @@ -137,7 +138,7 @@ format.jaspOrdinal <- function(x, ...) { #' @export obj_print_footer.jaspOrdinal <- function(x, ...) { val <- attr(x, "values") - lab <- attr(x, "labels") + lab <- attr(x, "levels") out <- paste(sprintf("%s(%i)", lab, val), collapse = " < ") cat("Labels(Values):", out) @@ -165,14 +166,28 @@ vec_ptype2.integer.jaspOrdinal <- function(x, y, ...) numeric() #' @export vec_cast.jaspOrdinal.jaspOrdinal <- function(x, to, ...) x #' @export -vec_cast.jaspOrdinal.double <- function(x, to, ...) jaspOrdinal(x, ...) +vec_cast.jaspOrdinal.double <- function(x, to, ...) jaspOrdinal(x) #' @export -vec_cast.double.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +vec_cast.double.jaspOrdinal <- function(x, to, ...) { + values <- attr(x, "values") + x <- vctrs::vec_data(x) + as.double(values[x]) +} #' @export -vec_cast.jaspOrdinal.integer <- function(x, to, ...) jaspOrdinal(x, ...) +vec_cast.jaspOrdinal.integer <- function(x, to, ...) jaspOrdinal(x) #' @export -vec_cast.integer.jaspOrdinal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() - +vec_cast.integer.jaspOrdinal <- function(x, to, ...) { + vec_cast.double.jaspOrdinal(x, to, ...) |> as.integer() +} +#' @export +vec_cast.jaspOrdinal.ordered <- function(x, to, ...) jaspOrdinal(x) +#' @export +vec_cast.ordered.jaspOrdinal <- function(x, to, ...) { + print("hole!") + attr(x, "values") <- NULL + class(x) <- c("ordered", "factor") + return(x) +} # jaspNominal ---- newJaspNominal <- function(x = integer(), values = integer(), labels = character()) { From a84763ae1f0b0720e9bdb1cfe27a7efb82d92405 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 8 Aug 2023 16:08:13 +0200 Subject: [PATCH 05/22] try S3 methods --- NAMESPACE | 5 +++++ R/column-types.R | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 5f70c09..49d3b97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,10 @@ S3method(ifElse,factor) S3method(ifElse,integer) S3method(ifElse,numeric) S3method(ifElse,ordered) +S3method(jasp2R,default) +S3method(jasp2R,jaspNominal) +S3method(jasp2R,jaspOrdinal) +S3method(jasp2R,jaspScale) S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) S3method(print,jaspObjR) @@ -142,6 +146,7 @@ export(isJaspOrdinal) export(isJaspScale) export(isRecomputed) export(isTryError) +export(jasp2R) export(jaspColumnR) export(jaspDeps) export(jaspFormula) diff --git a/R/column-types.R b/R/column-types.R index e1d1fc1..ee03155 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -270,3 +270,37 @@ vec_cast.double.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.dou vec_cast.jaspNominal.integer <- function(x, to, ...) jaspNominal(x, ...) #' @export vec_cast.integer.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() + +#' @export +jasp2R <- function(x) { + UseMethod("jasp2R") +} + +#' @export +jasp2R.default <- function(x) { + warning("Object is not of JASP type, no conversion done") + return(x) +} + +#' @export +jasp2R.jaspScale <- function(x) { + as.numeric(x) +} + +#' @export +jasp2R.jaspOrdinal <- function(x) { + values <- attr(x, "values") + labels <- attr(x, "levels") + ordered(vctrs::vec_data(x), levels = values, labels = labels) +} + +#' @export +jasp2R.jaspNominal <- function(x) { + values <- attr(x, "values") + labels <- attr(x, "levels") + factor(vctrs::vec_data(x), levels = values, labels = labels) +} + +r2jasp <- function(x) { + UseMethod("r2jasp") +} From 461524f8f21cb8ff3566737e9cacf3d2e2d125c3 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Thu, 7 Sep 2023 13:06:23 +0200 Subject: [PATCH 06/22] r2jasp method --- NAMESPACE | 5 +++++ R/column-types.R | 49 ++++++++++++++++++++++++++++-------------------- 2 files changed, 34 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 49d3b97..d45c1e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,6 +35,11 @@ S3method(jasp2R,jaspScale) S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) S3method(print,jaspObjR) +S3method(r2jasp,character) +S3method(r2jasp,default) +S3method(r2jasp,factor) +S3method(r2jasp,numeric) +S3method(r2jasp,ordered) S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) diff --git a/R/column-types.R b/R/column-types.R index ee03155..30c1e52 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -56,7 +56,7 @@ asJaspScale <- function(x, ...) { vctrs::vec_cast(x, newJaspScale()) } -## Coercion +## Coercion ---- #' @export vec_ptype2.jaspScale.jaspScale <- function(x, y, ...) newJaspScale() #' @export @@ -68,7 +68,7 @@ vec_ptype2.jaspScale.integer <- function(x, y, ...) numeric() #' @export vec_ptype2.integer.jaspScale <- function(x, y, ...) numeric() -## Casting +## Casting ---- #' @export vec_cast.jaspScale.jaspScale <- function(x, to, ...) x #' @export @@ -79,13 +79,6 @@ vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.doubl vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) #' @export vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() -#' @export -vec_cast.jaspScale.ordered <- function(x, to, ...) jaspScale(as.numeric(as.character(x))) -#' @export -vec_cast.ordered.jaspScale <- function(x, to, ...) { - print("hallo1") - vctrs::vec_data(x) |> as.ordered() -} # jaspOrdinal ---- newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { @@ -150,17 +143,6 @@ asJaspOrdinal <- function(x, ...) { vctrs::vec_cast(x, newJaspOrdinal()) } -## Coercion -#' @export -vec_ptype2.jaspOrdinal.jaspOrdinal <- function(x, y, ...) newJaspOrdinal() -#' @export -vec_ptype2.jaspOrdinal.double <- function(x, y, ...) numeric() -#' @export -vec_ptype2.double.jaspOrdinal <- function(x, y, ...) numeric() -#' @export -vec_ptype2.jaspOrdinal.integer <- function(x, y, ...) numeric() -#' @export -vec_ptype2.integer.jaspOrdinal <- function(x, y, ...) numeric() ## Casting #' @export @@ -271,6 +253,7 @@ vec_cast.jaspNominal.integer <- function(x, to, ...) jaspNominal(x, ...) #' @export vec_cast.integer.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() +# S3 conversions ---- #' @export jasp2R <- function(x) { UseMethod("jasp2R") @@ -304,3 +287,29 @@ jasp2R.jaspNominal <- function(x) { r2jasp <- function(x) { UseMethod("r2jasp") } + +#' @export +r2jasp.default <- function(x) { + warning("Object is not of type that can be explicitly converted to a JASP type, try converting your column into `numeric` or `factor`.") + return(x) +} + +#' @export +r2jasp.numeric <- function(x) { + asJaspScale(x) +} + +#' @export +r2jasp.ordered <- function(x) { + asJaspOrdinal(x) +} + +#' @export +r2jasp.factor <- function(x) { + asJaspNominal(x) +} + +#' @export +r2jasp.character <- function(x) { + asJaspNominal(x) +} From 33eb935d44737bed0b418622bdd5665000f4c7b0 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 8 Sep 2023 09:03:52 +0200 Subject: [PATCH 07/22] validate jaspScale --- NAMESPACE | 15 ++++------ R/column-types.R | 27 +++++++++++------- tests/testthat/test-column-types.R | 44 ++++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 20 deletions(-) create mode 100644 tests/testthat/test-column-types.R diff --git a/NAMESPACE b/NAMESPACE index d45c1e3..92db422 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) +S3method(vec_cast,character.jaspScale) S3method(vec_cast,double.jaspNominal) S3method(vec_cast,double.jaspOrdinal) S3method(vec_cast,double.jaspScale) @@ -57,26 +58,20 @@ S3method(vec_cast,jaspOrdinal.double) S3method(vec_cast,jaspOrdinal.integer) S3method(vec_cast,jaspOrdinal.jaspOrdinal) S3method(vec_cast,jaspOrdinal.ordered) +S3method(vec_cast,jaspScale.character) S3method(vec_cast,jaspScale.double) +S3method(vec_cast,jaspScale.factor) S3method(vec_cast,jaspScale.integer) S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_cast,jaspScale.logical) S3method(vec_cast,jaspScale.ordered) +S3method(vec_cast,logical.jaspScale) S3method(vec_cast,ordered.jaspOrdinal) -S3method(vec_cast,ordered.jaspScale) S3method(vec_ptype2,double.jaspNominal) -S3method(vec_ptype2,double.jaspOrdinal) -S3method(vec_ptype2,double.jaspScale) S3method(vec_ptype2,integer.jaspNominal) -S3method(vec_ptype2,integer.jaspOrdinal) -S3method(vec_ptype2,integer.jaspScale) S3method(vec_ptype2,jaspNominal.double) S3method(vec_ptype2,jaspNominal.integer) S3method(vec_ptype2,jaspNominal.jaspNominal) -S3method(vec_ptype2,jaspOrdinal.double) -S3method(vec_ptype2,jaspOrdinal.integer) -S3method(vec_ptype2,jaspOrdinal.jaspOrdinal) -S3method(vec_ptype2,jaspScale.double) -S3method(vec_ptype2,jaspScale.integer) S3method(vec_ptype2,jaspScale.jaspScale) S3method(vec_ptype_abbr,jaspNominal) S3method(vec_ptype_abbr,jaspOrdinal) diff --git a/R/column-types.R b/R/column-types.R index 30c1e52..425e3d7 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -59,26 +59,33 @@ asJaspScale <- function(x, ...) { ## Coercion ---- #' @export vec_ptype2.jaspScale.jaspScale <- function(x, y, ...) newJaspScale() -#' @export -vec_ptype2.jaspScale.double <- function(x, y, ...) numeric() -#' @export -vec_ptype2.double.jaspScale <- function(x, y, ...) numeric() -#' @export -vec_ptype2.jaspScale.integer <- function(x, y, ...) numeric() -#' @export -vec_ptype2.integer.jaspScale <- function(x, y, ...) numeric() ## Casting ---- +### to jaspScale ---- #' @export vec_cast.jaspScale.jaspScale <- function(x, to, ...) x #' @export vec_cast.jaspScale.double <- function(x, to, ...) jaspScale(x) #' @export -vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.double() -#' @export vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) #' @export +vec_cast.jaspScale.character <- function(x, to, ...) jaspScale(as.double(x)) +#' @export +vec_cast.jaspScale.logical <- function(x, to, ...) jaspScale(as.double(x)) +#' @export +vec_cast.jaspScale.factor <- function(x, to, ...) x |> as.character() |> as.double() |> jaspScale() +#' @export +vec_cast.jaspScale.ordered <- function(x, to, ...) x |> as.character() |> as.double() |> jaspScale() + +### to R types---- +#' @export +vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +#' @export vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() +#' @export +vec_cast.character.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.character() +#' @export +vec_cast.logical.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.logical() # jaspOrdinal ---- newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R new file mode 100644 index 0000000..540aeb5 --- /dev/null +++ b/tests/testthat/test-column-types.R @@ -0,0 +1,44 @@ +test_that("Converting jaspScale to R types works", { + x <- rnorm(10) + z <- jaspScale(x) + + expect_equal(as.numeric(z), x ) + expect_equal(as.integer(z), as.integer(x) ) + expect_equal(as.double(z), as.double(x) ) + expect_equal(as.character(z), as.character(x)) + expect_equal(as.factor(z), as.factor(x) ) + expect_equal(as.ordered(z), as.ordered(x) ) + expect_equal(as.logical(z), as.logical(x) ) +}) + +test_that("Converting R types to jaspScale works", { + expect_vector(asJaspScale(rnorm(10)), jaspScale(rnorm(10))) + expect_vector(asJaspScale(integer()), jaspScale()) + expect_vector(asJaspScale(character()), jaspScale()) + + # these types should coerce to jaspScale the same way as to a double + types <- list( + numeric = rnorm(10), + integer = 1L:10L, + character = c("a", "b", 1, 2.3, NA), + logical = c(TRUE, FALSE, NA) + ) + + for (x in types) + expect_identical( + suppressWarnings(x |> asJaspScale() |> as.double()), + suppressWarnings(x |> as.double()) + ) + + # these types should convert differently to jaspScale + types <- list( + factor = factor(c("a", "b", 1, 2)), + ordered = ordered(c("a", "b", 1, 2)) + ) + + for (x in types) + expect_identical( + suppressWarnings(x |> asJaspScale() |> as.double()), + suppressWarnings(x |> as.character() |> as.double()) + ) +}) From 76c179457e732c17d472df2aadd8d9b2f642df8b Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 8 Sep 2023 17:14:04 +0200 Subject: [PATCH 08/22] fix jaspNominal/jaspText + expand docs --- NAMESPACE | 26 +++-- R/column-types.R | 151 +++++++++++++++++++++-------- man/column-types.Rd | 21 +++- tests/testthat/test-column-types.R | 16 +++ 4 files changed, 162 insertions(+), 52 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 92db422..ebc2ec9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,32 +28,40 @@ S3method(ifElse,factor) S3method(ifElse,integer) S3method(ifElse,numeric) S3method(ifElse,ordered) -S3method(jasp2R,default) -S3method(jasp2R,jaspNominal) -S3method(jasp2R,jaspOrdinal) -S3method(jasp2R,jaspScale) +S3method(jasp2r,default) +S3method(jasp2r,jaspNominal) +S3method(jasp2r,jaspOrdinal) +S3method(jasp2r,jaspScale) S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) +S3method(obj_print_footer,jaspText) S3method(print,jaspObjR) S3method(r2jasp,character) S3method(r2jasp,default) S3method(r2jasp,factor) +S3method(r2jasp,logical) S3method(r2jasp,numeric) S3method(r2jasp,ordered) S3method(replaceNA,character) S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) +S3method(vec_cast,character.jaspNominal) S3method(vec_cast,character.jaspScale) +S3method(vec_cast,character.jaspText) S3method(vec_cast,double.jaspNominal) S3method(vec_cast,double.jaspOrdinal) S3method(vec_cast,double.jaspScale) S3method(vec_cast,integer.jaspNominal) S3method(vec_cast,integer.jaspOrdinal) S3method(vec_cast,integer.jaspScale) +S3method(vec_cast,jaspNominal.character) S3method(vec_cast,jaspNominal.double) +S3method(vec_cast,jaspNominal.factor) S3method(vec_cast,jaspNominal.integer) S3method(vec_cast,jaspNominal.jaspNominal) +S3method(vec_cast,jaspNominal.logical) +S3method(vec_cast,jaspNominal.ordered) S3method(vec_cast,jaspOrdinal.double) S3method(vec_cast,jaspOrdinal.integer) S3method(vec_cast,jaspOrdinal.jaspOrdinal) @@ -67,15 +75,11 @@ S3method(vec_cast,jaspScale.logical) S3method(vec_cast,jaspScale.ordered) S3method(vec_cast,logical.jaspScale) S3method(vec_cast,ordered.jaspOrdinal) -S3method(vec_ptype2,double.jaspNominal) -S3method(vec_ptype2,integer.jaspNominal) -S3method(vec_ptype2,jaspNominal.double) -S3method(vec_ptype2,jaspNominal.integer) -S3method(vec_ptype2,jaspNominal.jaspNominal) S3method(vec_ptype2,jaspScale.jaspScale) S3method(vec_ptype_abbr,jaspNominal) S3method(vec_ptype_abbr,jaspOrdinal) S3method(vec_ptype_abbr,jaspScale) +S3method(vec_ptype_abbr,jaspText) S3method(zScores,factor) S3method(zScores,numeric) export("%setOrRetrieve%") @@ -144,9 +148,10 @@ export(invLogit) export(isJaspNominal) export(isJaspOrdinal) export(isJaspScale) +export(isJaspText) export(isRecomputed) export(isTryError) -export(jasp2R) +export(jasp2r) export(jaspColumnR) export(jaspDeps) export(jaspFormula) @@ -165,6 +170,7 @@ export(normalDist) export(poisDist) export(powerTransform) export(progressbarTick) +export(r2jasp) export(readDataSetHeader) export(readDataSetToEnd) export(replaceNA) diff --git a/R/column-types.R b/R/column-types.R index 425e3d7..9bfc47c 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -3,8 +3,13 @@ #' @importFrom vctrs vec_ptype2 vec_cast vec_ptype_abbr obj_print_footer #' @title JASP Column Types #' -#' @description Columns types in JASP. -#' @param x the main object for which the operation is done +#' @description Columns types in JASP. JASP recognizes 3 main types (Scale, Ordinal, Nominal), +#' with Nominal being further split between basic Nominal and Text. +#' These types roughly correspond to [numeric()], [ordered()], and [factor()]. +#' @param x object to be coerced or tested. +#' @param values set of possible values (similar to `levels` in [factor()]). +#' @param labels set of labels of the values (similar to `labels` in [factor()]). +#' @param ... not used. NULL @@ -178,31 +183,42 @@ vec_cast.ordered.jaspOrdinal <- function(x, to, ...) { return(x) } -# jaspNominal ---- -newJaspNominal <- function(x = integer(), values = integer(), labels = character()) { - if (!rlang::is_integer(x) || !rlang::is_integer(values) || !rlang::is_character(labels)) { - rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") - } - - if (!all(x %in% values)) { - rlang::abort("`values` must be a superset of `x`.") - } +# jaspNominal(Text) ---- +newJaspNominal <- function(x = integer(), values = integer(), labels = character(), class = character()) { + if (!rlang::is_integer(x) || !rlang::is_character(labels)) + rlang::abort("`x` must be integer vectors, `labels` must be a character vector.") - if (length(values) != length(labels)) { - rlangs::abort("`values` and `labels` must be of equal length.") - } + vctrs::new_vctr(x, values = values, labels = labels, class = c(class, "jaspNominal")) +} - vctrs::new_vctr(x, values = values, labels = labels, class = "jaspNominal") +newJaspText <- function(x = integer(), values = character(), labels = character()) { + newJaspNominal(x = x, values = values, labels = labels, class = "jaspText") } #' @rdname column-types #' @export jaspNominal <- function(x = integer(), values = sort(unique(x)), labels = values) { - x <- vctrs::vec_cast(x, integer()) - values <- vctrs::vec_cast(values, integer()) + if (!all(x %in% values)) { + rlang::abort("`values` must be a superset of `x`.") + } + if (length(values) != length(labels)) { + rlang::abort("`values` and `labels` must be of same length.") + } + + cast_integers <- try(vctrs::vec_cast(x, integer()), silent = TRUE) + idx <- match(x, values) + values <- as.character(values) labels <- as.character(labels) - newJaspNominal(x, values, labels) + if (isTryError(cast_integers)) { + labels <- as.character(labels) + vctr <- newJaspText(x = idx, values = values, labels = labels) + } else { + labels <- as.character(labels) + vctr <- newJaspNominal(x = idx, values = values, labels = labels) + } + + return(vctr) } #' @rdname column-types @@ -211,14 +227,33 @@ isJaspNominal <- function(x) { inherits(x, "jaspNominal") } +#' @rdname column-types +#' @export +isJaspText <- function(x) { + inherits(x, "jaspText") +} + #' @export vec_ptype_abbr.jaspNominal <- function(x, ...) { return("jspNom") } +#' @export +vec_ptype_abbr.jaspText <- function(x, ...) { + return("jspTxt") +} + #' @export format.jaspNominal <- function(x, ...) { - format.jaspOrdinal(x, ...) + lab <- attr(x, "labels") + x <- vctrs::vec_data(x) + + valid <- !is.na(x) + + out <- rep(NA_character_, vctrs::vec_size(x)) + out[valid] <- lab[x[valid]] + + return(out) } #' @export @@ -230,74 +265,105 @@ obj_print_footer.jaspNominal <- function(x, ...) { cat("Labels(Values):", out) } +#' @export +obj_print_footer.jaspText <- function(x, ...) { + val <- attr(x, "values") + lab <- attr(x, "labels") + + out <- paste(sprintf("%s(%s)", lab, val), collapse = ", ") + cat("Labels(Values):", out) +} + #' @rdname column-types #' @export asJaspNominal <- function(x, ...) { - vctrs::vec_cast(x, newJaspOrdinal()) + vctrs::vec_cast(x, newJaspNominal()) } -## Coercion + +## Casting ---- +### to jaspNominal ---- #' @export -vec_ptype2.jaspNominal.jaspNominal <- function(x, y, ...) newjaspNominal() +vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) x #' @export -vec_ptype2.jaspNominal.double <- function(x, y, ...) numeric() +vec_cast.jaspNominal.double <- function(x, to, ...) { jaspNominal(x) } #' @export -vec_ptype2.double.jaspNominal <- function(x, y, ...) numeric() +vec_cast.jaspNominal.integer <- function(x, to, ...) { jaspNominal(x) } #' @export -vec_ptype2.jaspNominal.integer <- function(x, y, ...) numeric() +vec_cast.jaspNominal.character <- function(x, to, ...) { jaspNominal(x) } #' @export -vec_ptype2.integer.jaspNominal <- function(x, y, ...) numeric() - -## Casting +vec_cast.jaspNominal.logical <- function(x, to, ...) { jaspNominal(x) } #' @export -vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) x +vec_cast.jaspNominal.factor <- function(x, to, ...) { + xx <- as.integer(x) + labels <- levels(x) + jaspNominal(xx, values = seq_along(labels), labels = labels) +} +#' @export +vec_cast.jaspNominal.ordered <- vec_cast.jaspNominal.factor + +### to R types ---- #' @export -vec_cast.jaspNominal.double <- function(x, to, ...) jaspNominal(x, ...) +vec_cast.double.jaspNominal <- function(x, to, ...) { + data <- vctrs::vec_data(x) + values <- attr(x, "values") + values[data] |> as.double() +} #' @export -vec_cast.double.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +vec_cast.integer.jaspNominal <- function(x, to, ...) { + vec_cast.double.jaspNominal(x, to, ...) |> as.integer() +} #' @export -vec_cast.jaspNominal.integer <- function(x, to, ...) jaspNominal(x, ...) +vec_cast.character.jaspNominal <- function(x, to, ...) { + data <- vctrs::vec_data(x) + labels <- attr(x, "labels") + return(labels[data]) +} #' @export -vec_cast.integer.jaspNominal <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() +vec_cast.character.jaspText <- vec_cast.character.jaspNominal + # S3 conversions ---- +#' @rdname column-types #' @export -jasp2R <- function(x) { - UseMethod("jasp2R") +jasp2r <- function(x) { + UseMethod("jasp2r") } #' @export -jasp2R.default <- function(x) { +jasp2r.default <- function(x) { warning("Object is not of JASP type, no conversion done") return(x) } #' @export -jasp2R.jaspScale <- function(x) { +jasp2r.jaspScale <- function(x) { as.numeric(x) } #' @export -jasp2R.jaspOrdinal <- function(x) { +jasp2r.jaspOrdinal <- function(x) { values <- attr(x, "values") labels <- attr(x, "levels") ordered(vctrs::vec_data(x), levels = values, labels = labels) } #' @export -jasp2R.jaspNominal <- function(x) { +jasp2r.jaspNominal <- function(x) { values <- attr(x, "values") labels <- attr(x, "levels") factor(vctrs::vec_data(x), levels = values, labels = labels) } +#' @rdname column-types +#' @export r2jasp <- function(x) { UseMethod("r2jasp") } #' @export r2jasp.default <- function(x) { - warning("Object is not of type that can be explicitly converted to a JASP type, try converting your column into `numeric` or `factor`.") + warning("Object is not of type that can be automatically converted to a JASP type.") return(x) } @@ -320,3 +386,8 @@ r2jasp.factor <- function(x) { r2jasp.character <- function(x) { asJaspNominal(x) } + +#' @export +r2jasp.logical <- function(x) { + asJaspNominal(x) +} diff --git a/man/column-types.Rd b/man/column-types.Rd index 71b4830..0809c9d 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -10,7 +10,10 @@ \alias{asJaspOrdinal} \alias{jaspNominal} \alias{isJaspNominal} +\alias{isJaspText} \alias{asJaspNominal} +\alias{jasp2r} +\alias{r2jasp} \title{JASP Column Types} \usage{ jaspScale(x = double()) @@ -29,11 +32,25 @@ jaspNominal(x = integer(), values = sort(unique(x)), labels = values) isJaspNominal(x) +isJaspText(x) + asJaspNominal(x, ...) + +jasp2r(x) + +r2jasp(x) } \arguments{ -\item{x}{the main object for which the operation is done} +\item{x}{object to be coerced or tested.} + +\item{...}{not used.} + +\item{values}{set of possible values (similar to \code{levels} in \code{\link[=factor]{factor()}}).} + +\item{labels}{set of labels of the values (similar to \code{labels} in \code{\link[=factor]{factor()}}).} } \description{ -Columns types in JASP. +Columns types in JASP. JASP recognizes 3 main types (Scale, Ordinal, Nominal), +with Nominal being further split between basic Nominal and Text. +These types roughly correspond to \code{\link[=numeric]{numeric()}}, \code{\link[=ordered]{ordered()}}, and \code{\link[=factor]{factor()}}. } diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index 540aeb5..e3eb1be 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -42,3 +42,19 @@ test_that("Converting R types to jaspScale works", { suppressWarnings(x |> as.character() |> as.double()) ) }) + + +test_that("jasp2r works", { + expect_vector(jaspScale() |> jasp2r(), numeric()) + expect_vector(jaspOrdinal() |> jasp2r(), factor(ordered=TRUE)) + expect_vector(jaspNominal() |> jasp2r(), factor()) +}) + +test_that("r2jasp works", { + expect_vector(numeric() |> r2jasp(), jaspScale()) + expect_vector(integer() |> r2jasp(), jaspScale()) + expect_vector(double() |> r2jasp(), jaspScale()) + expect_vector(logical() |> r2jasp(), jaspNominal()) + expect_vector(factor() |> r2jasp(), jaspNominal()) + expect_vector(character() |> r2jasp(), newJaspText()) +}) From 3abbfc4bc6a48822f2a5c64d48dcbcaa47ab0d91 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 8 Sep 2023 20:05:01 +0200 Subject: [PATCH 09/22] add tests fr jaspNominal to R --- NAMESPACE | 1 - R/column-types.R | 11 +---------- tests/testthat/test-column-types.R | 16 ++++++++++++++++ 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ebc2ec9..ff172c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,7 +34,6 @@ S3method(jasp2r,jaspOrdinal) S3method(jasp2r,jaspScale) S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) -S3method(obj_print_footer,jaspText) S3method(print,jaspObjR) S3method(r2jasp,character) S3method(r2jasp,default) diff --git a/R/column-types.R b/R/column-types.R index 9bfc47c..817c33b 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -198,7 +198,7 @@ newJaspText <- function(x = integer(), values = character(), labels = character( #' @rdname column-types #' @export jaspNominal <- function(x = integer(), values = sort(unique(x)), labels = values) { - if (!all(x %in% values)) { + if (!all(na.omit(x) %in% values)) { rlang::abort("`values` must be a superset of `x`.") } if (length(values) != length(labels)) { @@ -261,15 +261,6 @@ obj_print_footer.jaspNominal <- function(x, ...) { val <- attr(x, "values") lab <- attr(x, "labels") - out <- paste(sprintf("%s(%i)", lab, val), collapse = ", ") - cat("Labels(Values):", out) -} - -#' @export -obj_print_footer.jaspText <- function(x, ...) { - val <- attr(x, "values") - lab <- attr(x, "labels") - out <- paste(sprintf("%s(%s)", lab, val), collapse = ", ") cat("Labels(Values):", out) } diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index e3eb1be..ccef7f9 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -44,6 +44,22 @@ test_that("Converting R types to jaspScale works", { }) +test_that("Converting jaspNominal to R types works", { + x <- c(4, 6, 2, 2, 6, NA) + values <- c(2, 6, 4) + labels <- c("two", "six", "four") + nom <- jaspNominal(x, values = values, labels = labels) + + expect_equal(as.numeric(nom), x) + expect_equal(as.integer(nom), x) + expect_equal(as.double(nom), x) + expect_equal(as.character(nom), labels[match(x, values)]) + expect_equal(as.factor(nom), factor(x, levels = values, labels = labels)) + expect_equal(as.ordered(nom), ordered(x, levels = values, labels = labels)) + expect_error(as.logical(nom), regexp = "Can't convert `x` to ") +}) + + test_that("jasp2r works", { expect_vector(jaspScale() |> jasp2r(), numeric()) expect_vector(jaspOrdinal() |> jasp2r(), factor(ordered=TRUE)) From 73a955a35c8a0a59dd5ad19cf13131f7273fbec9 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 8 Sep 2023 20:08:33 +0200 Subject: [PATCH 10/22] add tests for r types to jaspNominal --- tests/testthat/test-column-types.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index ccef7f9..d3084f9 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -59,6 +59,11 @@ test_that("Converting jaspNominal to R types works", { expect_error(as.logical(nom), regexp = "Can't convert `x` to ") }) +test_that("Converting R types to jaspScale works", { + expect_vector(asJaspNominal(integer()), jaspNominal(integer())) + expect_vector(asJaspNominal(character()), jaspNominal(character())) +}) + test_that("jasp2r works", { expect_vector(jaspScale() |> jasp2r(), numeric()) From 83a37a70d677036f791309dc0dc4db000e1868ce Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 11 Sep 2023 12:38:38 +0200 Subject: [PATCH 11/22] add tests for r types to jaspOrdinal --- NAMESPACE | 13 ++- R/column-types.R | 127 +++++++++++++++++++---------- tests/testthat/test-column-types.R | 26 +++++- 3 files changed, 118 insertions(+), 48 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ff172c7..07cb46e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,7 @@ S3method(replaceNA,factor) S3method(replaceNA,numeric) S3method(replaceNA,ordered) S3method(vec_cast,character.jaspNominal) +S3method(vec_cast,character.jaspOrdinal) S3method(vec_cast,character.jaspScale) S3method(vec_cast,character.jaspText) S3method(vec_cast,double.jaspNominal) @@ -59,22 +60,28 @@ S3method(vec_cast,jaspNominal.double) S3method(vec_cast,jaspNominal.factor) S3method(vec_cast,jaspNominal.integer) S3method(vec_cast,jaspNominal.jaspNominal) +S3method(vec_cast,jaspNominal.jaspOrdinal) +S3method(vec_cast,jaspNominal.jaspScale) S3method(vec_cast,jaspNominal.logical) S3method(vec_cast,jaspNominal.ordered) +S3method(vec_cast,jaspOrdinal.character) S3method(vec_cast,jaspOrdinal.double) +S3method(vec_cast,jaspOrdinal.factor) S3method(vec_cast,jaspOrdinal.integer) -S3method(vec_cast,jaspOrdinal.jaspOrdinal) +S3method(vec_cast,jaspOrdinal.jaspNominal) +S3method(vec_cast,jaspOrdinal.jaspScale) S3method(vec_cast,jaspOrdinal.ordered) S3method(vec_cast,jaspScale.character) S3method(vec_cast,jaspScale.double) S3method(vec_cast,jaspScale.factor) S3method(vec_cast,jaspScale.integer) +S3method(vec_cast,jaspScale.jaspNominal) +S3method(vec_cast,jaspScale.jaspOrdinal) S3method(vec_cast,jaspScale.jaspScale) +S3method(vec_cast,jaspScale.jaspText) S3method(vec_cast,jaspScale.logical) S3method(vec_cast,jaspScale.ordered) S3method(vec_cast,logical.jaspScale) -S3method(vec_cast,ordered.jaspOrdinal) -S3method(vec_ptype2,jaspScale.jaspScale) S3method(vec_ptype_abbr,jaspNominal) S3method(vec_ptype_abbr,jaspOrdinal) S3method(vec_ptype_abbr,jaspScale) diff --git a/R/column-types.R b/R/column-types.R index 817c33b..7b7ed5d 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -61,58 +61,59 @@ asJaspScale <- function(x, ...) { vctrs::vec_cast(x, newJaspScale()) } -## Coercion ---- -#' @export -vec_ptype2.jaspScale.jaspScale <- function(x, y, ...) newJaspScale() - ## Casting ---- ### to jaspScale ---- #' @export -vec_cast.jaspScale.jaspScale <- function(x, to, ...) x +vec_cast.jaspScale.jaspScale <- function(x, to, ...) { x } #' @export -vec_cast.jaspScale.double <- function(x, to, ...) jaspScale(x) +vec_cast.jaspScale.double <- function(x, to, ...) { jaspScale(x) } #' @export -vec_cast.jaspScale.integer <- function(x, to, ...) jaspScale(x) +vec_cast.jaspScale.integer <- function(x, to, ...) { jaspScale(x) } #' @export -vec_cast.jaspScale.character <- function(x, to, ...) jaspScale(as.double(x)) +vec_cast.jaspScale.character <- function(x, to, ...) { jaspScale(as.double(x)) } #' @export -vec_cast.jaspScale.logical <- function(x, to, ...) jaspScale(as.double(x)) +vec_cast.jaspScale.logical <- function(x, to, ...) { jaspScale(as.double(x)) } #' @export -vec_cast.jaspScale.factor <- function(x, to, ...) x |> as.character() |> as.double() |> jaspScale() +vec_cast.jaspScale.factor <- function(x, to, ...) { x |> as.character() |> as.double() |> jaspScale() } #' @export -vec_cast.jaspScale.ordered <- function(x, to, ...) x |> as.character() |> as.double() |> jaspScale() +vec_cast.jaspScale.ordered <- function(x, to, ...) { x |> as.character() |> as.double() |> jaspScale() } ### to R types---- #' @export -vec_cast.double.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.double() +vec_cast.double.jaspScale <- function(x, to, ...) { vctrs::vec_data(x) |> as.double() } #' @export -vec_cast.integer.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.integer() +vec_cast.integer.jaspScale <- function(x, to, ...) { vctrs::vec_data(x) |> as.integer() } #' @export -vec_cast.character.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.character() +vec_cast.character.jaspScale <- function(x, to, ...) { vctrs::vec_data(x) |> as.character() } #' @export -vec_cast.logical.jaspScale <- function(x, to, ...) vctrs::vec_data(x) |> as.logical() +vec_cast.logical.jaspScale <- function(x, to, ...) { vctrs::vec_data(x) |> as.logical() } # jaspOrdinal ---- newJaspOrdinal <- function(x = integer(), values = integer(), labels = character()) { - if (!rlang::is_integer(x) || !rlang::is_integer(values) || !rlang::is_character(labels)) { - rlang::abort("`x` and `values` must be integer vectors, `labels` must be a character vector.") - } + if (!rlang::is_integer(x) || !rlang::is_character(labels)) + rlang::abort("`x` must be integer vectors, `labels` must be a character vector.") - ord <- ordered(x, levels = values, labels = labels) - attr(ord, "values") <- values - class(ord) <- c("jaspOrdinal", "vctrs_vctr", class(ord)) - return(ord) - #vctrs::new_vctr(ordered(x, levels = values, labels = labels), values = values, class = "jaspOrdinal") + vctrs::new_vctr(x, values = values, labels = labels, class = "jaspOrdinal") } #' @rdname column-types #' @export jaspOrdinal <- function(x = integer(), values = sort(unique(x)), labels = values) { + if (!all(na.omit(x) %in% values)) { + rlang::abort("`values` must be a superset of `x`.") + } + if (length(values) != length(labels)) { + rlang::abort("`values` and `labels` must be of same length.") + } + x <- vctrs::vec_cast(x, integer()) - values <- vctrs::vec_cast(values, integer()) + idx <- match(x, values) + values <- as.character(values) labels <- as.character(labels) - newJaspOrdinal(x, values, labels) + vctr <- newJaspOrdinal(x = idx, values = values, labels = labels) + + return(vctr) } #' @rdname column-types @@ -128,14 +129,13 @@ vec_ptype_abbr.jaspOrdinal <- function(x, ...) { #' @export format.jaspOrdinal <- function(x, ...) { - labels <- attr(x, "levels") + lab <- attr(x, "labels") x <- vctrs::vec_data(x) - valid <- !is.na(x) out <- rep(NA_character_, vctrs::vec_size(x)) - out[valid] <- labels[x[valid]] + out[valid] <- lab[x[valid]] return(out) } @@ -143,24 +143,44 @@ format.jaspOrdinal <- function(x, ...) { #' @export obj_print_footer.jaspOrdinal <- function(x, ...) { val <- attr(x, "values") - lab <- attr(x, "levels") + lab <- attr(x, "labels") - out <- paste(sprintf("%s(%i)", lab, val), collapse = " < ") + out <- paste(sprintf("%s(%s)", lab, val), collapse = " < ") cat("Labels(Values):", out) } #' @rdname column-types #' @export asJaspOrdinal <- function(x, ...) { - vctrs::vec_cast(x, newJaspOrdinal()) + if(is.ordered(x)) { + vec_cast.jaspOrdinal.ordered(x, ...) + } else { + vctrs::vec_cast(x, newJaspOrdinal()) + } } -## Casting +## Casting ---- +### to jaspOrdinal ---- +#' @export +vec_cast.jaspOrdinal.double <- function(x, to, ...) { jaspOrdinal(x) } +#' @export +vec_cast.jaspOrdinal.integer <- function(x, to, ...) { jaspOrdinal(x) } +#' @export +vec_cast.jaspOrdinal.character <- function(x, to, ...) { + xx <- as.integer(x) + jaspOrdinal(xx) +} #' @export -vec_cast.jaspOrdinal.jaspOrdinal <- function(x, to, ...) x +vec_cast.jaspOrdinal.factor <- function(x, to, ...) { + xx <- as.integer(x) + labels <- levels(x) + jaspOrdinal(xx, labels = labels) +} #' @export -vec_cast.jaspOrdinal.double <- function(x, to, ...) jaspOrdinal(x) +vec_cast.jaspOrdinal.ordered <- vec_cast.jaspOrdinal.factor + +### to R types ---- #' @export vec_cast.double.jaspOrdinal <- function(x, to, ...) { values <- attr(x, "values") @@ -168,19 +188,14 @@ vec_cast.double.jaspOrdinal <- function(x, to, ...) { as.double(values[x]) } #' @export -vec_cast.jaspOrdinal.integer <- function(x, to, ...) jaspOrdinal(x) -#' @export vec_cast.integer.jaspOrdinal <- function(x, to, ...) { vec_cast.double.jaspOrdinal(x, to, ...) |> as.integer() } #' @export -vec_cast.jaspOrdinal.ordered <- function(x, to, ...) jaspOrdinal(x) -#' @export -vec_cast.ordered.jaspOrdinal <- function(x, to, ...) { - print("hole!") - attr(x, "values") <- NULL - class(x) <- c("ordered", "factor") - return(x) +vec_cast.character.jaspOrdinal <- function(x, to, ...) { + data <- vctrs::vec_data(x) + labels <- attr(x, "labels") + return(labels[data]) } # jaspNominal(Text) ---- @@ -313,7 +328,6 @@ vec_cast.character.jaspNominal <- function(x, to, ...) { #' @export vec_cast.character.jaspText <- vec_cast.character.jaspNominal - # S3 conversions ---- #' @rdname column-types #' @export @@ -382,3 +396,28 @@ r2jasp.character <- function(x) { r2jasp.logical <- function(x) { asJaspNominal(x) } + +# Casting between JASP types ---- + +#' @export +vec_cast.jaspScale.jaspOrdinal <- function(x, to, ...) { x |> as.double() |> asJaspScale() } +#' @export +vec_cast.jaspScale.jaspNominal <- function(x, to, ...) { x |> as.double() |> asJaspScale() } +#' @export +vec_cast.jaspScale.jaspText <- function(x, to, ...) { x |> as.character() |> asJaspScale() } + +#' @export +vec_cast.jaspOrdinal.jaspScale <- function(x, to, ...) { x |> as.double() |> asJaspOrdinal() } +#' @export +vec_cast.jaspOrdinal.jaspNominal <- function(x, to, ...) { + class(x) <- c("jaspOrdinal", "vctrs_vctr") + x +} + +#' @export +vec_cast.jaspNominal.jaspScale <- function(x, to, ...) { x |> as.double() |> asJaspNominal() } +#' @export +vec_cast.jaspNominal.jaspOrdinal <- function(x, to, ...) { + class(x) <- c("jaspNominal", "vctrs_vctr") + x +} diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index d3084f9..e2d45c4 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -1,3 +1,4 @@ +# jaspScale ---- test_that("Converting jaspScale to R types works", { x <- rnorm(10) z <- jaspScale(x) @@ -43,7 +44,30 @@ test_that("Converting R types to jaspScale works", { ) }) +# jaspOrdinal ---- +test_that("Converting jaspOrdinal to R types works", { + x <- c(4, 6, 2, 2, 6, NA) + values <- c(2, 6, 4) + labels <- c("two", "six", "four") + nom <- jaspOrdinal(x, values = values, labels = labels) + + expect_equal(as.numeric(nom), x) + expect_equal(as.integer(nom), x) + expect_equal(as.double(nom), x) + expect_equal(as.character(nom), labels[match(x, values)]) + expect_equal(as.factor(nom), factor(x, levels = values, labels = labels)) + expect_equal(as.ordered(nom), ordered(x, levels = values, labels = labels)) + expect_error(as.logical(nom), regexp = "Can't convert `x` to ") +}) +test_that("Converting R types to jaspOrdinal works", { + expect_vector (asJaspOrdinal(integer()), jaspOrdinal(integer())) + expect_error (rnorm(10) |> asJaspOrdinal(), regexp = "Can't convert from `x` to due to loss of precision.") + expect_error (letters |> jaspOrdinal(), regexp = "Can't convert `x` to .") + expect_warning(letters |> asJaspOrdinal(), regexp = "NAs introduced by coercion") +}) + +# jaspNominal ----- test_that("Converting jaspNominal to R types works", { x <- c(4, 6, 2, 2, 6, NA) values <- c(2, 6, 4) @@ -59,7 +83,7 @@ test_that("Converting jaspNominal to R types works", { expect_error(as.logical(nom), regexp = "Can't convert `x` to ") }) -test_that("Converting R types to jaspScale works", { +test_that("Converting R types to jaspNominal works", { expect_vector(asJaspNominal(integer()), jaspNominal(integer())) expect_vector(asJaspNominal(character()), jaspNominal(character())) }) From 62e6a2cce853cdaf66e52599ae34dbcf9dff7775 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 11 Sep 2023 13:11:28 +0200 Subject: [PATCH 12/22] added jasp<->jasp conversion tests --- NAMESPACE | 2 ++ R/column-types.R | 12 ++++--- tests/testthat/test-column-types.R | 50 +++++++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 07cb46e..0e22c2e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -62,6 +62,7 @@ S3method(vec_cast,jaspNominal.integer) S3method(vec_cast,jaspNominal.jaspNominal) S3method(vec_cast,jaspNominal.jaspOrdinal) S3method(vec_cast,jaspNominal.jaspScale) +S3method(vec_cast,jaspNominal.jaspText) S3method(vec_cast,jaspNominal.logical) S3method(vec_cast,jaspNominal.ordered) S3method(vec_cast,jaspOrdinal.character) @@ -69,6 +70,7 @@ S3method(vec_cast,jaspOrdinal.double) S3method(vec_cast,jaspOrdinal.factor) S3method(vec_cast,jaspOrdinal.integer) S3method(vec_cast,jaspOrdinal.jaspNominal) +S3method(vec_cast,jaspOrdinal.jaspOrdinal) S3method(vec_cast,jaspOrdinal.jaspScale) S3method(vec_cast,jaspOrdinal.ordered) S3method(vec_cast,jaspScale.character) diff --git a/R/column-types.R b/R/column-types.R index 7b7ed5d..f1defa7 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -64,8 +64,6 @@ asJaspScale <- function(x, ...) { ## Casting ---- ### to jaspScale ---- #' @export -vec_cast.jaspScale.jaspScale <- function(x, to, ...) { x } -#' @export vec_cast.jaspScale.double <- function(x, to, ...) { jaspScale(x) } #' @export vec_cast.jaspScale.integer <- function(x, to, ...) { jaspScale(x) } @@ -290,8 +288,6 @@ asJaspNominal <- function(x, ...) { ## Casting ---- ### to jaspNominal ---- #' @export -vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) x -#' @export vec_cast.jaspNominal.double <- function(x, to, ...) { jaspNominal(x) } #' @export vec_cast.jaspNominal.integer <- function(x, to, ...) { jaspNominal(x) } @@ -399,6 +395,8 @@ r2jasp.logical <- function(x) { # Casting between JASP types ---- +#' @export +vec_cast.jaspScale.jaspScale <- function(x, to, ...) { x } #' @export vec_cast.jaspScale.jaspOrdinal <- function(x, to, ...) { x |> as.double() |> asJaspScale() } #' @export @@ -409,6 +407,8 @@ vec_cast.jaspScale.jaspText <- function(x, to, ...) { x |> as.character() |> asJ #' @export vec_cast.jaspOrdinal.jaspScale <- function(x, to, ...) { x |> as.double() |> asJaspOrdinal() } #' @export +vec_cast.jaspOrdinal.jaspOrdinal <- function(x, to, ...) { x } +#' @export vec_cast.jaspOrdinal.jaspNominal <- function(x, to, ...) { class(x) <- c("jaspOrdinal", "vctrs_vctr") x @@ -421,3 +421,7 @@ vec_cast.jaspNominal.jaspOrdinal <- function(x, to, ...) { class(x) <- c("jaspNominal", "vctrs_vctr") x } +#' @export +vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) { x } +#' @export +vec_cast.jaspNominal.jaspText <- function(x, to, ...) { x } diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index e2d45c4..eaa2837 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -88,7 +88,7 @@ test_that("Converting R types to jaspNominal works", { expect_vector(asJaspNominal(character()), jaspNominal(character())) }) - +# auto converting ---- test_that("jasp2r works", { expect_vector(jaspScale() |> jasp2r(), numeric()) expect_vector(jaspOrdinal() |> jasp2r(), factor(ordered=TRUE)) @@ -103,3 +103,51 @@ test_that("r2jasp works", { expect_vector(factor() |> r2jasp(), jaspNominal()) expect_vector(character() |> r2jasp(), newJaspText()) }) + +# JASP to JASP ---- +test_that("from jaspScale works", { + x <- jaspScale(rnorm(3)) + y <- jaspScale(1:3) + + expect_equal(x |> asJaspScale(), x) + expect_equal(y |> asJaspScale(), y) + + expect_error (x |> asJaspOrdinal(), regexp = "Can't convert from `x` to due to loss of precision.") + expect_equal(y |> asJaspOrdinal(), jaspOrdinal(1:3)) + + expect_equal(x |> asJaspNominal(), x |> as.double() |> jaspNominal()) + expect_equal(y |> asJaspNominal(), y |> as.integer() |> jaspNominal()) +}) + +test_that("from jaspOrdinal works", { + x <- c(2, 6, 4, 2, 2, 6, 4) + values <- c(4, 6, 2) + labels <- letters[1:3] + ord <- jaspOrdinal(x = x, values = values, labels = labels) + + expect_equal(ord |> asJaspScale(), jaspScale(x)) + expect_equal(ord |> asJaspOrdinal(), ord) + expect_equal(ord |> asJaspNominal(), jaspNominal(x, values, labels)) +}) + +test_that("from jaspNominal works", { + x <- c(2, 6, 4, 2, 2, 6, 4) + values <- c(4, 6, 2) + labels <- letters[1:3] + nom <- jaspNominal(x = x, values = values, labels = labels) + + expect_equal(nom |> asJaspScale(), jaspScale(x)) + expect_equal(nom |> asJaspOrdinal(), jaspOrdinal(x, values, labels)) + expect_equal(nom |> asJaspNominal(), nom) +}) + +test_that("from jaspText works", { + x <- c("a", "b", "c", "1", "2.4") + txt <- jaspNominal(x) + + expect_warning(txt |> asJaspScale(), regexp = "NAs introduced by coercion") + expect_equal (suppressWarnings(txt |> asJaspScale() |> as.double()), suppressWarnings(as.double(x))) + expect_error (txt |> asJaspOrdinal(), regexp = "Can't convert `x` to .") + expect_equal (txt |> asJaspNominal(), txt) + +}) From e58a541716adea57ff674c5115f435205833423c Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 11 Sep 2023 13:34:15 +0200 Subject: [PATCH 13/22] add readDataSet functionality --- NAMESPACE | 7 ++++ R/column-types.R | 9 ++++ R/common.R | 8 +++- R/readDataSet.R | 66 ++++++++++++++++++++++++++++++ R/setOrRetrieve.R | 3 +- man/column-types.Rd | 11 ++++- tests/testthat/test-column-types.R | 2 +- 7 files changed, 101 insertions(+), 5 deletions(-) create mode 100644 R/readDataSet.R diff --git a/NAMESPACE b/NAMESPACE index 0e22c2e..e631e4e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,6 +38,10 @@ S3method(print,jaspObjR) S3method(r2jasp,character) S3method(r2jasp,default) S3method(r2jasp,factor) +S3method(r2jasp,jaspNominal) +S3method(r2jasp,jaspOrdinal) +S3method(r2jasp,jaspScale) +S3method(r2jasp,jaspText) S3method(r2jasp,logical) S3method(r2jasp,numeric) S3method(r2jasp,ordered) @@ -134,6 +138,7 @@ export(createJaspQmlSource) export(createJaspReport) export(createJaspState) export(createJaspTable) +export(dataSetColumnSpecification) export(decodeColNames) export(decodeName) export(encodeColNames) @@ -142,6 +147,7 @@ export(fDist) export(fishZ) export(gammaDist) export(geomDist) +export(getDataSet) export(getOS) export(gsubInteractionSymbol) export(hasSubstring) @@ -184,6 +190,7 @@ export(readDataSetToEnd) export(replaceNA) export(runJaspResults) export(runWrappedAnalysis) +export(setDataSet) export(startProgressbar) export(tDist) export(unifDist) diff --git a/R/column-types.R b/R/column-types.R index f1defa7..c2956bf 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -368,6 +368,15 @@ r2jasp.default <- function(x) { return(x) } +#' @export +r2jasp.jaspScale <- function(x) x +#' @export +r2jasp.jaspOrdinal <- function(x) x +#' @export +r2jasp.jaspNominal <- function(x) x +#' @export +r2jasp.jaspText <- function(x) x + #' @export r2jasp.numeric <- function(x) { asJaspScale(x) diff --git a/R/common.R b/R/common.R index 537033a..e512b37 100644 --- a/R/common.R +++ b/R/common.R @@ -274,7 +274,11 @@ isTryError <- function(obj){ if (all.columns == FALSE && is.null(columns) && is.null(columns.as.numeric) && is.null(columns.as.ordinal) && is.null(columns.as.factor)) return (data.frame()) - dataset <- .fromRCPP(".readDatasetToEndNative", unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns != FALSE) + if (isInsideJASP()) { + dataset <- .fromRCPP(".readDatasetToEndNative", unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns != FALSE) + } else { + dataset <- .readDataSetToEndFromR(unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns) + } dataset <- .excludeNaListwise(dataset, exclude.na.listwise) dataset @@ -539,7 +543,7 @@ jaspResultsStrings <- function() { base::tryCatch( base::load(location$relativePath), error=function(e) e - #,warning=function(w) w #Commented out because if there *is* a warning, which there of course shouldnt be, the state wont be loaded *at all*. + #,warning=function(w) w #Commented out because if there *is* a warning, which there of course shouldnt be, the state wont be loaded *at all*. ) } diff --git a/R/readDataSet.R b/R/readDataSet.R new file mode 100644 index 0000000..fdaaa73 --- /dev/null +++ b/R/readDataSet.R @@ -0,0 +1,66 @@ +#' @rdname column-types +#' @export +setDataSet <- function(dataset) { + .internal[["dataset"]] <- as.data.frame(lapply(dataset, r2jasp)) +} + +#' @rdname column-types +#' @export +getDataSet <- function(dataset) { + return(.internal[["dataset"]]) +} + +#' @rdname column-types +#' @export +dataSetColumnSpecification <- function() { + dataset <- .readDataSetHeaderFromR(all.columns = TRUE) + if (is.null(dataset)) stop("No dataset set!") + + specification <- list() + for(i in seq_len(ncol(dataset))) { + cl <- class(dataset[[i]])[1] + specification[[i]] <- list( + name = colnames(dataset)[[i]], + type = cl, + values = if(cl == "jaspScale") NA else attr(dataset[[i]], "values"), + labels = if(cl == "jaspScale") NA else attr(dataset[[i]], "labels") + ) + } + return(specification) +} + +.readDataSetToEndFromR <- function(columns=NULL, columns.as.numeric=NULL, columns.as.ordinal=NULL, columns.as.factor=NULL, all.columns=FALSE, ...) { + dataset <- .internal[["dataset"]] + dataset <- .dataSetSubsetColumns(dataset, columns=columns, columns.as.numeric=columns.as.numeric, columns.as.ordinal=columns.as.ordinal, columns.as.factor=columns.as.factor, all.columns=all.columns, ...) + return(dataset) +} + +.readDataSetHeaderFromR <- function(columns=NULL, columns.as.numeric=NULL, columns.as.ordinal=NULL, columns.as.factor=NULL, all.columns=FALSE, ...) { + dataset <- .readDataSetToEndFromR(columns=columns, columns.as.numeric=columns.as.numeric, columns.as.ordinal=columns.as.ordinal, columns.as.factor=columns.as.factor, all.columns=all.columns, ...) + dataset <- dataset[NULL, ] + return(dataset) +} + +.dataSetSubsetColumns <- function(dataset, columns=NULL, columns.as.numeric=NULL, columns.as.ordinal=NULL, columns.as.factor=NULL, all.columns=FALSE, ...) { + if(!all.columns) { + dataset <- dataset[, unique(c(columns, columns.as.numeric, columns.as.ordinal, columns.as.factor)), drop = FALSE] + } + + dataset <- .recodeColumns(dataset, columns.as.numeric, as.numeric) + dataset <- .recodeColumns(dataset, columns.as.ordinal, as.ordered) + dataset <- .recodeColumns(dataset, columns.as.factor, as.factor ) + + return(dataset) +} + +.recodeColumns <- function(dataset, which, type) { + if(!is.null(which)) { + dataset[, which] <- .coerceColumnType(dataset[, which, drop = FALSE], type) + } + return(dataset) +} +.coerceColumnType <- function(columns, type) { + as.data.frame( + lapply(columns, function(col) type(col)) + ) +} diff --git a/R/setOrRetrieve.R b/R/setOrRetrieve.R index 4dffdc3..fb22688 100644 --- a/R/setOrRetrieve.R +++ b/R/setOrRetrieve.R @@ -2,7 +2,8 @@ # It's not 100% clear if "address" is the best choice here, but it should be a little bit faster than constructing hashes using identical. # See also https://github.com/wch/r-source/blob/trunk/src/library/utils/src/hashtab.c recomputedHashtab = hashtab(type = "address", NULL), - lastRecomputed = TRUE + lastRecomputed = TRUE, + dataset = NULL ), parent = emptyenv()) saveHashOfJaspObject <- function(x) { diff --git a/man/column-types.Rd b/man/column-types.Rd index 0809c9d..9b3b2d7 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/column-types.R +% Please edit documentation in R/column-types.R, R/readDataSet.R \name{column-types} \alias{column-types} \alias{jaspScale} @@ -14,6 +14,9 @@ \alias{asJaspNominal} \alias{jasp2r} \alias{r2jasp} +\alias{setDataSet} +\alias{getDataSet} +\alias{dataSetColumnSpecification} \title{JASP Column Types} \usage{ jaspScale(x = double()) @@ -39,6 +42,12 @@ asJaspNominal(x, ...) jasp2r(x) r2jasp(x) + +setDataSet(dataset) + +getDataSet(dataset) + +dataSetColumnSpecification() } \arguments{ \item{x}{object to be coerced or tested.} diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index eaa2837..1169956 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -149,5 +149,5 @@ test_that("from jaspText works", { expect_equal (suppressWarnings(txt |> asJaspScale() |> as.double()), suppressWarnings(as.double(x))) expect_error (txt |> asJaspOrdinal(), regexp = "Can't convert `x` to .") expect_equal (txt |> asJaspNominal(), txt) - }) + From cd4614b1d5c66eb75eb6a1614f771f00ca765982 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 11 Sep 2023 14:14:02 +0200 Subject: [PATCH 14/22] improve documentation --- R/column-types.R | 34 ++++++++++++++++----- R/readDataSet.R | 2 +- inst/examples/ex-column-types.R | 31 +++++++++++++++++++ man/column-types.Rd | 54 +++++++++++++++++++++++++++++++-- 4 files changed, 111 insertions(+), 10 deletions(-) create mode 100644 inst/examples/ex-column-types.R diff --git a/R/column-types.R b/R/column-types.R index c2956bf..fe5472b 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -3,13 +3,31 @@ #' @importFrom vctrs vec_ptype2 vec_cast vec_ptype_abbr obj_print_footer #' @title JASP Column Types #' -#' @description Columns types in JASP. JASP recognizes 3 main types (Scale, Ordinal, Nominal), -#' with Nominal being further split between basic Nominal and Text. -#' These types roughly correspond to [numeric()], [ordered()], and [factor()]. +#' @description Columns types in JASP. #' @param x object to be coerced or tested. #' @param values set of possible values (similar to `levels` in [factor()]). #' @param labels set of labels of the values (similar to `labels` in [factor()]). #' @param ... not used. +#' @param dataset Data frame or tibble that contains data. +#' +#' @details +#' JASP recognizes 3 main data types (Scale, Ordinal, Nominal), +#' with Nominal being further split between basic Nominal and Text. +#' These types roughly correspond to [numeric()], [ordered()], and [factor()]. +#' +#' However, the correspondence between the base R types is not 100%. Thus, when passing a dataset from R to a JASP analysis, +#' JASP converts columns to these JASP types. Information from these columns is used for validating the input of the analysis +#' to ensure that the behavior is identical between R syntax and JASP application. +#' +#' The conversion uses simple heuristics (e.g., [`numeric()`] columns are converted to [`jaspScale()`]). For overriding +#' these heuristics, it is possible to convert a column to a specific JASP type before passing it to an analysis. +#' +#' To make it easier to reason how are these column conversion rules used within JASP, use [`jasp2r()`] and [`r2jasp()`] +#' functions that implement the implicit conversion rules using S3 dispatch. +#' Alternatively, it is possible to use functions [`setDataSet()`], [`getDataSet()`], and [`dataSetColumnSpecification()`], +#' that allow you to explicitly pass the data set to JASP, retrieve it, and check the column meta-data. +#' +#' @example inst/examples/ex-column-types.R NULL @@ -344,16 +362,18 @@ jasp2r.jaspScale <- function(x) { #' @export jasp2r.jaspOrdinal <- function(x) { + idx <- vctrs::vec_data(x) values <- attr(x, "values") - labels <- attr(x, "levels") - ordered(vctrs::vec_data(x), levels = values, labels = labels) + labels <- attr(x, "labels") + ordered(values[idx], levels = values, labels = labels) } #' @export jasp2r.jaspNominal <- function(x) { + idx <- vctrs::vec_data(x) values <- attr(x, "values") - labels <- attr(x, "levels") - factor(vctrs::vec_data(x), levels = values, labels = labels) + labels <- attr(x, "labels") + factor(values[idx], levels = values, labels = labels) } #' @rdname column-types diff --git a/R/readDataSet.R b/R/readDataSet.R index fdaaa73..9c273fb 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -6,7 +6,7 @@ setDataSet <- function(dataset) { #' @rdname column-types #' @export -getDataSet <- function(dataset) { +getDataSet <- function() { return(.internal[["dataset"]]) } diff --git a/inst/examples/ex-column-types.R b/inst/examples/ex-column-types.R new file mode 100644 index 0000000..820c0e9 --- /dev/null +++ b/inst/examples/ex-column-types.R @@ -0,0 +1,31 @@ +# load mtcars +df <- mtcars +str(df) + +# by default numeric columns are converted to jaspScale +lapply(df, r2jasp) + + +# change cyl to an ordinal variable +df$cyl <- jaspOrdinal(df$cyl, values = c(2, 4, 6, 8), labels = c("two", "four", "six", "eight")) +# change vs and am to nominal variables +df$vs <- jaspNominal(df$vs, labels = c("No", "Yes")) +df$am <- jaspNominal(df$am, labels = c("No", "Yes")) +# create a new variable that is a nominal text +df$group <- jaspNominal(rep(LETTERS[1:2], 16)) + +# factor and ordered will be converted to Nominal and Ordinal, respectively +df$gear <- as.factor(df$gear) +df$carb <- as.ordered(df$carb) + +str(df) + +# pass the data set to JASP +setDataSet(df) +# and retrieve it back +getDataSet() |> str() +# get the column specification of the set data frame as a list +dataSetColumnSpecification() + +# check how are these columns converted back to R types +getDataSet() |> lapply(jasp2r) diff --git a/man/column-types.Rd b/man/column-types.Rd index 9b3b2d7..2936e8f 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -45,7 +45,7 @@ r2jasp(x) setDataSet(dataset) -getDataSet(dataset) +getDataSet() dataSetColumnSpecification() } @@ -57,9 +57,59 @@ dataSetColumnSpecification() \item{values}{set of possible values (similar to \code{levels} in \code{\link[=factor]{factor()}}).} \item{labels}{set of labels of the values (similar to \code{labels} in \code{\link[=factor]{factor()}}).} + +\item{dataset}{Data frame or tibble that contains data.} } \description{ -Columns types in JASP. JASP recognizes 3 main types (Scale, Ordinal, Nominal), +Columns types in JASP. +} +\details{ +JASP recognizes 3 main data types (Scale, Ordinal, Nominal), with Nominal being further split between basic Nominal and Text. These types roughly correspond to \code{\link[=numeric]{numeric()}}, \code{\link[=ordered]{ordered()}}, and \code{\link[=factor]{factor()}}. + +However, the correspondence between the base R types is not 100\%. Thus, when passing a dataset from R to a JASP analysis, +JASP converts columns to these JASP types. Information from these columns is used for validating the input of the analysis +to ensure that the behavior is identical between R syntax and JASP application. + +The conversion uses simple heuristics (e.g., \code{\link[=numeric]{numeric()}} columns are converted to \code{\link[=jaspScale]{jaspScale()}}). For overriding +these heuristics, it is possible to convert a column to a specific JASP type before passing it to an analysis. + +To make it easier to reason how are these column conversion rules used within JASP, use \code{\link[=jasp2r]{jasp2r()}} and \code{\link[=r2jasp]{r2jasp()}} +functions that implement the implicit conversion rules using S3 dispatch. +Alternatively, it is possible to use functions \code{\link[=setDataSet]{setDataSet()}}, \code{\link[=getDataSet]{getDataSet()}}, and \code{\link[=dataSetColumnSpecification]{dataSetColumnSpecification()}}, +that allow you to explicitly pass the data set to JASP, retrieve it, and check the column meta-data. +} +\examples{ +# load mtcars +df <- mtcars +str(df) + +# by default numeric columns are converted to jaspScale +lapply(df, r2jasp) + + +# change cyl to an ordinal variable +df$cyl <- jaspOrdinal(df$cyl, values = c(2, 4, 6, 8), labels = c("two", "four", "six", "eight")) +# change vs and am to nominal variables +df$vs <- jaspNominal(df$vs, labels = c("No", "Yes")) +df$am <- jaspNominal(df$am, labels = c("No", "Yes")) +# create a new variable that is a nominal text +df$group <- jaspNominal(rep(LETTERS[1:2], 16)) + +# factor and ordered will be converted to Nominal and Ordinal, respectively +df$gear <- as.factor(df$gear) +df$carb <- as.ordered(df$carb) + +str(df) + +# pass the data set to JASP +setDataSet(df) +# and retrieve it back +getDataSet() |> str() +# get the column specification of the set data frame as a list +dataSetColumnSpecification() + +# check how are these columns converted back to R types +getDataSet() |> lapply(jasp2r) } From 6fc0a55bad00ec78ba157171d4c451214cae0c60 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Sun, 17 Sep 2023 12:06:16 +0200 Subject: [PATCH 15/22] S3 methods for data.frame --- NAMESPACE | 2 ++ R/column-types.R | 10 ++++++++++ R/readDataSet.R | 2 +- inst/examples/ex-column-types.R | 5 ++--- man/column-types.Rd | 2 +- 5 files changed, 16 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e631e4e..0cf75b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ S3method(ifElse,factor) S3method(ifElse,integer) S3method(ifElse,numeric) S3method(ifElse,ordered) +S3method(jasp2r,data.frame) S3method(jasp2r,default) S3method(jasp2r,jaspNominal) S3method(jasp2r,jaspOrdinal) @@ -36,6 +37,7 @@ S3method(obj_print_footer,jaspNominal) S3method(obj_print_footer,jaspOrdinal) S3method(print,jaspObjR) S3method(r2jasp,character) +S3method(r2jasp,data.frame) S3method(r2jasp,default) S3method(r2jasp,factor) S3method(r2jasp,jaspNominal) diff --git a/R/column-types.R b/R/column-types.R index fe5472b..88e82eb 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -355,6 +355,11 @@ jasp2r.default <- function(x) { return(x) } +#' @export +jasp2r.data.frame <- function(x) { + as.data.frame(lapply(x, jasp2r)) +} + #' @export jasp2r.jaspScale <- function(x) { as.numeric(x) @@ -388,6 +393,11 @@ r2jasp.default <- function(x) { return(x) } +#' @export +r2jasp.data.frame <- function(x) { + as.data.frame(lapply(x, r2jasp)) +} + #' @export r2jasp.jaspScale <- function(x) x #' @export diff --git a/R/readDataSet.R b/R/readDataSet.R index 9c273fb..2bffdeb 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -1,7 +1,7 @@ #' @rdname column-types #' @export setDataSet <- function(dataset) { - .internal[["dataset"]] <- as.data.frame(lapply(dataset, r2jasp)) + .internal[["dataset"]] <- r2jasp(dataset) } #' @rdname column-types diff --git a/inst/examples/ex-column-types.R b/inst/examples/ex-column-types.R index 820c0e9..92850f8 100644 --- a/inst/examples/ex-column-types.R +++ b/inst/examples/ex-column-types.R @@ -3,8 +3,7 @@ df <- mtcars str(df) # by default numeric columns are converted to jaspScale -lapply(df, r2jasp) - +r2jasp(df) |> str() # change cyl to an ordinal variable df$cyl <- jaspOrdinal(df$cyl, values = c(2, 4, 6, 8), labels = c("two", "four", "six", "eight")) @@ -28,4 +27,4 @@ getDataSet() |> str() dataSetColumnSpecification() # check how are these columns converted back to R types -getDataSet() |> lapply(jasp2r) +getDataSet() |> jasp2r() |> str() diff --git a/man/column-types.Rd b/man/column-types.Rd index 2936e8f..2dc616c 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -87,7 +87,7 @@ str(df) # by default numeric columns are converted to jaspScale lapply(df, r2jasp) - +r2jasp(df) |> str() # change cyl to an ordinal variable df$cyl <- jaspOrdinal(df$cyl, values = c(2, 4, 6, 8), labels = c("two", "four", "six", "eight")) From 072d5855dec79eedc624a7fa5521118c10b59cda Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Sun, 17 Sep 2023 12:16:37 +0200 Subject: [PATCH 16/22] convert default columns + update example --- R/readDataSet.R | 1 + man/column-types.Rd | 3 +-- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/readDataSet.R b/R/readDataSet.R index 2bffdeb..b1f5888 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -46,6 +46,7 @@ dataSetColumnSpecification <- function() { dataset <- dataset[, unique(c(columns, columns.as.numeric, columns.as.ordinal, columns.as.factor)), drop = FALSE] } + dataset <- .recodeColumns(dataset, columns, jasp2r) dataset <- .recodeColumns(dataset, columns.as.numeric, as.numeric) dataset <- .recodeColumns(dataset, columns.as.ordinal, as.ordered) dataset <- .recodeColumns(dataset, columns.as.factor, as.factor ) diff --git a/man/column-types.Rd b/man/column-types.Rd index 2dc616c..3cec167 100644 --- a/man/column-types.Rd +++ b/man/column-types.Rd @@ -86,7 +86,6 @@ df <- mtcars str(df) # by default numeric columns are converted to jaspScale -lapply(df, r2jasp) r2jasp(df) |> str() # change cyl to an ordinal variable @@ -111,5 +110,5 @@ getDataSet() |> str() dataSetColumnSpecification() # check how are these columns converted back to R types -getDataSet() |> lapply(jasp2r) +getDataSet() |> jasp2r() |> str() } From 939fe38046ff5cf2b45a24ec9f1d1c7bb0f4f85f Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 18 Sep 2023 18:25:16 +0200 Subject: [PATCH 17/22] if all.columns==TRUE also return r types --- R/readDataSet.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/readDataSet.R b/R/readDataSet.R index b1f5888..f0e63d5 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -44,6 +44,8 @@ dataSetColumnSpecification <- function() { .dataSetSubsetColumns <- function(dataset, columns=NULL, columns.as.numeric=NULL, columns.as.ordinal=NULL, columns.as.factor=NULL, all.columns=FALSE, ...) { if(!all.columns) { dataset <- dataset[, unique(c(columns, columns.as.numeric, columns.as.ordinal, columns.as.factor)), drop = FALSE] + } else { + dataset <- jasp2r(dataset) } dataset <- .recodeColumns(dataset, columns, jasp2r) From c77d8330078a25dd3bf0075541952987b44de8ba Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 18 Sep 2023 18:28:23 +0200 Subject: [PATCH 18/22] forgot to send readDataSetHeader to R --- R/common.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/common.R b/R/common.R index e512b37..75b2290 100644 --- a/R/common.R +++ b/R/common.R @@ -295,7 +295,11 @@ isTryError <- function(obj){ if (all.columns == FALSE && is.null(columns) && is.null(columns.as.numeric) && is.null(columns.as.ordinal) && is.null(columns.as.factor)) return (data.frame()) - dataset <- .fromRCPP(".readDataSetHeaderNative", unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns != FALSE) + if (isInsideJASP()) { + dataset <- .fromRCPP(".readDataSetHeaderNative", unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns != FALSE) + } else { + dataset <- .readDataSetHeaderFromR(unlist(columns), unlist(columns.as.numeric), unlist(columns.as.ordinal), unlist(columns.as.factor), all.columns) + } dataset } From b3c156825b416c2ad03b88519ed4f75625f1d08f Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 18 Sep 2023 22:24:47 +0200 Subject: [PATCH 19/22] simplify coercing columns --- R/readDataSet.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/readDataSet.R b/R/readDataSet.R index f0e63d5..4df92fe 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -48,22 +48,22 @@ dataSetColumnSpecification <- function() { dataset <- jasp2r(dataset) } - dataset <- .recodeColumns(dataset, columns, jasp2r) - dataset <- .recodeColumns(dataset, columns.as.numeric, as.numeric) - dataset <- .recodeColumns(dataset, columns.as.ordinal, as.ordered) - dataset <- .recodeColumns(dataset, columns.as.factor, as.factor ) + dataset <- .convertColumns(dataset, columns, jasp2r) + dataset <- .convertColumns(dataset, columns.as.numeric, as.numeric) + dataset <- .convertColumns(dataset, columns.as.ordinal, as.ordered) + dataset <- .convertColumns(dataset, columns.as.factor, as.factor ) return(dataset) } -.recodeColumns <- function(dataset, which, type) { - if(!is.null(which)) { - dataset[, which] <- .coerceColumnType(dataset[, which, drop = FALSE], type) +.convertColumns <- function(dataset, columns, type) { + for(column in columns) { + data <- dataset[[column]] + if(!is.null(data)) { + dataset[[column]] <- type(data) + } else { + warning("Variable ", column, " not found!") + } } return(dataset) } -.coerceColumnType <- function(columns, type) { - as.data.frame( - lapply(columns, function(col) type(col)) - ) -} From 93fff7803dabd2952aef86cf937243d87408cbbd Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Mon, 18 Sep 2023 23:15:07 +0200 Subject: [PATCH 20/22] Make sure not to screw up column names - this should not be an issue if we encode dataset anyway but still --- R/column-types.R | 8 ++++++-- R/readDataSet.R | 4 +++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/R/column-types.R b/R/column-types.R index 88e82eb..940b73f 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -357,7 +357,9 @@ jasp2r.default <- function(x) { #' @export jasp2r.data.frame <- function(x) { - as.data.frame(lapply(x, jasp2r)) + out <- as.data.frame(lapply(x, jasp2r)) + colnames(out) <- colnames(x) + return(out) } #' @export @@ -395,7 +397,9 @@ r2jasp.default <- function(x) { #' @export r2jasp.data.frame <- function(x) { - as.data.frame(lapply(x, r2jasp)) + out <- as.data.frame(lapply(x, r2jasp)) + colnames(out) <- colnames(x) + return(out) } #' @export diff --git a/R/readDataSet.R b/R/readDataSet.R index 4df92fe..a320faf 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -43,7 +43,9 @@ dataSetColumnSpecification <- function() { .dataSetSubsetColumns <- function(dataset, columns=NULL, columns.as.numeric=NULL, columns.as.ordinal=NULL, columns.as.factor=NULL, all.columns=FALSE, ...) { if(!all.columns) { - dataset <- dataset[, unique(c(columns, columns.as.numeric, columns.as.ordinal, columns.as.factor)), drop = FALSE] + cols <- unique(c(columns, columns.as.numeric, columns.as.ordinal, columns.as.factor)) + cols <- cols[cols %in% colnames(dataset)] + dataset <- dataset[, cols, drop = FALSE] } else { dataset <- jasp2r(dataset) } From de8a98db88128eebd282f8c1e536531065b2d42c Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 19 Sep 2023 11:17:26 +0200 Subject: [PATCH 21/22] fix corner cases (coerce jaspText -> numeric, integer -> jaspScale -> numeric is integer) --- NAMESPACE | 5 +++++ R/column-types.R | 35 +++++++++++++++++++++++++----- R/readDataSet.R | 2 +- tests/testthat/test-column-types.R | 6 +++++ 4 files changed, 42 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0cf75b8..254efe2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,8 @@ S3method("[[<-",jaspContainerR) S3method("[[<-",jaspTableR) S3method(.RCodeInOptionsIsOk,default) S3method(.RCodeInOptionsIsOk,list) +S3method(as.numeric2,default) +S3method(as.numeric2,integer) S3method(decodeplot,"function") S3method(decodeplot,gDesc) S3method(decodeplot,gTree) @@ -58,9 +60,11 @@ S3method(vec_cast,character.jaspText) S3method(vec_cast,double.jaspNominal) S3method(vec_cast,double.jaspOrdinal) S3method(vec_cast,double.jaspScale) +S3method(vec_cast,double.jaspText) S3method(vec_cast,integer.jaspNominal) S3method(vec_cast,integer.jaspOrdinal) S3method(vec_cast,integer.jaspScale) +S3method(vec_cast,integer.jaspText) S3method(vec_cast,jaspNominal.character) S3method(vec_cast,jaspNominal.double) S3method(vec_cast,jaspNominal.factor) @@ -124,6 +128,7 @@ export(VovkSellkeMPR) export(VovkSellkeMPROneSided) export(YeoJohnson) export(addRenvBeforeAfterDispatch) +export(as.numeric2) export(asJaspNominal) export(asJaspOrdinal) export(asJaspScale) diff --git a/R/column-types.R b/R/column-types.R index 940b73f..6357a9d 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -33,17 +33,21 @@ NULL # jaspScale ----- newJaspScale <- function(x = double()) { - if (!rlang::is_double(x)) { - rlang::abort("`x` must be a double vector.") + if (!rlang::is_double(x) && !rlang::is_integer(x)) { + rlang::abort("`x` must be a double or integer vector.") } - vctrs::new_vctr(x, class = "jaspScale") + type <- typeof(x) + vctrs::new_vctr(x, class = c("jaspScale", type)) } #' @rdname column-types #' @export jaspScale <- function(x = double()) { - x <- vctrs::vec_cast(x, double()) + x <- tryCatch( + expr = vctrs::vec_cast(x, integer()), + error = function(e) vctrs::vec_cast(x, double()) + ) newJaspScale(x) } @@ -340,6 +344,10 @@ vec_cast.character.jaspNominal <- function(x, to, ...) { return(labels[data]) } #' @export +vec_cast.double.jaspText <- vec_cast.double.jaspNominal +#' @export +vec_cast.integer.jaspText <- vec_cast.integer.jaspNominal +#' @export vec_cast.character.jaspText <- vec_cast.character.jaspNominal # S3 conversions ---- @@ -364,7 +372,7 @@ jasp2r.data.frame <- function(x) { #' @export jasp2r.jaspScale <- function(x) { - as.numeric(x) + as.numeric2(x) } #' @export @@ -468,3 +476,20 @@ vec_cast.jaspNominal.jaspOrdinal <- function(x, to, ...) { vec_cast.jaspNominal.jaspNominal <- function(x, to, ...) { x } #' @export vec_cast.jaspNominal.jaspText <- function(x, to, ...) { x } + +# Corner cases ---- +# as.numeric2() preserves integers instead of converting them to doubles +#' @export +as.numeric2 <- function(x, ...) { + UseMethod("as.numeric2") +} + +#' @export +as.numeric2.default <- function(x, ...) { + as.numeric(x, ...) +} + +#' @export +as.numeric2.integer <- function(x, ...) { + as.integer(x, ...) +} diff --git a/R/readDataSet.R b/R/readDataSet.R index a320faf..62898fa 100644 --- a/R/readDataSet.R +++ b/R/readDataSet.R @@ -51,7 +51,7 @@ dataSetColumnSpecification <- function() { } dataset <- .convertColumns(dataset, columns, jasp2r) - dataset <- .convertColumns(dataset, columns.as.numeric, as.numeric) + dataset <- .convertColumns(dataset, columns.as.numeric, as.numeric2) dataset <- .convertColumns(dataset, columns.as.ordinal, as.ordered) dataset <- .convertColumns(dataset, columns.as.factor, as.factor ) diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index 1169956..e81c2a8 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -151,3 +151,9 @@ test_that("from jaspText works", { expect_equal (txt |> asJaspNominal(), txt) }) +test_that("as.numeric2 works as expected", { + num <- rnorm(3) + int <- 1L:3L + expect_vector(num |> as.numeric2(), double(), size = 3) + expect_vector(int |> as.numeric2(), integer(), size = 3) +}) From 099df1bf605a5f35fc2fd69999963ea57a07095b Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 29 Sep 2023 11:58:39 +0200 Subject: [PATCH 22/22] fix tests --- R/column-types.R | 10 ++++++---- tests/testthat/test-column-types.R | 4 ++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/R/column-types.R b/R/column-types.R index 6357a9d..47adeea 100644 --- a/R/column-types.R +++ b/R/column-types.R @@ -44,10 +44,12 @@ newJaspScale <- function(x = double()) { #' @rdname column-types #' @export jaspScale <- function(x = double()) { - x <- tryCatch( - expr = vctrs::vec_cast(x, integer()), - error = function(e) vctrs::vec_cast(x, double()) - ) + if (!rlang::is_bare_double(x)) { + x <- tryCatch( + expr = vctrs::vec_cast(x, integer()), + error = function(e) vctrs::vec_cast(x, double()) + ) + } newJaspScale(x) } diff --git a/tests/testthat/test-column-types.R b/tests/testthat/test-column-types.R index e81c2a8..e805971 100644 --- a/tests/testthat/test-column-types.R +++ b/tests/testthat/test-column-types.R @@ -14,7 +14,7 @@ test_that("Converting jaspScale to R types works", { test_that("Converting R types to jaspScale works", { expect_vector(asJaspScale(rnorm(10)), jaspScale(rnorm(10))) - expect_vector(asJaspScale(integer()), jaspScale()) + expect_vector(asJaspScale(integer()), jaspScale(integer())) expect_vector(asJaspScale(character()), jaspScale()) # these types should coerce to jaspScale the same way as to a double @@ -97,7 +97,7 @@ test_that("jasp2r works", { test_that("r2jasp works", { expect_vector(numeric() |> r2jasp(), jaspScale()) - expect_vector(integer() |> r2jasp(), jaspScale()) + expect_vector(integer() |> r2jasp(), jaspScale(integer())) expect_vector(double() |> r2jasp(), jaspScale()) expect_vector(logical() |> r2jasp(), jaspNominal()) expect_vector(factor() |> r2jasp(), jaspNominal())