diff --git a/R/add_biodiversity.R b/R/add_biodiversity.R index 22479b97..73465409 100644 --- a/R/add_biodiversity.R +++ b/R/add_biodiversity.R @@ -282,7 +282,7 @@ methods::setMethod( # Finally set the data to the BiodiversityDistribution object y <- x$clone(deep = TRUE) - x$set_biodiversity(id, bd) + y$set_biodiversity(id, bd) } ) @@ -475,7 +475,7 @@ methods::setMethod( # Finally set the data to the BiodiversityDistribution object y <- x$clone(deep = TRUE) - x$set_biodiversity(id, bd) + y$set_biodiversity(id, bd) } } ) @@ -696,7 +696,7 @@ methods::setMethod( # Finally set the data to the BiodiversityDistribution object y <- x$clone(deep = TRUE) - x$set_biodiversity(id, bd) + y$set_biodiversity(id, bd) } } ) diff --git a/R/write_output.R b/R/write_output.R index 13682d8c..9555e630 100644 --- a/R/write_output.R +++ b/R/write_output.R @@ -57,7 +57,7 @@ methods::setMethod( # This function will only capture the distribution model object and will # save them separately - if(any(class(mod) %in% getOption("ibis.engines")) ){ + if(any(mod$get_name() %in% getOption("ibis.engines")) ){ # FIXME: If errors occur, check harmonization of saving among engines. mod$save(fname = fname) } else if(is.Raster(mod)){ @@ -374,7 +374,7 @@ methods::setMethod( # Model parameters in a tibble output[["params"]][["id"]] <- as.character(model$id) output[["params"]][["runname"]] <- as.character(model$runname) - output[["params"]][["algorithm"]] <- class(mod)[1] + output[["params"]][["algorithm"]] <- mod$get_name() output[["params"]][["equation"]] <- mod$get_equation() # Collect settings and parameters if existing if( !is.Waiver(mod$get_data("params")) ){ @@ -420,7 +420,7 @@ methods::setMethod( # Model parameters in a tibble output[["params"]][["id"]] <- as.character(mod$modelid) output[["params"]][["runname"]] <- as.character(model$model$runname) - output[["params"]][["algorithm"]] <- class(model)[1] + output[["params"]][["algorithm"]] <- mod$get_name() if( "settings" %in% names(mod) ){ output[["params"]][["settings"]] <- model$settings$data } @@ -715,31 +715,28 @@ methods::setMethod( !is.Waiver(mod$get_data("fit_best")) ) - # FIXME MH: Class of mod is only R6 and DistributionModel currently but no engine - warning("Due to a bug, there is no check if the object has a valid engine.", - call. = FALSE) - # # Check that model type is known - # assertthat::assert_that( any(sapply(class(mod), function(z) z %in% getOption("ibis.engines"))) ) - # # Depending on engine, check package and load them - # - # if(inherits(mod, "GDB-Model")){ - # check_package("mboost") - # } else if(inherits(mod, "BART-Model")){ - # check_package("dbarts") - # } else if(inherits(mod, "INLABRU-Model")){ - # check_package("INLA") - # check_package("inlabru") - # } else if(inherits(mod, "BREG-Model")){ - # check_package("BoomSpikeSlab") - # } else if(inherits(mod, "GLMNET-Model")){ - # check_package("glmnet") - # check_package("glmnetUtils") - # } else if(inherits(mod, "STAN-Model")){ - # check_package("rstan") - # check_package("cmdstanr") - # } else if(inherits(mod, "XGBOOST-Model")){ - # check_package("xgboost") - # } + # Check that model type is known + assertthat::assert_that( any(sapply(mod$get_name(), function(z) z %in% getOption("ibis.engines"))) ) + + # Depending on engine, check package and load them + if(mod$get_name() == "GDB-Model"){ + check_package("mboost") + } else if(mod$get_name() == "BART-Model"){ + check_package("dbarts") + } else if(mod$get_name() == "INLABRU-Model"){ + check_package("INLA") + check_package("inlabru") + } else if(mod$get_name() == "BREG-Model"){ + check_package("BoomSpikeSlab") + } else if(mod$get_name() == "GLMNET-Model"){ + check_package("glmnet") + check_package("glmnetUtils") + } else if(mod$get_name() == "STAN-Model"){ + check_package("rstan") + check_package("cmdstanr") + } else if(mod$get_name() == "XGBOOST-Model"){ + check_package("xgboost") + } # --- # # Return the model diff --git a/tests/testthat/test_objectinheritance.R b/tests/testthat/test_objectinheritance.R index a8188033..3238aa61 100644 --- a/tests/testthat/test_objectinheritance.R +++ b/tests/testthat/test_objectinheritance.R @@ -36,6 +36,11 @@ test_that('Check that distribution objects are properly inherited', { add_biodiversity_polpo(virtual_range, field_occurrence = 'Observed', name = 'Virtual points') expect_equal(x$biodiversity$length(),0) + # For Poipa + pa <- virtual_points |> add_pseudoabsence(field_occurrence = "Observed",template = background) + x |> add_biodiversity_poipa(pa, field_occurrence = "Observed",docheck = FALSE) + expect_equal(x$biodiversity$length(),0) + # Offsets suppressMessages( suppressWarnings( x |> add_offset_range(virtual_range) ) ) expect_s3_class(x$offset, "Waiver") @@ -49,6 +54,13 @@ test_that('Check that distribution objects are properly inherited', { expect_length(x$get_predictor_names(), 0) expect_length(y$get_predictor_names(), 14) + # Remove a predictor + y |> rm_predictors("ndvi_mean_50km") + expect_length(y$get_predictor_names(), 14) + y <- y |> rm_predictors("ndvi_mean_50km") + expect_length(y$get_predictor_names(), 13) + expect_error(y |> rm_predictors("ndvi_mean_50km")) # Trying to remove it again should lead to an error + # Add elevation y <- x |> add_predictor_elevationpref(predictors$elevation_mean_50km, 500, 1000) expect_length(y$get_predictor_names(), 2)