Merge pull request #33 from weirichs/cran_submission_0.7.6

Cran submission 0.7.6

DESCRIPTION

@@ -1,31 +1,31 @@
-Package: eatTools
-Type: Package
-Title: Miscellaneous Functions for the Analysis of Educational Assessments
-Version: 0.7.5
-Depends: R (>= 4.0.0)
-Imports: 
-    stats,
-    data.table,
-    stringi,
-    checkmate
-Authors@R: c(
-    person("Sebastian", "Weirich", email = "sebastian.weirich@iqb.hu-berlin.de", role = c("aut", "cre")),
-    person("Martin", "Hecht", role = c("aut")),
-    person("Karoline", "Sachse", role = c("aut")),
-    person("Benjamin", "Becker", role = c("aut")),
-    person("Nicole", "Mahler", role = c("aut")),
-    person("Edna", "Grewers", role = c("ctb")))
-Description:
-   Miscellaneous functions for data cleaning and data analysis of educational assessments. Includes functions for descriptive 
-   analyses, character vector manipulations and weighted statistics. Mainly a lightweight dependency for the packages 'eatRep', 
-   'eatGADS', 'eatPrep' and 'eatModel' (which will be subsequently submitted to 'CRAN').
-   The function for defining (weighted) contrasts in weighted effect coding refers to
-   te Grotenhuis et al. (2017) <doi:10.1007/s00038-016-0901-1>.
-   Functions for weighted statistics refer to
-   Wolter (2007) <doi:10.1007/978-0-387-35099-8>.
-License: GPL (>= 2)
-URL: https://github.com/weirichs/eatTools
-Suggests:
-    testthat,
-    covr
-NeedsCompilation: no
+Package: eatTools
+Type: Package
+Title: Miscellaneous Functions for the Analysis of Educational Assessments
+Version: 0.7.6
+Depends: R (>= 4.0.0)
+Imports: 
+    stats,
+    data.table,
+    stringi,
+    checkmate
+Authors@R: c(
+    person("Sebastian", "Weirich", email = "sebastian.weirich@iqb.hu-berlin.de", role = c("aut", "cre")),
+    person("Martin", "Hecht", role = c("aut")),
+    person("Karoline", "Sachse", role = c("aut")),
+    person("Benjamin", "Becker", role = c("aut")),
+    person("Nicole", "Mahler", role = c("aut")),
+    person("Edna", "Grewers", role = c("ctb")))
+Description:
+   Miscellaneous functions for data cleaning and data analysis of educational assessments. Includes functions for descriptive 
+   analyses, character vector manipulations and weighted statistics. Mainly a lightweight dependency for the packages 'eatRep', 
+   'eatGADS', 'eatPrep' and 'eatModel' (which will be subsequently submitted to 'CRAN').
+   The function for defining (weighted) contrasts in weighted effect coding refers to
+   te Grotenhuis et al. (2017) <doi:10.1007/s00038-016-0901-1>.
+   Functions for weighted statistics refer to
+   Wolter (2007) <doi:10.1007/978-0-387-35099-8>.
+License: GPL (>= 2)
+URL: https://github.com/weirichs/eatTools
+Suggests:
+    testthat,
+    covr
+NeedsCompilation: no

NEWS.md

@@ -1,8 +1,10 @@
+# eatTools 0.7.6
+
+* add argument checks using the checkmate package
 * bugfix in `halveString()` for splitting at the last instance of a regular expression
-* new function `rbind_fill_vector()` allows `rbind()` for non-dimensional vectors of unequal length, filling empty entries with NA
+* new function `rbind_fill_vector()` allows `rbind()` for unidimensional vectors of unequal length, filling empty entries with NA
 * new operator `%$$%` works for lists similar to `$` but gives error instead of NULL if the corresponding list element does not exist
 
-
 # eatTools 0.7.5
 
 * internal fixes to tests (removed language dependency)

R/existsBackgroundVariables.r

@@ -1,11 +1,10 @@
 existsBackgroundVariables <- function(dat, variable, warnIfMissing = FALSE, stopIfMissingOnVars = NULL )  {
            checkmate::assert_data_frame(dat)
-           checkmate::assert_vector(variable, null.ok = TRUE)
+           checkmate::assert_vector(variable, null.ok = TRUE, unique=TRUE)
            checkmate::assert_logical(warnIfMissing, len = 1)
            checkmate::assert_character(stopIfMissingOnVars, null.ok = TRUE)
            if(is.null(variable))  {return(NULL)}
            if(any(is.na(variable))) {stop("'variable' must not contain missing values (i.e., NA values).")}
-           if(length(variable) != length(unique(variable)) ) {stop("Variable definition is not unique.")}
            if(is.factor(variable))    {
 	             v  <- as.character(variable)
       				 rN <- removeNumeric(v)

R/facToChar.r

@@ -1,5 +1,5 @@
 facToChar <- function ( dataFrame, from = "factor", to = "character" ) {
-             if(!"data.frame" %in% class(dataFrame)) {stop("'dataFrame' must be of class 'data.frame'.")}
+             dataFrame <- makeDataFrame(dataFrame)
              classes <- which( unlist(lapply(dataFrame,class)) == from)
              if(length(classes)>0) {
                 for (u in classes) { eval(parse(text=paste("dataFrame[,u] <- as.",to,"(dataFrame[,u])",sep="") )) }}

R/makeDataFrame.r

@@ -1,11 +1,11 @@
 makeDataFrame <- function(dat, name = "dat", minRow = 1, onlyWarn=TRUE) {
-  if(inherits(dat, c("tbl", "data.table"))) {
+  if(inherits(dat, c("tbl", "data.table", "matrix", "list"))) {
     old_classes <- paste(class(dat), collapse="', '")
     message("Convert '", name, "' of class '", old_classes, "' to a data.frame.")
       dat <- data.frame ( dat, stringsAsFactors = FALSE)
   }
   if(!inherits(dat, c("data.frame"))) {
-    stop("'", name, "' is neither a 'data.frame', 'tibble' or 'data.table' object.")
+    stop("'", name, "' is neither a 'data.frame', 'matrix', 'tibble' or 'data.table' object.")
   }
     if(nrow(dat) < minRow) {
         if(onlyWarn) {

R/makeTria.r

@@ -1,11 +1,11 @@
 ### Matrix dreieckig machen
 makeTria <- function(dfr) {
         dfr <- makeDataFrame(dfr)
-        cols <- sort(sapply(dfr[,-1, drop=FALSE],
-                FUN = function (d) {min(which(!is.na(d))) }))
-        dfr  <- dfr[,c(colnames(dfr)[1], names(cols))]
-        rows <- sort(apply(dfr[,-1], MARGIN = 1,
-                FUN = function (d) {max(which(!is.na(d)))}), decreasing=FALSE, index.return=TRUE)[["ix"]]
-        dfr  <- dfr[rows,]
+        checkmate::assert_character(dfr[,1], unique = TRUE)
+        cols <- sort(sapply(dfr[,-1, drop=FALSE], FUN = function (d) {length(which(is.na(d))) }))
+        stopifnot(all(cols == 0:(ncol(dfr)-2)))
+        rows <- sort(apply(dfr[,-1], MARGIN = 1, FUN = function (d) {length(which(is.na(d)))}), decreasing = TRUE, index.return=TRUE)
+        stopifnot(all(sort(rows[["x"]]) == 0:(nrow(dfr)-1)))
+        dfr  <- dfr[rows[["ix"]],c(colnames(dfr)[1], names(cols))]
         rownames(dfr) <- NULL
         return(dfr)}

R/recodeLookup.r

@@ -1,7 +1,7 @@
 # var    ... variable
 # lookup ... data.frame mit zwei spalten; erste spalte: alte Werte; zweite Spalte: neue Werte
 recodeLookup <- function (var, lookup) {
-        if(!is.data.frame(lookup) && !is.matrix(lookup)) {stop("The lookup table must be a data.frame or matrix.")}     ### checks ...
+        lookup <- makeDataFrame(lookup)
         if(ncol(lookup) != 2) {stop("The lookup table must have two colums.")}     ### checks ...
         if(length(unique(lookup[,1])) < nrow(lookup) ) { stop("Old values in lookup table are not unique.")}
         haven_labelled <- lapply(lookup, function(x) {

R/tableUnlist.r

@@ -1,10 +1,7 @@
 ### Hilfsfunktion, ersetzt table(unlist( ... ))
 tableUnlist <- function(dataFrame, useNA = c("no","ifany", "always"))   {
                 useNA<- match.arg(useNA)
-                if( !"data.frame" %in% class(dataFrame) ) {
-                   warning("Argument of 'tableUnlist' has to be of class 'data.frame'. Object will be converted to data.frame.")
-                   dataFrame <- data.frame(dataFrame, stringsAsFactors=FALSE)
-                }
+                dataFrame <- makeDataFrame(dataFrame)
                 vek  <- do.call("c", lapply(dataFrame, FUN = function ( col ) { return(col)}))
                 freqT<- table(vek, useNA = useNA)
                 isna <- which(is.na(names(freqT)))

man/makeTria.rd

@@ -12,6 +12,16 @@ makeTria (dfr)}
 A data frame consisting of a row name column and a square matrix.
 }
 }
+\details{
+covariance/correlation matrices which are inherently symmetrical are often displayed
+in a space-saving manner by only showing the upper or lower triangular part, omitting the
+symmetrical counterpart. In R, covariance/correlation matrices tend to be displayed with their
+upper and lower halves. Whereas \code{\link[base]{lower.tri}} and \code{\link[base]{upper.tri}}
+allows to replace upper or lower half with \code{NA}s, the triangular shape could then be lost if the
+covariance/correlation matrix was provided in a long format and reshaped afterwards. \code{makeTria}
+sorts rows and colums appropriately to provide triangular shape if redundant entries are replaced by
+NA. Please note that the functions expects row names in the first column of the input data.frame.
+}
 \value{
 data frame.
 }

man/operator.Rd

@@ -25,6 +25,8 @@ x \%$$\% y
 \examples{
 \dontrun{
 x <- list(value1 = 14, value2 = NULL)
+x$value2                 # NULL
 x$value_not_defined      # NULL
+x\%$$\%value2            # NULL
 x\%$$\%value_not_defined # error
 }}

man/removePattern.Rd

@@ -1,32 +1,20 @@
 \name{removePattern}
 \alias{removePattern}
-%- Also NEED an '\alias' for EACH other topic documented here.
 \title{Removes a specified pattern from a string.}
 \description{Function remove a specified string from a character vector.}
 \usage{
 removePattern ( string, pattern)}
-%- maybe also 'usage' for other objects documented here.
 \arguments{
   \item{string}{
-%%     ~~Describe \code{file} here~~
 a character vector
 }
   \item{pattern}{
-%%     ~~Describe \code{file} here~~
-a character pattern
+a character pattern of length 1
 }
 }
 \value{
-%%  ~Describe the value returned
-%%  If it is a LIST, use
-%%  \item{comp1 }{Description of 'comp1'}
-%%  \item{comp2 }{Description of 'comp2'}
-%% ...
 a character string
 }
-\author{
-Sebastian Weirich
-}
 \examples{
 str <- c(".d1.nh.120", "empty", "110", ".nh.dgd", "only.nh")
 removePattern(str, ".nh.")

tests/testthat/test_insert.col.R

@@ -2,7 +2,7 @@
 
 test_that("Errors", {
   expect_error(insert.col(1),
-               "'dat' is neither a 'data.frame', 'tibble' or 'data.table' object.")
+               "'dat' is neither a 'data.frame', 'matrix', 'tibble' or 'data.table' object.")
 })
 
 ###

tests/testthat/test_makeDataFrame.R

@@ -6,9 +6,9 @@ rownames(mtcars_norownames) <- NULL
 
 test_that("data.table", {
   test_dt <- data.table::as.data.table(mtcars)
-  expect_message(out <- makeDataFrame(test_dt),
+ expect_message(out <- makeDataFrame(test_dt),
                  "Convert 'dat' of class 'data.table', 'data.frame' to a data.frame.")
-  expect_equal(out, mtcars_norownames)
+   expect_equal(out, mtcars_norownames)
 })
 
 test_that("tibble", {
@@ -25,5 +25,5 @@ test_that("data.frame", {
 
 test_that("other", {
   expect_error(out <- makeDataFrame(1),
-               "'dat' is neither a 'data.frame', 'tibble' or 'data.table' object.")
+               "'dat' is neither a 'data.frame', 'matrix', 'tibble' or 'data.table' object.")
 })

tests/testthat/test_recodeLookup.R

@@ -2,7 +2,7 @@
 
 test_that("Errors", {
   expect_error(recodeLookup(1:3, "a"),
-               "The lookup table must be a data.frame or matrix.")
+               "'dat' is neither a 'data.frame', 'matrix', 'tibble' or 'data.table' object.")
   expect_error(recodeLookup(1:3, mtcars),
                "The lookup table must have two colums.")
   expect_error(recodeLookup(1:3, data.frame(old = rep(1, 2), new = 2:1)),

tests/testthat/test_tableUnlist.R

@@ -13,5 +13,5 @@ test_that("tableUnlist", {
 
 ### test fuer warnings
 test_that("tableUnlist warnings", {
-  expect_warning(tableUnlist(dataFrame=as.matrix(df)), "Argument of 'tableUnlist' has to be of class 'data.frame'. Object will be converted to data.frame.", fixed = TRUE)
+  expect_message(tableUnlist(dataFrame=as.matrix(df)), "Convert 'dat' of class 'matrix', 'array' to a data.frame.")
 })