From 0d46869d92f1c8ed805d3e0de382796574e1b6cb Mon Sep 17 00:00:00 2001 From: Steve Vissault Date: Fri, 17 Feb 2017 15:39:08 -0500 Subject: [PATCH] cover unit tests as.alienData() - issue #18 --- R/as.alienData.R | 21 ++++++--------- tests/testthat/test-alienData.R | 46 ++++++++++++++++++++++++++------- 2 files changed, 44 insertions(+), 23 deletions(-) diff --git a/R/as.alienData.R b/R/as.alienData.R index 81fbd38..bf4b201 100755 --- a/R/as.alienData.R +++ b/R/as.alienData.R @@ -67,8 +67,7 @@ as.alienData <- function(idObs = NULL, interactPair = NULL, coOcc = NULL, coAbun # Check for duplicates rows if (nrow(idObs[duplicated(idObs), ]) != 0) { - stop(cat("some idObs entries are duplicated: \n", idObs[duplicated(idObs), - ])) + stop("some idObs entries are duplicated") } # Cast all columns has factors @@ -117,6 +116,8 @@ as.alienData <- function(idObs = NULL, interactPair = NULL, coOcc = NULL, coAbun ## Check if idFrom and idTo are in levels(idSp) or levels(idInd) and not both ## interactPair are observations at species level OR at individual level but not ## both + + if (any(levels(interactPair$idFrom) %in% levels(idObs$idSp)) & any(levels(interactPair$idFrom) %in% levels(idObs$idInd))) { stop("'idFrom' values belongs to 'idSp' and 'idInd' in 'idObs'. Interaction can't be at the species AND individual levels") @@ -131,13 +132,11 @@ as.alienData <- function(idObs = NULL, interactPair = NULL, coOcc = NULL, coAbun if (any(c(levels(interactPair$idFrom), levels(interactPair$idTo)) %in% levels(idObs$idSp))) { if (!all(levels(interactPair$idFrom) %in% levels(idObs$idSp))) { - stop(cat("Some species ids in 'idFrom' are not in 'idObs': \n", levels(interactPair$idFrom)[which(!levels(interactPair$idFrom) %in% - levels(idObs$idSp))])) + stop("Some species ids in 'idFrom' are not in 'idObs'") } if (!all(levels(interactPair$idTo) %in% levels(idObs$idSp))) { - stop(cat("Some species ids in 'idTo' are not in 'idObs': \n", levels(interactPair$idFrom)[which(!levels(interactPair$idFrom) %in% - levels(idObs$idSp))])) + stop("Some species ids in 'idTo' are not in 'idObs'") } } @@ -146,14 +145,11 @@ as.alienData <- function(idObs = NULL, interactPair = NULL, coOcc = NULL, coAbun if (any(c(levels(interactPair$idFrom), levels(interactPair$idTo)) %in% levels(idObs$idInd))) { if (!all(levels(interactPair$idFrom) %in% levels(idObs$idInd))) { - stop(cat("Some individus ids in 'idFrom' are not in 'idObs': \n", - levels(interactPair$idFrom)[which(!levels(interactPair$idFrom) %in% - levels(idObs$idInd))])) + stop("Some individus ids in 'idFrom' are not in 'idObs'") } if (!all(levels(interactPair$idTo) %in% levels(idObs$idInd))) { - stop(cat("Some individus ids in 'idTo' are not in 'idObs': \n", levels(interactPair$idFrom)[which(!levels(interactPair$idFrom) %in% - levels(idObs$idInd))])) + stop("Some individus ids in 'idTo' are not in 'idObs'") } } @@ -161,8 +157,7 @@ as.alienData <- function(idObs = NULL, interactPair = NULL, coOcc = NULL, coAbun # Check if rows are not duplicated if (nrow(interactPair[duplicated(interactPair[, c("idFrom", "idTo")]), ]) != 0) { - stop(cat("Some 'idFrom' and 'idTo' are duplicated:\n", interactPair[duplicated(interactPair[, - c("idFrom", "idTo")]), ])) + stop("Some 'idFrom' and 'idTo' are duplicated") } } diff --git a/tests/testthat/test-alienData.R b/tests/testthat/test-alienData.R index 91d7cd7..fabb301 100644 --- a/tests/testthat/test-alienData.R +++ b/tests/testthat/test-alienData.R @@ -1,16 +1,42 @@ context("alienData function") -load('./argsAlienData.RData') -out <- as.alienData(idObs=idObs,interactPair=interactPair,traitSp=traitSp,traitInd=traitInd,verbose=FALSE) - -test_that("check data structure", { - expect_is(out, "alienData") - # Even if items from the list are NULL, all items have to be returned - expect_equal(names(out),c("idObs","interactSp","interactInd","coOcc","coAbund","siteEnv","traitSp","traitInd","phylo")) -}) +# load('./argsAlienData.RData') +# out <- as.alienData(idObs=idObs,interactPair=interactPair,traitSp=traitSp,traitInd=traitInd,verbose=FALSE) +# +# test_that("check data structure", { +# expect_is(out, "alienData") +# # Even if items from the list are NULL, all items have to be returned +# expect_equal(names(out),c("idObs","interactSp","interactInd","coOcc","coAbund","siteEnv","traitSp","traitInd","phylo")) +# }) test_that("check data integrity", { - # create fake data - idObs <- data.frame(idSite=rep(3,c("")), idTime=NULL) + + # Generate fake data for idObs + len <- 3 + sites <- sample(paste("site",letters[1:3],sep="_"),len,replace=TRUE) # 3 sites + sp <- paste0("sp",sample(1:len,len,replace=TRUE)) # 3 species + ind <- 1:len # 3 individus + idObs <- data.frame(idSite=sites,idTime=rep(NA,len),idSp=sp, idInd=ind,stringsAsFactors=FALSE) + + interactPair <- data.frame(idTo=c("1","sp1"),idFrom=c("1","2"),strength=c(NA,NA),verbose=FALSE,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"'idTo' values belongs to 'idSp' and 'idInd' in 'idObs'. Interaction can't be at the species AND individual levels") + + interactPair <- data.frame(idTo=c("1","2"),idFrom=c("sp1","2"),strength=c(NA,NA),verbose=FALSE,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"'idFrom' values belongs to 'idSp' and 'idInd' in 'idObs'. Interaction can't be at the species AND individual levels") + + interactPair <- data.frame(idTo="sp4",idFrom="sp1",strength=NA,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"Some species ids in 'idTo' are not in 'idObs'") + + interactPair <- data.frame(idTo="4",idFrom="1",strength=NA,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"Some individus ids in 'idTo' are not in 'idObs'") + + interactPair <- data.frame(idTo="sp1",idFrom="sp4",strength=NA,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"Some species ids in 'idFrom' are not in 'idObs'") + + interactPair <- data.frame(idTo="1",idFrom="4",strength=NA,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"Some individus ids in 'idFrom' are not in 'idObs'") + + interactPair <- data.frame(idTo=c("2","2","3"),idFrom=c("2","2","2"),strength=c(NA,NA,NA),verbose=FALSE,stringsAsFactors=FALSE) + expect_error(as.alienData(idObs=idObs, interactPair=interactPair,verbose=FALSE),"Some 'idFrom' and 'idTo' are duplicated") })