- Added more tests for niche Breadth tests #19

GotelliLab · Feb 18, 2015 · 88a8df8 · 88a8df8
1 parent 0e5bf9d
commit 88a8df8
Show file tree

Hide file tree

Showing 4 changed files with 52 additions and 9 deletions.
diff --git a/R/coccurrence_null.R b/R/coccurrence_null.R
@@ -75,8 +75,8 @@ summary.coocnullmod <- function(object,...)
   cat("Reproducible: ",nullmodObj$Reproducible,  "\n")
   cat("Number of Replications: ",nullmodObj$nReps,  "\n")
   cat("Elapsed Time: ", nullmodObj$Elapsed.Time, "\n")
-  cat("Metric: ", nullmodObj$metric,  "\n")
-  cat("Algorithm: ", nullmodObj$algo,  "\n") 
+  cat("Metric: ", nullmodObj$Metric,  "\n")
+  cat("Algorithm: ", nullmodObj$Algorithm,  "\n") 
 
   cat("Observed Index: ", format(nullmodObj$Obs,digits=5),  "\n")
   cat("Mean Of Simulated Index: ",format(mean(nullmodObj$Sim),digits=5),  "\n")

diff --git a/R/niche_overlap_null.R b/R/niche_overlap_null.R
@@ -2,7 +2,7 @@
 #'@description Create a niche overlap null model
 #'@param speciesData a dataframe <put some guidelines in here>
 #'@param algo the algorithm to use, must be "ra1", "ra2", "ra3", "ra4"
-#'@param metric the metric used to caluclate the null model: choices are "Pianka", "Czekanowski", "Pianka.var", "Czekanowski.var", "Pianka.skew", "Czekanowski.skew"; default is Pianka
+#'@param metric the metric used to caluclate the null model: choices are "pianka", "czekanowski", "pianka_var", "czekanowski_var", "pianka_skew", "czekanowski_skew"; default is pianka
 #'@param nReps the number of replicates to run the null model.
 #'@param rowNames Does your dataframe have row names? If yes, they are stripped, otherwise FALSE for data that has no row names
 #'@param saveSeed TRUE or FALSE.  If TRUE the current seed is saved so the simulation can be repeated
@@ -22,7 +22,7 @@
 #'
 #'@export
 
-niche_null_model <- function(speciesData, algo = "ra3", metric = "Pianka", nReps = 1000, rowNames = TRUE,algoOpts = list(),metricOpts = list(),saveSeed=TRUE){
+niche_null_model <- function(speciesData, algo = "ra3", metric = "pianka", nReps = 1000, rowNames = TRUE,algoOpts = list(),metricOpts = list(),saveSeed=TRUE){
   aChoice <- c("ra1","ra2","ra3","ra4")
   mChoice<- c("pianka", "czekanowski", "pianka_var", "czekanowski_var", "pianka_skew", "czekanowski_skew")
 
@@ -50,8 +50,8 @@ summary.nichenullmod <- function(object,...)
   cat("Reproducible: ",nullmodObj$SaveSeed,  "\n")
   cat("Number of Replications: ",nullmodObj$nReps,  "\n")
   cat("Elapsed Time: ", nullmodObj$Elapsed.Time, "\n")
-  cat("Metric: ", nullmodObj$metric,  "\n")
-  cat("Algorithm: ", nullmodObj$algorithm,  "\n") 
+  cat("Metric: ", nullmodObj$Metric,  "\n")
+  cat("Algorithm: ", nullmodObj$Algorithm,  "\n") 
 
   cat("Observed Index: ", format(nullmodObj$Obs,digits=5),  "\n")
   cat("Mean Of Simulated Index: ",format(mean(nullmodObj$Sim),digits=5),  "\n")

diff --git a/R/sizeratio_null.R b/R/sizeratio_null.R
@@ -33,7 +33,7 @@
 #'
 #'@export
 
-size_null_model <- function(speciesData, algo = "Uniform.Size", metric = "Var.Ratio", nReps = 1000, rowNames = TRUE, saveSeed = FALSE, algoOpts = list(), metricOpts = list()){
+size_null_model <- function(speciesData, algo = "size_uniform", metric = "var_ratio", nReps = 1000, rowNames = TRUE, saveSeed = FALSE, algoOpts = list(), metricOpts = list()){
 
   mChoice<- c("min_diff", "min_ratio", "var_diff", "var_ratio")
   aChoice <- c("size_uniform", "size_uniform_user", "size_source_pool", "size_gamma")
@@ -62,8 +62,8 @@ summary.sizenullmod <- function(object,...)
   cat("Reproducible: ",nullmodObj$SaveSeed,  "\n")
   cat("Number of Replications: ",nullmodObj$nReps,  "\n")
   cat("Elapsed Time: ", nullmodObj$Elapsed.Time, "\n")
-  cat("Metric: ", nullmodObj$metric,  "\n")
-  cat("Algorithm: ", nullmodObj$algo,  "\n") 
+  cat("Metric: ", nullmodObj$Metric,  "\n")
+  cat("Algorithm: ", nullmodObj$Algorithm,  "\n") 
 
   cat("Observed Index: ", format(nullmodObj$Obs,digits=5),  "\n")
   cat("Mean Of Simulated Index: ",format(mean(nullmodObj$Sim),digits=5),  "\n")

diff --git a/tests/testthat/test_nichebreadth.R b/tests/testthat/test_nichebreadth.R
@@ -39,6 +39,49 @@ test_that("ra4 algorithm works:",{
 }
 )
 
+test_that("pianka metric works:"{
+expect_true(is.numeric(pianka(ra1())))
+expect_true(is.numeric(pianka(ra4(macwarb[,2:5]))))
+expect_true(pianka(ra4(macwarb[,2:5])) > .5 )
+
+})
+
+test_that("czekanowski metric works:"{
+  expect_true(is.numeric(czekanowski(ra1())))
+  expect_true(is.numeric(czekanowski(ra4(macwarb[,2:5]))))
+  expect_true(czekanowski(ra4(macwarb[,2:5])) > .5 )
+
+})
+
+test_that("pianka_var metric works:"{
+  expect_true(is.numeric(pianka_var(ra1())))
+  expect_true(is.numeric(pianka_var(ra4(macwarb[,2:5]))))
+  expect_true(pianka_var(ra4(macwarb[,2:5])) < .5 )
+
+})
+
+
+test_that("czekanowski_var metric works:"{
+  expect_true(is.numeric(czekanowski_var(ra1())))
+  expect_true(is.numeric(czekanowski_var(ra4(macwarb[,2:5]))))
+  expect_true(czekanowski_var(ra4(macwarb[,2:5])) < .5 )
+
+})
+
+test_that("pianka_skew metric works:"{
+  expect_true(is.numeric(pianka_skew(ra1())))
+  expect_true(is.numeric(pianka_skew(ra4(macwarb[,2:5]))))
+
+})
+
+
+test_that("czekanowski_skew metric works:"{
+  expect_true(is.numeric(czekanowski_skew(ra1())))
+  expect_true(is.numeric(czekanowski_skew(ra4(macwarb[,2:5]))))  
+})
+
+
+