Pass models in a list to summarize_ds_models

DESCRIPTION

@@ -16,7 +16,7 @@ Description: A simple way of fitting detection functions to distance sampling
     Horvitz-Thompson-like estimator) if survey area information is provided. See
     Miller et al. (2019) <doi:10.18637/jss.v089.i01> for more information on
     methods and <https://examples.distancesampling.org/> for example analyses.
-Version: 2.0.0.9002
+Version: 2.0.0.9003
 URL: https://github.com/DistanceDevelopment/Distance/
 BugReports: https://github.com/DistanceDevelopment/Distance/issues
 Language: en-GB

NEWS.md

@@ -2,6 +2,7 @@
 
 * Fixes issue with print dht2 when multipliers are a data.frame (Issue #179)
 * Fixes bug when including a uniform with no adjustment terms in the summarize_ds_models function (Issue #180)
+* Users to pass a list of models to summarize_ds_models rather than passing them individually. (Issue #)
 
 # Distance 2.0.0
 

R/summarize_ds_models.R

@@ -26,15 +26,31 @@
 #' model_hr <- ds(tee.data,4, key="hr")
 #' summarize_ds_models(model_hr, model_hn, output="plain")
 #'}
-summarize_ds_models <- function(..., sort="AIC", output="latex", delta_only=TRUE){
-
-  # get the models
-  models <- list(...)
-
-  # get the model names
-  model_names <- setdiff(as.character(match.call(expand.dots=TRUE)),
-                         as.character(match.call(expand.dots=FALSE)))
-
+summarize_ds_models <- function(..., models=list(), sort="AIC", output="latex", delta_only=TRUE){
+  # Check to see if the user supplied the model list via the ...
+  tmp <- list(...)
+  if(length(tmp) > 0){
+    # Check if its a list of models - incase the user has passed in via ... instead of models argument
+    if(is(tmp[[1]], "list")){
+      models <- tmp[[1]]
+    }
+  }
+  # Check if user is supplying via new models argument or not
+  if(length(models) == 0){
+    warning("Passing models via ... will be depricated in the next release, please pass models in a list using the models argument.", immediate. = TRUE, call. = FALSE)
+    # get the models from ...
+    models <- tmp
+    # get the model names
+    model_names <- setdiff(as.character(match.call(expand.dots=TRUE)),
+                           as.character(match.call(expand.dots=FALSE)))
+  }else{
+    # get the model names
+    model_names <- names(models)
+    # if it's an unnamed list, give generic names to them
+    if(is.null(model_names)){
+      model_names <- paste("model ", 1:length(models), sep = "")
+    }
+  }
 
   ## checking
   # can't compare models with different truncations

tests/testthat/test_ds.R

@@ -156,8 +156,8 @@ test_that("Uniform does work after all",{
   x1 <- ds(ducknest, key="unif", adjustment = NULL)
   x2 <- ds(ducknest, key="unif", nadj = 1)
   x3 <- ds(ducknest, key="hn", adjustment = NULL)
-  tmp <- summarize_ds_models(x1, x2, x3, 
-                             delta_only = FALSE)
+  tmp <- suppressWarnings(summarize_ds_models(x1, x2, x3, 
+                                              delta_only = FALSE))
   expect_is(tmp, "data.frame")
   expect_equal(nrow(tmp), 3)
 })

tests/testthat/test_summarize.R

@@ -28,14 +28,14 @@ test_that("Error on different truncation distance", {
 ", header=FALSE)
   names(out) <- c("Model", "Key function", "Formula", "C-vM p-value",
                 "$\\hat{P_a}$", "se($\\hat{P_a}$)", "$\\Delta$AIC")
-  expect_equal(summarize_ds_models(t4, t42, t4hr), out, fixed=TRUE, tol=par.tol)
+  expect_equal(suppressWarnings(summarize_ds_models(t4, t42, t4hr)), out, fixed=TRUE, tol=par.tol)
 
   # right truncation different
-  expect_error(summarize_ds_models(t3, t4))
+  expect_error(suppressWarnings(summarize_ds_models(t3, t4)))
   # left
-  expect_error(summarize_ds_models(t4, t14))
+  expect_error(suppressWarnings(summarize_ds_models(t4, t14)))
   # both
-  expect_error(summarize_ds_models(t3, t4, t41))
+  expect_error(suppressWarnings(summarize_ds_models(t3, t4, t41)))
 })
 
 
@@ -57,13 +57,32 @@ test_that("Binning",{
 
   names(out) <- c("Model", "Key function", "Formula", "$\\chi^2$ $p$-value",
                   "$\\hat{P_a}$", "se($\\hat{P_a}$)", "$\\Delta$AIC")
-  expect_equal(summarize_ds_models(cp1, cp11), out, fixed=TRUE, tol=par.tol)
+  expect_equal(suppressWarnings(summarize_ds_models(cp1, cp11)), out, fixed=TRUE, tol=par.tol)
 
   # different bins
-  expect_error(summarize_ds_models(cp1, cp11, cp2))
+  expect_error(suppressWarnings(summarize_ds_models(cp1, cp11, cp2)))
 
   # mixing binned and unbinned
   ncp <- suppressMessages(ds(egdata, key="hn", order=0))
-  expect_error(summarize_ds_models(cp1, ncp))
+  expect_error(suppressWarnings(summarize_ds_models(cp1, ncp)))
 
 })
+
+test_that("Passing in models via a list",{
+  skip_on_cran()
+  data(book.tee.data)
+  tee.data <- subset(book.tee.data$book.tee.dataframe, observer==1)
+  ds.model <- ds(tee.data, 4)
+  ds.model.cos <- ds(tee.data, 4, adjustment="cos", order=2)
+  ds.model.hr <- ds(tee.data, 4, key = "hr", nadj = 0)
+
+  expect_warning(test1 <- summarize_ds_models(ds.model, ds.model.cos, ds.model.hr), "Passing models via ... will be depricated in the next release, please pass models in a list using the models argument.")
+
+  test2 <- summarize_ds_models(models = list(ds.model, ds.model.cos, ds.model.hr))
+
+  expect_identical(test1[,2:7], test2[,2:7])
+
+  test3 <- summarize_ds_models(list(ds.model, ds.model.cos, ds.model.hr))
+
+  expect_identical(test1[,2:7], test3[,2:7])
+})