R/NonPar_CV.R

Defines functions NonParamCV

# Non-parametric cross-validation
# 
# @examples
# library(deforeStable)
# n_pts <- 10
# 
# forestdir <- system.file('extdata/Forest/', package = "deforeStable")
# Nonforestdir <- system.file('extdata/Non-forest/', package = "deforeStable")
# 
# Best_model <- NonParamCV(k_folds=2, n_pts=n_pts, forestdir=forestdir, Nonforestdir=Nonforestdir, parallel=FALSE)
# str(Best_model)
#
# @export
NonParamCV <- function(k_folds=NULL, n_pts=n_pts, forestdir=forestdir, Nonforestdir=Nonforestdir, parallel=FALSE)
{

    #### Obtaining k folds #######################
    trainPart <- createFolds(forestdir=forestdir, Nonforestdir=Nonforestdir, k = k_folds)


    kFolds_F <- trainPart$forest
    F_full <- unlist(kFolds_F)
    
    kFolds_NF <- trainPart$nonforest
    NF_full <- unlist(kFolds_NF)
    ##############################################
    
    Models <- list()
    test_ress <- list()
    acc <- vector(mode='numeric')
    
    for (ind in 1:length(kFolds_F)){
    
        # Defining the training sets
        train_F <- F_full[! F_full %in% kFolds_F[[ind]]]
        train_NF <- NF_full[! NF_full %in% kFolds_NF[[ind]]]
    
        # Training the model
        Models[[ind]] <- NonParamTrain(forestdir = forestdir, Nonforestdir = Nonforestdir, 
                                       Forest_list = train_F, Non_Forest_list = train_NF)
    
        # classifying test forest images
        f_npar_pos <- vector(mode='numeric')
        f_npar_sum <- vector(mode='numeric')
    
        for (ind_f in 1:length(kFolds_F[[ind]])) {
          data <- read_data_raster(filename = kFolds_F[[ind]][ind_f],
                                   dir=forestdir)
          dd <- Nonparam_classifier(rastData=data, n_pts=n_pts, progress = "none",
                                    Model = Models[[ind]], parallel=parallel)
          f_npar_pos <- c(f_npar_pos, sum(dd)) # positive pixels tagged
          f_npar_sum <- c(f_npar_sum, dim(dd)[1] * dim(dd)[2]) # pixels total
        }
    
        # classifying test non-forest images
        nf_npar_pos <- vector(mode='numeric')
        nf_npar_sum <- vector(mode='numeric')
    
        for (ind_nf in 1:length(kFolds_NF[[ind]])) {
          data <- read_data_raster(filename = kFolds_NF[[ind]][ind_nf],
                                   dir=Nonforestdir)
          dd <- Nonparam_classifier(rastData=data, n_pts=n_pts, progress = "none",
                                    Model = Models[[ind]], parallel=parallel)
          nf_npar_pos <- c(nf_npar_pos, sum(dd)) # positive pixels tagged
          nf_npar_sum <- c(nf_npar_sum, dim(dd)[1] * dim(dd)[2]) # pixels total
        }
        acc[ind] <- (sum(f_npar_pos) + (sum(nf_npar_sum) - sum(nf_npar_pos))) / 
                    (sum(f_npar_sum) + sum(nf_npar_sum))

        test_ress[[ind]] <- list(acc=acc[ind], 
                               tp = sum(f_npar_pos), 
                               fp = sum(nf_npar_pos), 
                               tn = sum(nf_npar_sum) - sum(nf_npar_pos), 
                               fn = sum(f_npar_sum) - sum(f_npar_pos)
                              )
    }
    
    # Pick and return the best model
    model_N <- which(acc==max(acc)); model_N <- min(model_N)
    Out_model <- Models[[model_N]]
    ress <- test_ress[[model_N]]
    Out_object <- structure(list(call = Out_model$call,
                                 acc = Out_model$acc,
                                 tp = Out_model$tp,
                                 fp = Out_model$fp,
                                 tn = Out_model$tn,
                                 fn = Out_model$fn,
                                 thres = Out_model$thres,
                                 forest_ns = Out_model$forest_ns,
                                 forest_means = Out_model$forest_means,
                                 forest_covars = Out_model$forest_covars,
                                 test_ress = ress
                                ),
                            class = c("ForestCVNonParam", "ForestTrainNonParam", "ForestTrain"))
    
    Out_object
}






##################

Try the deforestable package in your browser

Any scripts or data that you put into this service are public.

deforestable documentation built on Oct. 16, 2022, 1:06 a.m.