Merge branch 'master' of https://github.com/e-sensing/sits into dev

Conflicts:
	R/sits_TWDTW.R
	R/sits_machine_learning.R
	man/sits_svm.Rd

R/sits_TWDTW.R

@@ -34,67 +34,12 @@
 sits_TWDTW_matches <- function (data.tb = NULL, patterns.tb = NULL, bands = NULL, dist.method = "euclidean",
  alpha = -0.1, beta = 100, theta = 0.5, span = 250, keep = FALSE){
 
-
- result_fun <- function (data.tb, patterns.tb) {
- # add a progress bar
- progress_bar <- NULL
- if (nrow (data.tb) > 10) {
- message("Matching patterns to time series...")
- progress_bar <- utils::txtProgressBar(min = 0, max = nrow(data.tb), style = 3)
- i <- 0
- }
- # does the input data exist?
- .sits_test_table (data.tb)
- .sits_test_table (patterns.tb)
-
- # handle the case of null bands
- if (purrr::is_null (bands)) bands <- sits_bands(data.tb)
-
- # create a tibble to store the results of the TWDTW matches
- matches.tb <- sits_table()
-
- # select the bands for patterns time series and convert to TWDTW format
- twdtw_patterns <- patterns.tb %>%
- sits_select (bands) %>%
- .sits_toTWDTW_time_series()
-
- # Define the logistic function
- log_fun <- dtwSat::logisticWeight(alpha = alpha, beta = beta)
-
- data.tb %>%
- purrrlyr::by_row (function (row.tb) {
- # select the bands for the samples time series and convert to TWDTW format
- twdtw_series <- row.tb %>%
- sits_select (bands) %>%
- .sits_toTWDTW_time_series()
-
- #classify the data using TWDTW
- matches = dtwSat::twdtwApply(x = twdtw_series,
- y = twdtw_patterns,
- weight.fun = log_fun,
- theta = theta,
- span = span,
- keep = keep,
- dist.method = dist.method)
-
- # add the matches to the results
- matches.lst <- .sits_fromTWDTW_matches(matches)
-
- # include the matches in the SITS table
- res.tb <- row.tb %>%
- dplyr::mutate(matches = matches.lst)
-
- # add the row to the results.tb tibble
- matches.tb <<- dplyr::bind_rows(matches.tb, res.tb)
-
- # update progress bar
- if (!purrr::is_null(progress_bar)) {
- i <<- i + 1
- utils::setTxtProgressBar(progress_bar, i)
- }
- })
- if (!purrr::is_null(progress_bar)) close(progress_bar)
- return (matches.tb)
+ # add a progress bar
+ progress_bar <- NULL
+ if (nrow (data.tb) > 10) {
+ message("Matching patterns to time series...")
+ progress_bar <- utils::txtProgressBar(min = 0, max = nrow(data.tb), style = 3)
+ i <- 0
  }
  # does the input data exist?
  .sits_test_table (data.tb)

R/sits_machine_learning.R

@@ -51,17 +51,16 @@ sits_train <- function(distances.tb, tr_method = sits_svm()){
 #' @description This function is a front-end to the "svm" method in the "e1071" package.
 #' Please refer to the documentation in that package for more details.
 #'
-#' @param data.tb a SITS tibble time series with an alignment column. If data.tb is NULL, the function returns
-#' a function to be called further to compute svm training model according to given parameters
-#' @param formula a symbolic description of the model to be fit. SITS offers a set of such formulas (default: sits_formula_logref)
-#' @param kernel the kernel used in training and predicting (options = linear, polynomial, radial basis, sigmoid)
-#' @param degree exponential of polynomial type kernel
-#' @param coef0 parameter needed for kernels of type polynomial and sigmoid (default: 0)
-#' @param cost cost of constraints violation
-#' @param tolerance tolerance of termination criterion (default: 0.001)
-#' @param epsilon epsilon in the insensitive-loss function (default: 0.1)
-#' @param ... other parameters to be passed to e1071::svm function
-#' @return result either an e1071::svm class or an function prepared that can be called further to compute svm training model
+#' @param distances.tb a time series with a set of distance measures for each training sample
+#' @param formula a symbolic description of the model to be fit. SITS offers a set of such formulas (default: sits_svm)
+#' @param kernel the kernel used in training and predicting (options = linear, polynomial, radial basis, sigmoid)
+#' @param degree exponential of polynomial type kernel
+#' @param coef0 parameter needed for kernels of type polynomial and sigmoid (default: 0)
+#' @param cost cost of constraints violation
+#' @param tolerance tolerance of termination criterion (default: 0.001)
+#' @param epsilon epsilon in the insensitive-loss function (default: 0.1)
+#' @param ... other parameters to be passed to e1071::svm function
+#' @return result either an e1071::svm class or an function prepared that can be called further to compute svm training model
 #' @export
 #'
 sits_svm <- function(distances.tb = NULL, formula = sits_formula_logref(), kernel = "linear",
@@ -83,119 +82,7 @@ sits_svm <- function(distances.tb = NULL, formula = sits_formula_logref(), kerne
  return(result_svm)
  }
 
- result <- .sits_factory_function (data.tb, result_fun)
- return(result)
-}
-
-#' @title Train SITS classifiction models
-#' @name sits_lda
-#'
-#' @author Alexandre Xavier Ywata de Carvalho, \email{alexandre.ywata@@ipea.gov.br}
-#' @author Victor Maus, \email{vwmaus1@@gmail.com}
-#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
-#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
-#'
-#' @description Performs a linear discriminant analysis (lda) to classify data.
-#' This function is a front-end to the "lda" method in the "MASS" package.
-#' Please refer to the documentation in that package for more details.
-#'
-#' @param data.tb a SITS tibble time series with an `matches` column. If `data.tb` is NULL, the function returns
-#' a pre-parameterized function to be called further in order to compute `lda` training model
-#' @param formula a symbolic description of the model to be fit. SITS offers a set of such formulas (default: sits_formula_logref)
-#' @param ... other parameters to be passed to MASS::lda function
-#' @return result either an MASS::lda class or an function prepared that can be called further to compute lda training model
-#' @export
-#'
-sits_lda <- function(data.tb = NULL, formula = sits_formula_logref(), ...) {
-
- # function that returns MASS::lda model based on a sits sample tibble
- result_fun <- function(tb){
-
- # if parameter formula is a function call it passing as argument the input data sample. The function must return a valid formula.
- if (class(formula) == "function")
- formula <- formula(tb)
-
- # call MASS::lda method and return the trained lda model
- result_lda <- MASS::lda(formula = formula, data = tb, ...)
- return(result_lda)
- }
-
- result <- .sits_factory_function (data.tb, result_fun)
- return(result)
-}
-
-#' @title Train SITS classifiction models
-#' @name sits_mlr
-#'
-#' @author Alexandre Xavier Ywata de Carvalho, \email{alexandre.ywata@@ipea.gov.br}
-#' @author Victor Maus, \email{vwmaus1@@gmail.com}
-#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
-#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
-#'
-#' @description Use multinomial log-linear (mlr) fitting model via neural networks to classify data.
-#' This function is a front-end to the "multinom" method in the "nnet" package.
-#' Please refer to the documentation in that package for more details.
-#'
-#' @param data.tb a SITS tibble time series with an `matches` column. If `data.tb` is NULL, the function returns
-#' a pre-parameterized function to be called further in order to compute `multinom` training model
-#' @param formula a symbolic description of the model to be fit. SITS offers a set of such formulas (default: sits_formula_logref)
-#' @param ... other parameters to be passed to nnet::multinom function
-#' @return result either an nnet::multinom class or an function prepared that can be called further to compute multinom training model
-#' @export
-#'
-sits_mlr <- function(data.tb = NULL, formula = sits_formula_logref(), ...) {
-
- # function that returns nnet::multinom model based on a sits sample tibble
- result_fun <- function(tb){
-
- # if parameter formula is a function call it passing as argument the input data sample. The function must return a valid formula.
- if (class(formula) == "function")
- formula <- formula(tb)
-
- # call nnet::multinom method and return the trained multinom model
- result_mlr <- nnet::multinom(formula = formula, data = tb, ...)
- return(result_mlr)
- }
-
- result <- .sits_factory_function (data.tb, result_fun)
- return(result)
-}
-
-#' @title Train SITS classifiction models
-#' @name sits_glm
-#'
-#' @author Alexandre Xavier Ywata de Carvalho, \email{alexandre.ywata@@ipea.gov.br}
-#' @author Victor Maus, \email{vwmaus1@@gmail.com}
-#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
-#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
-#'
-#' @description Use generalized liner model (glm) via penalized maximim likelihood to classify data.
-#' This function is a front-end to the "glmnet" method in the "glmnet" package.
-#' Please refer to the documentation in that package for more details.
-#'
-#' @param data.tb a SITS tibble time series with an `matches` column. If `data.tb` is NULL, the function returns
-#' a pre-parameterized function to be called further in order to compute `multinom` training model
-#' @param formula a symbolic description of the model to be fit. SITS offers a set of such formulas (default: sits_formula_logref)
-#' @param ... other parameters to be passed to glmnet::multinom function
-#' @return result either an glmnet::multinom class or an function prepared that can be called further to compute multinom training model
-#' @export
-#'
-sits_glm <- function(data.tb = NULL, formula = sits_formula_logref(), ...) {
-
- # function that returns glmnet::multinom model based on a sits sample tibble
- result_fun <- function(tb){
-
- # if parameter formula is a function call it passing as argument the input data sample. The function must return a valid formula.
- if (class(formula) == "function")
- formula <- formula(tb)
-
- # call glmnet::multinom method and return the trained multinom model
- result_mlr <- glmnet::glmnet(formula = formula, data = tb, ...)
- return(result_mlr)
- }
-
- result <- .sits_factory_function (data.tb, result_fun)
- return(result)
+ result <- .sits_factory_function (distances.tb, result_fun)
 }
 
 #' @title Train SITS classifiction models