Skip to content

Commit fc61338

Browse files
gilbertocamaragilbertocamara
committed
remove nnet dependencies
1 parent 527aef2 commit fc61338

8 files changed

Lines changed: 67 additions & 93 deletions

File tree

‎R/sits_factory.R‎

Lines changed: 11 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,9 @@
2424
#' @examples
2525
#' # example code
2626
#' if (sits_run_examples()) {
27-
#' # Include a new machine learning function (multiple linear regression)
28-
#' # function that returns mlr model based on a sits sample tibble
27+
#' # Include a new machine learning function (naive bayes)
2928
#'
30-
#' sits_mlr <- function(samples = NULL, formula = sits_formula_linear(),
31-
#' n_weights = 20000, maxit = 2000) {
29+
#' sits_naive_bayes <- function(samples = NULL){
3230
#' train_fun <- function(samples) {
3331
#' # Data normalization
3432
#' ml_stats <- sits_stats(samples)
@@ -37,39 +35,34 @@
3735
#' pred = train_samples,
3836
#' stats = ml_stats
3937
#' )
40-
#' formula <- formula(train_samples[, -1])
4138
#' # call method and return the trained model
42-
#' result_mlr <- nnet::multinom(
43-
#' formula = formula,
44-
#' data = train_samples,
45-
#' maxit = maxit,
46-
#' MaxNWts = n_weights,
47-
#' trace = FALSE,
48-
#' na.action = stats::na.fail
39+
#' nb_model <- e1071::naiveBayes(
40+
#' x = sits_pred_features(train_samples),
41+
#' y = as.factor(sits_pred_references(train_samples))
4942
#' )
5043
#'
5144
#' # construct model predict closure function and returns
5245
#' predict_fun <- function(values) {
5346
#' # retrieve the prediction (values and probs)
5447
#' prediction <- tibble::as_tibble(
55-
#' stats::predict(result_mlr,
48+
#' stats::predict(nb_model,
5649
#' newdata = values,
57-
#' type = "probs"
50+
#' type = "raw"
5851
#' )
5952
#' )
6053
#' return(prediction)
6154
#' }
62-
#' class(predict_fun) <- c("sits_model", class(predict_fun))
55+
#' class(predict_fun) <- c("sits_model", "naiveBayes", class(predict_fun))
6356
#' return(predict_fun)
6457
#' }
6558
#' result <- sits_factory_function(samples, train_fun)
6659
#' return(result)
6760
#' }
68-
#' # create an mlr model using a set of samples
69-
#' mlr_model <- sits_train(samples_modis_ndvi, sits_mlr)
61+
#' # create an naiveBayes model using a set of samples
62+
#' nb_model <- sits_train(samples_modis_ndvi, sits_naive_bayes)
7063
#' # classify a point
7164
#' point_ndvi <- sits_select(point_mt_6bands, bands = "NDVI")
72-
#' point_class <- sits_classify(point_ndvi, mlr_model, multicores = 1)
65+
#' point_class <- sits_classify(point_ndvi, nb_model, multicores = 1)
7366
#' plot(point_class)
7467
#' }
7568
#' @export

‎R/sits_predictors.R‎

Lines changed: 11 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -14,12 +14,9 @@
1414
#'
1515
#' @examples
1616
#' if (sits_run_examples()) {
17-
#' # Include a new machine learning function (multiple linear regression)
18-
#' # function that returns mlr model based on a sits sample tibble
17+
#' # Include a new machine learning function (naive bayes)
1918
#'
20-
#' sits_mlr <- function(samples = NULL, formula = sits_formula_linear(),
21-
#' n_weights = 20000, maxit = 2000) {
22-
#' # create a training function
19+
#' sits_naive_bayes <- function(samples = NULL){
2320
#' train_fun <- function(samples) {
2421
#' # Data normalization
2522
#' ml_stats <- sits_stats(samples)
@@ -28,39 +25,34 @@
2825
#' pred = train_samples,
2926
#' stats = ml_stats
3027
#' )
31-
#' formula <- formula(train_samples[, -1])
3228
#' # call method and return the trained model
33-
#' result_mlr <- nnet::multinom(
34-
#' formula = formula,
35-
#' data = train_samples,
36-
#' maxit = maxit,
37-
#' MaxNWts = n_weights,
38-
#' trace = FALSE,
39-
#' na.action = stats::na.fail
29+
#' nb_model <- e1071::naiveBayes(
30+
#' x = sits_pred_features(train_samples),
31+
#' y = as.factor(sits_pred_references(train_samples))
4032
#' )
4133
#'
4234
#' # construct model predict closure function and returns
4335
#' predict_fun <- function(values) {
4436
#' # retrieve the prediction (values and probs)
4537
#' prediction <- tibble::as_tibble(
46-
#' stats::predict(result_mlr,
38+
#' stats::predict(nb_model,
4739
#' newdata = values,
48-
#' type = "probs"
40+
#' type = "raw"
4941
#' )
5042
#' )
5143
#' return(prediction)
5244
#' }
53-
#' class(predict_fun) <- c("sits_model", class(predict_fun))
45+
#' class(predict_fun) <- c("sits_model", "naiveBayes", class(predict_fun))
5446
#' return(predict_fun)
5547
#' }
5648
#' result <- sits_factory_function(samples, train_fun)
5749
#' return(result)
5850
#' }
59-
#' # create an mlr model using a set of samples
60-
#' mlr_model <- sits_train(samples_modis_ndvi, sits_mlr)
51+
#' # create an naiveBayes model using a set of samples
52+
#' nb_model <- sits_train(samples_modis_ndvi, sits_naive_bayes)
6153
#' # classify a point
6254
#' point_ndvi <- sits_select(point_mt_6bands, bands = "NDVI")
63-
#' point_class <- sits_classify(point_ndvi, mlr_model, multicores = 1)
55+
#' point_class <- sits_classify(point_ndvi, nb_model, multicores = 1)
6456
#' plot(point_class)
6557
#' }
6658
#'

‎R/sits_tuning.R‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@
7171
#' @param multicores Number of cores to process in parallel.
7272
#' @param gpu_memory Memory available in GPU in GB (default = 4)
7373
#' @param batch_size Batch size for GPU classification.
74+
#' @param seed Seed for random values.
7475
#'
7576
#' @return
7677
#' A tibble containing all parameters used to train on each trial
@@ -134,6 +135,7 @@ sits_tuning <- function(samples,
134135
multicores = 2L,
135136
gpu_memory = 4L,
136137
batch_size = 2L^gpu_memory,
138+
seed = NULL,
137139
progress = FALSE) {
138140
# set caller to show in errors
139141
.check_set_caller("sits_tuning")
@@ -188,6 +190,8 @@ sits_tuning <- function(samples,
188190
"optimizer" %in% ls(environment(ml_method))) {
189191
multicores <- 1L
190192
}
193+
# Set torch seed (kept in the model environment for reproducibility)
194+
torch_seed <- .torch_set_seed(seed)
191195
# Prepare parallel processing
192196
started <- .parallel_start(workers = multicores)
193197
on.exit(.parallel_stop(started), add = TRUE)

‎man/sits_factory_function.Rd‎

Lines changed: 11 additions & 18 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/sits_lighttae.Rd‎

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/sits_predictors.Rd‎

Lines changed: 11 additions & 19 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/sits_tuning.Rd‎

Lines changed: 3 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-factory.R‎

Lines changed: 15 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
test_that("test factory", {
2-
sits_mlr <- function(samples = NULL, formula = sits_formula_linear(),
3-
n_weights = 20000, maxit = 2000) {
2+
sits_naive_bayes <- function(samples = NULL) {
43
train_fun <- function(samples) {
54
# Data normalization
65
ml_stats <- sits_stats(samples)
@@ -9,46 +8,44 @@ test_that("test factory", {
98
pred = train_samples,
109
stats = ml_stats
1110
)
12-
formula <- formula(train_samples[, -1])
1311
# call method and return the trained model
14-
result_mlr <- nnet::multinom(
15-
formula = formula,
16-
data = train_samples,
17-
maxit = maxit,
18-
MaxNWts = n_weights,
19-
trace = FALSE,
20-
na.action = stats::na.fail
12+
nb_model <- e1071::naiveBayes(
13+
x = sits_pred_features(train_samples),
14+
y = as.factor(sits_pred_references(train_samples))
2115
)
22-
2316
# construct model predict closure function and returns
2417
predict_fun <- function(values) {
2518
# retrieve the prediction (values and probs)
2619
prediction <- tibble::as_tibble(
27-
stats::predict(result_mlr, newdata = values, type = "probs")
20+
stats::predict(nb_model,
21+
newdata = values,
22+
type = "raw"
23+
)
2824
)
2925
return(prediction)
3026
}
31-
class(predict_fun) <- c("sits_model", class(predict_fun))
27+
class(predict_fun) <- c("sits_model", "naiveBayes", class(predict_fun))
3228
return(predict_fun)
3329
}
3430
result <- sits_factory_function(samples, train_fun)
3531
return(result)
3632
}
3733
# create an lda model
38-
mlr_model <- sits_train(samples_modis_ndvi, sits_mlr)
34+
nb_model <- sits_train(samples_modis_ndvi, sits_naive_bayes)
3935
# classify a point
4036
point_ndvi <- sits_select(point_mt_6bands, bands = "NDVI")
41-
point_class <- sits_classify(point_ndvi,
42-
mlr_model,
37+
point_class <- sits_classify(
38+
point_ndvi,
39+
nb_model,
4340
multicores = 1,
4441
progress = FALSE
4542
)
4643

47-
expect_true(inherits(mlr_model, "function"))
44+
expect_true(inherits(nb_model, "function"))
4845
expect_true(all(unique(point_class$predicted[[1]]$class)
4946
%in% sits_labels(samples_modis_ndvi)))
5047
expect_equal(nrow(point_class$predicted[[1]]), 17)
5148

52-
ml_function <- sits_factory_function(data = NULL, sits_mlr)
49+
ml_function <- sits_factory_function(data = NULL, sits_naive_bayes)
5350
expect_true(inherits(ml_function, "function"))
5451
})

0 commit comments

Comments
 (0)