TestPredationMatrixToLinks <- function() { # Square matrices n <- paste('S',1:10) # Names for testing m <- matrix(0, ncol=10, nrow=10, dimnames=list(n,n)) AssertEqual(0, nrow(PredationMatrixToLinks(m))) m <- matrix(0, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- 1 AssertEqual(data.frame(resource='S 1', consumer='S 1', stringsAsFactors=FALSE), PredationMatrixToLinks(m)) m <- matrix(0, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- m[10,10] <- 1 AssertEqual(data.frame(resource=c('S 1','S 10'), consumer=c('S 1','S 10'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) m <- matrix(0, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- m[10,10] <- m[1,10] <- 1 AssertEqual(data.frame(resource=c('S 1','S 1','S 10'), consumer=c('S 1','S 10','S 10'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) t1 <- PredationMatrixToLinks(PredationMatrix(TL84)) t2 <- TLPS(TL84)[,c('resource', 'consumer')] AssertEqual(t1, t2) # Logical values m <- matrix(0, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- m[10,10] <- TRUE AssertEqual(data.frame(resource=c('S 1','S 10'), consumer=c('S 1','S 10'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # NA m <- matrix(NA, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- m[10,10] <- TRUE AssertEqual(data.frame(resource=c('S 1','S 10'), consumer=c('S 1','S 10'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # Values other than 1 m <- matrix(NA, ncol=10, nrow=10, dimnames=list(n,n)) m[1,1] <- m[10,10] <- -10 AssertEqual(data.frame(resource=c('S 1','S 10'), consumer=c('S 1','S 10'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # A non-square matrix m <- matrix(0, ncol=3, nrow=2) colnames(m) <- letters[1:3] rownames(m) <- letters[4:5] m[1,1] <- 0.3 m[2,1] <- 0.7 m[1,2] <- 1 m[1,3] <- 0.1 m[2,3] <- 0.9 AssertEqual(data.frame(resource=c('d','e','d','d','e'), consumer=c('a','a','b','c','c'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # The same non-square matrix with the link property extracted AssertEqual(data.frame(resource=c('d','e','d','d','e'), consumer=c('a','a','b','c','c'), diet.fraction=c(0.3,0.7,1,0.1,0.9), stringsAsFactors=FALSE), PredationMatrixToLinks(m, link.property='diet.fraction')) # A data.frame as input m <- data.frame(a=c(1,1), b=c(1,0), c=c(1,1), row.names=c('d', 'e')) AssertEqual(data.frame(resource=c('d','e','d','d','e'), consumer=c('a','a','b','c','c'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # A data.frame with a link property m <- data.frame(a=c(0.3,0.7), b=c(1,0), c=c(0.1,0.9), row.names=c('d', 'e')) AssertEqual(data.frame(resource=c('d','e','d','d','e'), consumer=c('a','a','b','c','c'), stringsAsFactors=FALSE), PredationMatrixToLinks(m)) # The same data.frame with the link property extracted AssertEqual(data.frame(resource=c('d','e','d','d','e'), consumer=c('a','a','b','c','c'), diet.fraction=c(0.3,0.7,1,0.1,0.9), stringsAsFactors=FALSE), PredationMatrixToLinks(m, link.property='diet.fraction')) # Not a matrix AssertRaises(PredationMatrixToLinks(NA)) AssertRaises(PredationMatrixToLinks(1:10)) AssertRaises(PredationMatrixToLinks(NA)) # No names AssertRaises(PredationMatrixToLinks(matrix(0, ncol=10, nrow=10))) } TestStripWhiteSpace <- function() { AssertEqual('', cheddar:::.StripWhitespace('')) AssertEqual('', cheddar:::.StripWhitespace(' ')) AssertEqual('', cheddar:::.StripWhitespace(' ')) AssertEqual('a', cheddar:::.StripWhitespace('a')) AssertEqual('a', cheddar:::.StripWhitespace('a ')) AssertEqual('a', cheddar:::.StripWhitespace('a ')) AssertEqual('a', cheddar:::.StripWhitespace(' a')) AssertEqual('a', cheddar:::.StripWhitespace(' a')) AssertEqual('a', cheddar:::.StripWhitespace(' a ')) AssertEqual('a', cheddar:::.StripWhitespace(' a ')) AssertEqual('a b c', cheddar:::.StripWhitespace('a b c')) AssertEqual('a b c', cheddar:::.StripWhitespace(' a b c')) AssertEqual('a b c', cheddar:::.StripWhitespace(' a b c ')) AssertEqual('\\.[]a b c.$^-+.;/"', cheddar:::.StripWhitespace(' \\.[]a b c.$^-+.;/" ')) } xxxTestFormatLM <- function() { # TODO Test disabled becuase it fails on R-devel as of 2020-01-26. # The example plot in CheddarQuickstart vignette looks OK so I think it is # the test that is at fault. # Values to 5 dp, no r squared models <- NvMLinearRegressions(TL84) res <- sapply(models, FormatLM, dp=5, r.squared=FALSE) expected <- expression(all = "y" == "-2.68628" ~ structure("-", .Names = "x") ~ "0.82711" * "x" * ""*"" * "", producer = "y" == "2.55834" ~ structure("-", .Names = "x") ~ "0.40715" * "x" * "" * "" * "", invertebrate = "y" == "1.46561" ~ structure("-", .Names = "x") ~ "0.32432" * "x" * "" * "" * "", vert.ecto = "y" == "-34.66097" ~ structure("-", .Names = "x") ~ "11.62787" * "x" * "" * "" * "") AssertEqual(expected, res) # Values to 2 dp, lots of info models <- NvMLinearRegressions(TL84) res <- sapply(models, FormatLM, r=TRUE, slope.95.ci=TRUE, ci.plus.minus.style=TRUE) expected <- expression(all = "y" == "-2.69" ~ structure("-", .Names = "x") ~ "0.83" * "x" * ("" %+-% 0.1 ~ "(95% CI, n=56)") * ("," ~ r == "-0.92") * ("," ~ r^2 == "0.84"), producer = "y" == "2.56" ~ structure("-", .Names = "x") ~ "0.41" * "x" * ("" %+-% 0.23 ~ "(95% CI, n=31)") * ("," ~ r == "-0.56") * ("," ~ r^2 == "0.32"), invertebrate = "y" == "1.47" ~ structure("-", .Names = "x") ~ "0.32" * "x" * ("" %+-% 0.24 ~ "(95% CI, n=22)") * ("," ~ r == "-0.54") * ("," ~ r^2 == "0.29"), vert.ecto = "y" == "-34.66" ~ structure("-", .Names = "x") ~ "11.63" * "x" * ("" %+-% 63.36 ~ "(95% CI, n=3)") * ("," ~ r == "-0.92") * ("," ~ r^2 == "0.84")) AssertEqual(expected, res) # names other than x and y m <- lm(Log10N(TL84) ~ Log10M(TL84)) res <- FormatLM(m, r=TRUE, slope.95.ci=TRUE, ci.plus.minus.style=TRUE) expected <- expression("Log10N(TL84)" == "-2.69" ~ structure("-", .Names = "Log10M(TL84)")~ "0.83" * "Log10M(TL84)" * ("" %+-% 0.1 ~ "(95% CI, n=56)") * ("," ~ r == "-0.92") * ("," ~ r^2 == "0.84")) AssertEqual(expected, res) }