diff --git a/DESCRIPTION b/DESCRIPTION index 98aeef6..abe74b0 100644 --- a/DESCRIPTION +++ b/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) for more information on methods and 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 diff --git a/NEWS.md b/NEWS.md index fcd15ce..3397245 100644 --- a/NEWS.md +++ b/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 diff --git a/R/summarize_ds_models.R b/R/summarize_ds_models.R index d4e261f..cb05f88 100644 --- a/R/summarize_ds_models.R +++ b/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 diff --git a/man/summarize_ds_models.Rd b/man/summarize_ds_models.Rd index e1f9e49..27dffbf 100644 --- a/man/summarize_ds_models.Rd +++ b/man/summarize_ds_models.Rd @@ -4,7 +4,13 @@ \alias{summarize_ds_models} \title{Make a table of summary statistics for detection function models} \usage{ -summarize_ds_models(..., sort = "AIC", output = "latex", delta_only = TRUE) +summarize_ds_models( + ..., + models = list(), + sort = "AIC", + output = "latex", + delta_only = TRUE +) } \arguments{ \item{...}{models to be summarised} diff --git a/tests/testthat/test_ds.R b/tests/testthat/test_ds.R index 09eca95..7ce90f3 100644 --- a/tests/testthat/test_ds.R +++ b/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) }) diff --git a/tests/testthat/test_summarize.R b/tests/testthat/test_summarize.R index 467eeff..3b41f5d 100644 --- a/tests/testthat/test_summarize.R +++ b/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]) +})