R Under development (unstable) (2024-07-23 r86915 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 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)
+ }
> 
> 
> proc.time()
   user  system elapsed 
   0.09    0.07    0.15