# \donttest{
library(prospectr)
data(NIRsoil)
# Proprocess the data using detrend plus first derivative with Savitzky and
# Golay smoothing filter
sg_det <- savitzkyGolay(
detrend(NIRsoil$spc,
wav = as.numeric(colnames(NIRsoil$spc))
),
m = 1,
p = 1,
w = 7
)
NIRsoil$spc_pr <- sg_det
# split into training and testing sets
test_x <- NIRsoil$spc_pr[NIRsoil$train == 0 & !is.na(NIRsoil$CEC), ]
test_y <- NIRsoil$CEC[NIRsoil$train == 0 & !is.na(NIRsoil$CEC)]
train_y <- NIRsoil$CEC[NIRsoil$train == 1 & !is.na(NIRsoil$CEC)]
train_x <- NIRsoil$spc_pr[NIRsoil$train == 1 & !is.na(NIRsoil$CEC), ]
# Example 1
# A mbl implemented in Ramirez-Lopez et al. (2013,
# the spectrum-based learner)
# Example 1.1
# An exmaple where Yu is supposed to be unknown, but the Xu
# (spectral variables) are known
my_control <- mbl_control(validation_type = "NNv")
## The neighborhood sizes to test
ks <- seq(40, 140, by = 20)
sbl <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
k = ks,
method = local_fit_gpr(),
control = my_control,
scale = TRUE
)
sbl
plot(sbl)
get_predictions(sbl)
# Example 1.2
# If Yu is actually known...
sbl_2 <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
Yu = test_y,
k = ks,
method = local_fit_gpr(),
control = my_control
)
sbl_2
plot(sbl_2)
# Example 2
# the LOCAL algorithm (Shenk et al., 1997)
local_algorithm <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
Yu = test_y,
k = ks,
method = local_fit_wapls(min_pls_c = 3, max_pls_c = 15),
diss_method = "cor",
diss_usage = "none",
control = my_control
)
local_algorithm
plot(local_algorithm)
# Example 3
# A variation of the LOCAL algorithm (using the optimized pc
# dissmilarity matrix) and dissimilarity matrix as source of
# additional preditors
local_algorithm_2 <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
Yu = test_y,
k = ks,
method = local_fit_wapls(min_pls_c = 3, max_pls_c = 15),
diss_method = "pca",
diss_usage = "predictors",
control = my_control
)
local_algorithm_2
plot(local_algorithm_2)
# Example 4
# Running the mbl function in parallel with example 2
n_cores <- 2
if (parallel::detectCores() < 2) {
n_cores <- 1
}
# Alternatively:
# n_cores <- parallel::detectCores() - 1
# if (n_cores == 0) {
# n_cores <- 1
# }
library(doParallel)
clust <- makeCluster(n_cores)
registerDoParallel(clust)
# Alernatively:
# library(doSNOW)
# clust <- makeCluster(n_cores, type = "SOCK")
# registerDoSNOW(clust)
# getDoParWorkers()
local_algorithm_par <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
Yu = test_y,
k = ks,
method = local_fit_wapls(min_pls_c = 3, max_pls_c = 15),
diss_method = "cor",
diss_usage = "none",
control = my_control
)
local_algorithm_par
registerDoSEQ()
try(stopCluster(clust))
# Example 5
# Using local pls distances
with_local_diss <- mbl(
Xr = train_x,
Yr = train_y,
Xu = test_x,
Yu = test_y,
k = ks,
method = local_fit_wapls(min_pls_c = 3, max_pls_c = 15),
diss_method = "pls",
diss_usage = "predictors",
control = my_control,
.local = TRUE,
pre_k = 150,
)
with_local_diss
plot(with_local_diss)
# }
Run the code above in your browser using DataLab