DistanceDevelopment / Distance

Simple distance sampling analysis
GNU General Public License v3.0
9 stars 8 forks source link

`summarize_ds_models()` from a (named) list of model objects #149

Open wlangera opened 1 year ago

wlangera commented 1 year ago

To improve automatisation of model selection, I would propose that the function summarize_ds_models() could take a (named) list with models objects. These could be generated from a for loop for example iterating between different key functions and formulas.

Here is a small example of what I mean:

# read in data
library(Distance)
data(book.tee.data)
tee.data <- subset(book.tee.data$book.tee.dataframe, observer == 1)

out_models <- list()
model_names <- c()
for (k in c("hn", "hr")) {
  # create model names and fit models
  model_name <- paste("dsmodel", k, sep = "_")
  ds_model <- ds(tee.data, 4, key = k)

  # put models and model names in list 
  out_models <- c(out_models, list(ds_model))
  model_names <- c(model_names, model_name)
}
names(out_models) <- model_names

# get summary of fitted models
summarize_ds_models(out_models)

At this point this is not possible and you need to add every model object manually in the summarize_ds_models() function. The following code keeps both original functionality and also provides the possiblility of taking a list as argument, which makes it possible to run the code above. ORIGINAL:

# ...

  # 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)))

# ...

NEW:

# ...

  ## get the models
  # create list when ... not a list
  if (class(try(class(...) != "list", silent = TRUE)) == "try-error") {
    models <- list(...)
    # get the model names
    model_names <- setdiff(as.character(match.call(expand.dots=TRUE)),
                           as.character(match.call(expand.dots=FALSE)))
  } else {
    if (class(...) != "list") {
      models <- list(...)
      # get the model names
      model_names <- setdiff(as.character(match.call(expand.dots=TRUE)),
                             as.character(match.call(expand.dots=FALSE)))
    } else {
      models <- unlist(list(...), recursive = FALSE)
      # get the model names
      model_names <- names(models)
    }
  }

# ...

I will provide a pull request if you are interested.

wlangera commented 1 year ago

Pull request created #150

lenthomas commented 1 year ago

Thanks @wlangera - we'll check it out in the next few days.

erex commented 1 year ago

Perhaps this commit to the unreleased mrds 2.2.9 might resolve this problem at its source (within mrds) rather than inside the Distance package. Have not tried mrds 2.2.9 to see if this statement is true.