Skip to content

Commit

Permalink
Moving jmvAtt to write_omv and restructuring the code to convert orig…
Browse files Browse the repository at this point in the history 
…inal data frames using jmvAtt before writing them
  • Loading branch information
@sjentsch
sjentsch committed Nov 7, 2024
1 parent a49bae0 commit aa8cce9
Show file tree
Hide file tree
Showing 2 changed files with 90 additions and 44 deletions.
76 changes: 45 additions & 31 deletions tests/testthat/test-globals.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,37 +99,6 @@ test_that("globals work", {
expect_error(df4Chk <- inp2DF(dtaInp = inpDF, rmvEmp = TRUE),
regexp = "Empty rows are not permitted execpt from the begin or the end of an input data frame \\(in such case, they are automatically removed\\)\\.")

tmpDF <- data.frame(ID = sprintf("P_%04d", sample(9999, 100)), I = as.integer(sample(1e6, 100)), D = rnorm(100),
OT = factor(sample(c("low", "middle", "high"), 100, replace = TRUE), levels = c("low", "middle", "high"), ordered = TRUE),
ON = factor(sample(seq(7), 100, replace = TRUE), levels = seq(7), ordered = TRUE),
NT = factor(sample(c("low", "middle", "high"), 100, replace = TRUE), levels = c("low", "middle", "high")),
NN = factor(sample(seq(7), 100, replace = TRUE), levels = seq(7)),
CR = sample(c("low", "middle", "high"), 100, replace = TRUE))
attr(tmpDF[["ID"]], "jmv-id") <- TRUE
attr(tmpDF[["ON"]], "values") <- seq(7)
attr(tmpDF[["NN"]], "values") <- seq(7)
attr(tmpDF[["CR"]], "jmv-desc") <- "Trial (is description kept?)"
expect_equal(lapply(lapply(jmvAtt(tmpDF), attributes), names), list(ID = c("jmv-id", "measureType", "dataType"),
I = c("measureType", "dataType"), D = c("measureType", "dataType"),
OT = c("levels", "class", "measureType", "dataType"), ON = c("levels", "class", "values", "measureType", "dataType"),
NT = c("levels", "class", "measureType", "dataType"), NN = c("levels", "class", "values", "measureType", "dataType"),
CR = c("levels", "class", "jmv-desc", "measureType", "dataType")))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["ID"]]), use.names = FALSE), c("TRUE", "ID", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["I"]]), use.names = FALSE), c("Continuous", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["D"]]), use.names = FALSE), c("Continuous", "Decimal"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["OT"]]), use.names = FALSE), c("low", "middle", "high", "ordered", "factor", "Ordinal", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["ON"]]), use.names = FALSE), c(sprintf("%d", seq(1:7)), "ordered", "factor", sprintf("%d", seq(1:7)), "Ordinal", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["NT"]]), use.names = FALSE), c("low", "middle", "high", "factor", "Nominal", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["NN"]]), use.names = FALSE), c(sprintf("%d", seq(1:7)), "factor", sprintf("%d", seq(1:7)), "Nominal", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["CR"]]), use.names = FALSE), c("high", "low", "middle", "factor", "Trial (is description kept?)", "Nominal", "Text"))
tmpCR <- tmpDF["CR"]
attr(tmpCR[["CR"]], "measureType") <- attr(tmpCR[["CR"]], "dataType") <- "Trial"
expect_equal(attributes(jmvAtt(tmpCR)[["CR"]]), list(`jmv-desc` = "Trial (is description kept?)", dataType = "Trial", measureType = "Trial"))
expect_error(jmvAtt("Trial"), regexp = "^Input data are either not a data frame or have incorrect \\(only one or more than two\\) dimensions\\.")
expect_error(jmvAtt(data.frame()), regexp = "^The first dimension of the input data frame has not the required size \\(0 < 1\\)\\.")
expect_error(jmvAtt(cbind(tmpDF, data.frame(ER = sample(seq(as.Date("2000/01/01"), as.Date("2019/12/31"), by = "day"), 100)))),
regexp = "^\\s+\\w+: Variable type \\w+ not implemented:")

Sys.setenv(JAMOVI_R_VERSION = paste0(R.version$major, ".", R.version$minor))
expect_warning(expect_error(rtnDta(fleOut = "", psvAnl = TRUE),
regexp = "The position of the jamovi executable could not be determined or it was not found at the determined position\\. Determined position:"),
Expand All @@ -141,4 +110,49 @@ test_that("globals work", {
expect_equal(jmvTtl("_arr_col"), "Dataset_arr_col")
Sys.unsetenv("JAMOVI_R_VERSION")
expect_equal(jmvTtl("_arr_col"), "")

set.seed(1)
tmpDF <- as.data.frame(cor(matrix(rnorm(1000), nrow = 100)))
expect_error(mtxF2S(tmpDF[-1, ]), regexp = "Input matrix needs to be symmetric.")
df4Chk <- mtxF2S(tmpDF)
expect_equal(dim(df4Chk), c(10, 10))
expect_equal(names(df4Chk), row.names(df4Chk))
expect_equal(names(df4Chk), sprintf("V%d", seq(10)))
expect_false(any(is.na(df4Chk)))
expect_equal(unname(colMeans(df4Chk)), c(0.128183893, 0.096625131, 0.070568445, 0.115919003, 0.139886614, 0.058323693, 0.092441925, 0.106711615, 0.168887776, 0.10403618))

df4Chk <- mtxF2S(tmpDF, rmvTrU = TRUE)
expect_equal(dim(df4Chk), c(10, 10))
expect_equal(names(df4Chk), row.names(df4Chk))
expect_equal(names(df4Chk), sprintf("V%d", seq(10)))
expect_identical(as.integer(colSums(is.na(df4Chk))), seq(0, 9))
expect_equal(unname(colMeans(df4Chk, na.rm = TRUE)), c(0.12818389, 0.10747174, 0.09210481, 0.16532417, 0.17717275, 0.18858648, 0.25467175, 0.34689183, 0.59969889, 1))

df4Chk <- mtxF2S(tmpDF, rmvDgn = TRUE)
expect_equal(dim(df4Chk), c(10, 10))
expect_equal(names(df4Chk), row.names(df4Chk))
expect_equal(names(df4Chk), sprintf("V%d", seq(10)))
expect_identical(unname(colSums(is.na(df4Chk))), rep(1, 10))
expect_equal(unname(colMeans(df4Chk, na.rm = TRUE)), c(0.031315436, -0.003749854, -0.032701727, 0.017687781, 0.044318459, -0.046307008, -0.008397862, 0.007457349, 0.076541973, 0.004484645))

df4Chk <- mtxF2S(tmpDF, rmvTrU = TRUE, mtxXps = TRUE)
expect_equal(dim(df4Chk), c(10, 10))
expect_equal(names(df4Chk), row.names(df4Chk))
expect_equal(names(df4Chk), sprintf("V%d", seq(10)))
expect_identical(as.integer(colSums(is.na(df4Chk))), seq(9, 0))
expect_equal(unname(colMeans(df4Chk, na.rm = TRUE)), c(1, 0.49950284, 0.322948658, 0.250480203, 0.26716593, 0.106717426, 0.129390323, 0.128305082, 0.165497776, 0.10403618))

df4Chk <- mtxF2S(tmpDF, rmvTrU = TRUE, rmvDgn = TRUE, mtxXps = TRUE)
expect_equal(dim(df4Chk), c(10, 10))
expect_equal(names(df4Chk), row.names(df4Chk))
expect_equal(names(df4Chk), sprintf("V%d", seq(10)))
expect_identical(as.integer(colSums(is.na(df4Chk))), seq(10, 1))
expect_equal(unname(colMeans(df4Chk, na.rm = TRUE)), c(NA, -0.0009943199, -0.0155770134, 0.0006402703, 0.0839574127, -0.0719390890, -0.0157112896, 0.0037772361, 0.0611849980, 0.0044846446))

df4Chk <- mtxF2S(tmpDF, mtxSps = TRUE)
expect_equal(dim(df4Chk), c(9, 10))
expect_equal(names(df4Chk), c("Variable", sprintf("V%d", seq(1, 9))))
expect_equal(row.names(df4Chk), sprintf("V%d", seq(2, 10)))
expect_identical(unname(colSums(is.na(df4Chk))), c(0, seq(0, 8)))
expect_equal(unname(colMeans(df4Chk[, -1], na.rm = TRUE)), c(0.031315436, -0.004094296, -0.037594503, 0.026211536, 0.012607297, -0.014266906, 0.006228995, 0.020337746, 0.199397772))
})
58 changes: 45 additions & 13 deletions tests/testthat/test-write_omv.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,9 +21,9 @@ test_that("write_omv works", {
expect_s3_class(dtaDbg$dtaFrm, "data.frame")
expect_equal(dim(dtaDbg$dtaFrm), c(60, 7))
expect_equal(names(attributes(dtaDbg$dtaFrm)), c("names", "row.names", "class"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[3]])), c("levels", "class", "description"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[7]])), c("jmv-desc"))
expect_equal(attributes(dtaDbg$dtaFrm[[4]]), NULL)
expect_equal(names(attributes(dtaDbg$dtaFrm[[3]])), c("levels", "class", "description", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[7]])), c("jmv-desc", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[4]])), c("measureType", "dataType"))
expect_equal(lapply(jmvReadWrite::ToothGrowth, class), lapply(dtaDbg$dtaFrm, class))

# add columns with only NAs to the dataset and attach jamovi-attributes to them, write the resulting data frame
Expand All @@ -43,20 +43,20 @@ test_that("write_omv works", {
expect_true(all(grepl("labels", unlist(lapply(dtaDbg$xtdDta, attributes)))))
expect_s3_class(dtaDbg$dtaFrm, "data.frame")
expect_equal(dim(dtaDbg$dtaFrm), c(60, 13))
expect_equal(names(attributes(dtaDbg$dtaFrm)), c("names", "class", "row.names"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[3]])), c("levels", "class", "description"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[7]])), c("jmv-desc"))
expect_equal(names(attributes(dtaDbg$dtaFrm)), c("names", "row.names", "class"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[3]])), c("levels", "class", "description", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[7]])), c("jmv-desc", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[10]])), c("class", "levels", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[11]])), c("class", "levels", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[12]])), c("levels", "class", "measureType", "dataType"))
expect_equal(names(attributes(dtaDbg$dtaFrm[[13]])), c("levels", "class", "measureType", "dataType"))
expect_equal(attributes(dtaDbg$dtaFrm[[4]]), NULL)
expect_equal(attributes(dtaDbg$dtaFrm[[4]]), list(measureType = "Continuous", dataType = "Decimal"))
expect_equal(attributes(dtaDbg$dtaFrm[[8]]), list(measureType = "Continuous", dataType = "Integer"))
expect_equal(attributes(dtaDbg$dtaFrm[[9]]), list(measureType = "Continuous", dataType = "Decimal"))
expect_equal(attributes(dtaDbg$dtaFrm[[10]]), list(class = "factor", levels = character(0), measureType = "Nominal", dataType = "Text"))
expect_equal(attributes(dtaDbg$dtaFrm[[11]]), list(class = c("ordered", "factor"), levels = character(0), measureType = "Ordinal", dataType = "Text"))
expect_equal(attributes(dtaDbg$dtaFrm[[10]]), list(class = "factor", levels = character(0), measureType = "Nominal", dataType = "Integer"))
expect_equal(attributes(dtaDbg$dtaFrm[[11]]), list(class = c("ordered", "factor"), levels = character(0), measureType = "Ordinal", dataType = "Integer"))
expect_equal(attributes(dtaDbg$dtaFrm[[12]]), list(levels = character(0), class = "factor", measureType = "Nominal", dataType = "Text"))
expect_equal(attributes(dtaDbg$dtaFrm[[13]]), list(levels = character(0), class = "factor", measureType = "Nominal", dataType = "Text"))
expect_equal(attributes(dtaDbg$dtaFrm[[13]]), list(levels = character(0), class = "factor", measureType = "Nominal", dataType = "Integer"))
expect_equal(c(lapply(jmvReadWrite::ToothGrowth, class), list(T1 = "integer", T2 = "numeric", T3 = "factor", T4 = c("ordered", "factor"), T5 = "factor", T6 = "factor")),
lapply(dtaDbg$dtaFrm, class))

Expand Down Expand Up @@ -85,8 +85,8 @@ test_that("write_omv works", {
unlink(nmeOut)

expect_error(write_omv(data.frame(T1 = sample(9999, 100), T2 = as.complex(rnorm(100))), fleOut = tempfile(fileext = ".omv")),
regexp = "Variable type complex not implemented\\. Please send the data file that caused this problem to sebastian\\.jentschke@uib\\.no")
expect_equal(write_omv(data.frame(ID = as.factor(seq(100)), T1 = sample(9999, 100), T2 = rnorm(100)), nmeOut, retDbg = TRUE)$mtaDta$field[[1]]$type, "string")
regexp = "Variable type \\w+ not implemented\\. Please send the data file that caused this problem to sebastian\\.jentschke@uib\\.no")
expect_equal(write_omv(data.frame(ID = as.factor(seq(100)), T1 = sample(9999, 100), T2 = rnorm(100)), nmeOut, retDbg = TRUE)$mtaDta$field[[1]]$type, "string")
unlink(nmeOut)

tmpDF <- read_omv(file.path("..", "ToothGrowth.omv"))
Expand Down Expand Up @@ -122,6 +122,10 @@ test_that("write_omv works", {
expect_equal(attr(dtaInp, "jmv-weights"), rep(1, 60))

dtaOut <- jmvReadWrite::ToothGrowth[, 1, drop = FALSE]
write_omv(dtaFrm = dtaOut, fleOut = nmeOut)
expect_true(chkFle(nmeOut, isZIP = TRUE))
expect_true(chkFle(nmeOut, fleCnt = "strings.bin"))
unlink(nmeOut)
dtaOut[c(5, 7, 10), 1] <- as.character(NA)
write_omv(dtaFrm = dtaOut, fleOut = nmeOut)
expect_true(chkFle(nmeOut, isZIP = TRUE))
Expand All @@ -138,7 +142,7 @@ test_that("write_omv works", {
df4Chk <- write_omv(dtaFrm = jmvReadWrite::ToothGrowth, fleOut = nmeOut, retDbg = TRUE)$dtaFrm
Sys.unsetenv("JAMOVI_R_VERSION")
expect_true(all(vapply(df4Chk, function(x) identical(c("measureType", "dataType") %in% names(attributes(x)), c(TRUE, TRUE)), logical(1))))
expect_equal(vapply(df4Chk, function(x) attr(x, "dataType"), character(1), USE.NAMES = FALSE), c("Text", "Text", "Text", "Decimal", "Text", "Decimal", "Decimal"))
expect_equal(vapply(df4Chk, function(x) attr(x, "dataType"), character(1), USE.NAMES = FALSE), c("Text", "Text", "Integer", "Decimal", "Text", "Decimal", "Decimal"))
expect_equal(vapply(df4Chk, function(x) attr(x, "measureType"), character(1), USE.NAMES = FALSE), c("ID", "Nominal", "Nominal", "Continuous", "Ordinal", "Continuous", "Continuous"))
# do not unlink to provoke the error underneath
expect_error(write_omv(dtaFrm = jmvReadWrite::ToothGrowth, fleOut = nmeOut),
Expand All @@ -156,4 +160,32 @@ test_that("write_omv works", {
expect_true(chkFle(nmeOut, isZIP = TRUE))
expect_true(chkFle(nmeOut, fleCnt = "01 empty/analysis"))
unlink(nmeOut)

tmpDF <- data.frame(ID = sprintf("P_%04d", sample(9999, 100)), I = as.integer(sample(1e6, 100)), D = rnorm(100),
OT = factor(sample(c("low", "middle", "high"), 100, replace = TRUE), levels = c("low", "middle", "high"), ordered = TRUE),
ON = factor(sample(seq(7), 100, replace = TRUE), levels = seq(7), ordered = TRUE),
NT = factor(sample(c("low", "middle", "high"), 100, replace = TRUE), levels = c("low", "middle", "high")),
NN = factor(sample(seq(7), 100, replace = TRUE), levels = seq(7)),
CR = sample(c("low", "middle", "high"), 100, replace = TRUE))
attr(tmpDF[["ID"]], "jmv-id") <- TRUE
attr(tmpDF[["ON"]], "values") <- seq(7)
attr(tmpDF[["NN"]], "values") <- seq(7)
attr(tmpDF[["CR"]], "jmv-desc") <- "Trial (is description kept?)"
expect_equal(lapply(lapply(jmvAtt(tmpDF), attributes), names), list(ID = c("jmv-id", "measureType", "dataType"),
I = c("measureType", "dataType"), D = c("measureType", "dataType"),
OT = c("levels", "class", "measureType", "dataType"), ON = c("levels", "class", "values", "measureType", "dataType"),
NT = c("levels", "class", "measureType", "dataType"), NN = c("levels", "class", "values", "measureType", "dataType"),
CR = c("jmv-desc", "measureType", "dataType")))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["ID"]]), use.names = FALSE), c("TRUE", "ID", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["I"]]), use.names = FALSE), c("Continuous", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["D"]]), use.names = FALSE), c("Continuous", "Decimal"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["OT"]]), use.names = FALSE), c("low", "middle", "high", "ordered", "factor", "Ordinal", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["ON"]]), use.names = FALSE), c(sprintf("%d", seq(1:7)), "ordered", "factor", sprintf("%d", seq(1:7)), "Ordinal", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["NT"]]), use.names = FALSE), c("low", "middle", "high", "factor", "Nominal", "Text"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["NN"]]), use.names = FALSE), c(sprintf("%d", seq(1:7)), "factor", sprintf("%d", seq(1:7)), "Nominal", "Integer"))
expect_equal(unlist(attributes(jmvAtt(tmpDF)[["CR"]]), use.names = FALSE), c("Trial (is description kept?)", "Nominal", "Text"))
expect_error(jmvAtt("Trial"), regexp = "^Input data are either not a data frame or have incorrect \\(only one or more than two\\) dimensions\\.")
expect_error(jmvAtt(data.frame()), regexp = "^The first dimension of the input data frame has not the required size \\(0 < 1\\)\\.")
expect_error(jmvAtt(cbind(tmpDF, data.frame(ER = sample(seq.Date(as.Date("2000/01/01"), as.Date("2019/12/31"), by = "day"), 100)))),
regexp = "^\\s+\\w+: Variable type \\w+ not implemented.")
})

0 comments on commit aa8cce9

Please sign in to comment.