#' Generate a raster data set with train segments
#'
#' An utility function used to create a raster dataset containing train segments for a given segmentation
#' solution and a train raster.
#'
#' @inheritParams getTrainData
#'
#' @param trainData Input train data. The input can be a \code{SpatRaster}, an integer vector (containing
#' raster data after using \code{\link[terra]{values}} function) or a character string with a path to a
#' raster layer. If trainData is an integer vector then it should have a length equal to the number of
#' pixels in rstSegm.
#'
#' @param filename A filename/path used to write the output raster (default: NULL)
#' @param verbose Print comments with function progress? (default: TRUE)
#'
#' @param ... Additional options passed to \code{writeRaster} function. The option \code{datatype}
#' is already internally set to \emph{INT2U}.
#'
#' @return A SpatRaster object with train segments.
#'
#' @importFrom terra values
#' @importFrom terra rast
#' @importFrom terra ncell
#' @importFrom terra writeRaster
#' @export
#'
<- (trainData, rstSegm, filename = , useThresh = , thresh = 0.5,
na.rm = , dup.rm = , minImgSegm = 30, ignore = ,
verbose = , ){
(verbose) ("-> Generating train data...\n") ## --------------------------------------------------- ##
trainDataDF <- (x=trainData, rstSegm=rstSegm, useThresh=useThresh, thresh=thresh,
na.rm=na.rm, dup.rm=dup.rm, minImgSegm=minImgSegm,ignore=ignore)
(verbose) ("done.\n\n")
(verbose) ("-> Loading segmented raster...\n") ## ------------------------------------------------ ##
rstSegmDF <- (cell_ID = 1:(terra::ncell(rstSegm)), SID = terra::values(rstSegm),1])
(rstSegmDF) <- ("cell_ID", "SID")
(verbose) ("done.\n\n")
(verbose) ("-> Joining and re-ordering train data with the segmented raster ...\n") ##------------ ##
rstSegmDF <- (rstSegmDF, trainDataDF, ="SID", all.x=)
rstSegmDF <- rstSegmDF[order(rstSegmDF$cell_ID), ]
(verbose) ("done.\n\n")
(verbose) ("-> Creating a new raster dataset with train segments...\n") ## --------------------- ##
newRstTrainData <- terra::rast(rstSegm)
terra::values(newRstTrainData) <- rstSegmDF$train
(verbose) ("done.\n\n")
(!(filename)){
(verbose) ("-> Writing data...\n") ## ---------------------------------------------------------- ##
terra::writeRaster(newRstTrainData, filename = filename, datatype="INT2U", )
(verbose) ("done.\n\n")
}
(newRstTrainData)
}
#' Predict class labels for image segments
#'
#' This function uses an input \code{SOptim.Classifier} object to predict class labels for train or all segments in the
#' input segmented image.
#'
#' @param classifierObj An object of class \code{SOptim.Classifier} containing a classification algorithm
#' generated by function \code{\link{calibrateClassifier}} with option \code{runFullCalibration = TRUE}.
#'
#' @param calData An object of class \code{SOptim.CalData} generated by function \code{\link{prepareCalData}} containing
#' calibration data for train segments and the entire image.
#'
#' @param rstSegm A string defining the path to the raster with segment IDs, a \code{SpatRaster} object or
#' a \code{SOptim.SegmentationResult} object (generated by any segmentation function (check \link{segmentationGeneric}).
#'
#' @param predictFor Either option \code{"train"} which predicts class labels only for train segments
#' or option \code{"all"} which predicts for all existing segments in \code{rstSegm} (default: all).
#'
#' @param filename A file name/path used to write the output raster (default: NULL).
#'
#' @param verbose Print comments with function progress? (default: TRUE).
#'
#' @param na.rm Remove NA's? (default: TRUE).
#'
#' @param ... Additional arguments for \code{\link[terra]{writeRaster}} function except \code{datatype}
#' which is already internally set to 'INT4U'.
#'
#' @param forceWriteByLine Use memory-safe writing of raster output by line? (default: FALSE).
#' If \code{forceWriteByLine = TRUE}, then \code{filename} must define a valid file path.
#'
#' @details By default the function uses the classifier ran with the 'full' dataset (i.e., no train/test splits)
#' for making class label predictions. In case of single-class problems the threshold that maximizes the selected
#' evaluation metric (check \code{evalMetric} in \code{\link{calibrateClassifier}}) is used to dichotomize predictions.
#' For multi-class problems the output class label is set for the one with highest probability value.
#'
#' @return An object of class \code{SpatRaster} containing the predicted class labels for
#' each image segment. If the file name is defined, the function will write a file containing the output
#' raster. The output data type is INT4U (see \code{\link[terra]{datatype}} for more details) which means
#' negative values for class labels are not valid.
#'
#' @importFrom terra ncell
#' @importFrom terra values
#' @importFrom terra rast
#' @importFrom terra writeRaster
#' @importFrom terra readStart
#' @importFrom terra readStop
#' @importFrom terra writeStart
#' @importFrom terra writeStop
#' @importFrom terra writeValues
#' @importFrom stats predict
#' @importFrom stats na.omit
#' @importFrom data.table setDT
#' @importFrom data.table setkey
#' @importFrom data.table setorder
#' @importFrom utils txtProgressBar
#' @importFrom utils setTxtProgressBar
#'
#' @export
<- (classifierObj, calData, rstSegm, predictFor = "all",
filename = , verbose = , na.rm = ,
forceWriteByLine = , ){
(!(classifierObj, "SOptim.Classifier"))
("classifierObj must be an object of class SOptim.Classifier generated by
calibrateClassifier function with option runFullCalibration = TRUE")
(!(calData, "SOptim.CalData"))
("calData must be an object of class SOptim.CalData generated by prepareCalData function")
(!(predictFor %in% ("train","all")))
("predictFor must be either \"train\" (only for train segments) or \"all\"!")
# TODO: Replace canProcessInMemory
#
#
# # If large raster filename must be defined to write data to disk
# if(!canProcessInMemory(rstSegm) && is.null(filename)){
# stop("Large raster detected! To process data please define a valid output path in parameter filename.\n")
# }
# If large raster filename must be defined to write data to disk
(forceWriteByLine && (filename)){
("If forceWriteByLine = TRUE please define a valid output path in parameter filename.\n")
}
(verbose) ("-> Pre-processing data...\n") ## ----------------------------------------- ##
((rstSegm,"SOptim.SegmentationResult")){
rstSegm <- terra::rast(rstSegm$segm)
}
# Get the classifier trained with the full dataset
clObj <- classifierObj$ClassObj$FULL
# Get metadata on number of classes
nClassType <- classifierObj$ClassParams$nClassType
# Get threshold values for dichotomizing single-class probability predictions
(nClassType=="single-class") threshVals <- classifierObj$Thresh
# Remove NA's from data
(na.rm){
(predictFor == "train") calData$calData <- (calData$calData)
(predictFor == "all") calData$classifFeatData <- (calData$classifFeatData)
}
(verbose) ("done.\n\n") ## ----- ##
(verbose) ("-> Classifying raster segments...\n") ## -------------------------------- ##
## --------------------------------------------------------------------------------------- ##
## Random forest classifier ----
## --------------------------------------------------------------------------------------- ##
((clObj, "randomForest")){
(nClassType == "single-class"){
# Get the threshold value used to binarize the classifier predictions
threshValFullClassif <- threshVals[length(threshVals)]
(predictFor == "train"){
pred <- ::(clObj, ="prob") ## Gets the out-of-bag predictions
pred <- (pred,2] > threshValFullClassif)
}
(predictFor == "all"){
pred <- ::(clObj, ="prob", newdata = calData$classifFeatData)
pred <- (pred,2] > threshValFullClassif)
}
}
(nClassType == "multi-class"){
(predictFor == "train"){
pred <- ::(clObj, = "response") ## Gets the out-of-bag predictions
}
(predictFor == "all"){
pred <- ::(clObj, = "response", newdata = calData$classifFeatData)
}
}
}
## --------------------------------------------------------------------------------------- ##
## GBM classifier ----
## --------------------------------------------------------------------------------------- ##
((clObj, "gbm")){
# Get the number of trees in GBM classifier
nt <- clObj$n.trees
(nClassType == "single-class"){
# Get the threshold value used to binarize the classifier predictions
threshValFullClassif <- threshVals[length(threshVals)]
(predictFor == "train"){
pred <- ::(clObj, newdata = calData$calData, = "response", n.trees = nt)
pred <- (pred > threshValFullClassif)
}
(predictFor == "all"){
pred <- ::(clObj, newdata = calData$classifFeatData, = "response", n.trees = nt)
pred <- (pred > threshValFullClassif)
}
}
(nClassType == "multi-class"){
# Use only the first element of the prediction array in [,,1] and extract the class with highest probability
# outcome using as.integer(colnames(pred))[apply(pred,1,which.max)]
(predictFor == "train"){
pred <- ::(clObj, newdata = calData$calData, = "response", n.trees = nt),,1]
pred <- ((pred))[apply(pred,1,)]
}
(predictFor == "all"){
pred <- ::(clObj, newdata = calData$classifFeatData, = "response", n.trees = nt),,1]
pred <- ((pred))[apply(pred,1,)]
}
}
}
## --------------------------------------------------------------------------------------- ##
## SVM classifier ----
## --------------------------------------------------------------------------------------- ##
((clObj, "svm")){
(nClassType == "single-class"){
# Get the threshold value used to binarize the classifier predictions
threshValFullClassif <- threshVals[length(threshVals)]
(predictFor == "train"){
pred <- (::(clObj, newdata = calData$calData, probability = ), "probabilities")
pred <- (pred,2] > threshValFullClassif)
}
(predictFor == "all"){
pred <- (::(clObj, newdata = calData$classifFeatData, probability = ), "probabilities")
pred <- (pred,2] > threshValFullClassif)
}
}
(nClassType == "multi-class"){
(predictFor == "train"){
pred <- ::(clObj, newdata = calData$calData)
}
(predictFor == "all"){
pred <- ::(clObj, newdata = calData$classifFeatData)
}
}
}
## --------------------------------------------------------------------------------------- ##
## KNN classifier ----
## --------------------------------------------------------------------------------------- ##
((clObj, "knn")){
(nClassType == "single-class" || nClassType == "multi-class"){
(predictFor == "train"){
pred <- ::(clObj, = "response")
}
(predictFor == "all"){
k <- classifierObj$ClassParams$classificationMethodParams$KNN$k
balanceTrainData <- classifierObj$ClassParams$balanceTrainData
balanceMethod <- classifierObj$ClassParams$balanceMethod
pred <- ::(clObj,
newdata = calData$classifFeatData,-1],
traindata = calData$calData,-(1:2)],
cl = calData$calData$train,
k = k,
= "response",
balanceTrainData = balanceTrainData,
balanceMethod = balanceMethod)
}
}
}
## --------------------------------------------------------------------------------------- ##
## FDA classifier ----
## --------------------------------------------------------------------------------------- ##
((clObj, "fda")){
(nClassType == "single-class"){
# Get the threshold value used to binarize the classifier predictions
threshValFullClassif <- threshVals[length(threshVals)]
(predictFor == "train"){
pred <- ::(clObj, newdata = calData$calData, = "posterior")
pred <- (pred,2] > threshValFullClassif)
}
(predictFor == "all"){
pred <- ::(clObj, newdata = calData$classifFeatData, = "posterior")
pred <- (pred,2] > threshValFullClassif)
}
}
(nClassType == "multi-class"){
(predictFor == "train"){
pred <- ::(clObj, newdata = calData$calData, = "class")
}
(predictFor == "all"){
pred <- ::(clObj, newdata = calData$classifFeatData, = "class")
}
}
}
(verbose) ("done.\n\n")
#if(canProcessInMemory(rstSegm) && !forceWriteByLine){
(!forceWriteByLine){
(verbose) ("-> Loading segmented raster data...\n") ## ----- ##
# Get some preliminary data on raster segments
rstSegmDF <- (cell_ID=1:terra::ncell(rstSegm), SID=terra::values(rstSegm),1])
(rstSegmDF) <- ("cell_ID", "SID")
data.table::setDT(rstSegmDF) # Convert to data.table by reference
data.table::setkey(rstSegmDF, SID) # Set key
(verbose) ("done.\n\n")
(verbose) ("-> Merging data and creating a new raster dataset with predicted class labels...\n") ## ----- ##
# Convert factors to integers if needed otherwise class integer codes may come out wrong...
((pred)) pred <- ((pred)[as.integer(pred)])
# Append the segment IDs (SID field) to the predicted object
(predictFor == "train"){
predDF <- (SID = calData$calData$SID, predClass = pred)
} (predictFor == "all"){
predDF <- (SID = calData$classifFeatData$SID, predClass = pred)
}
(pred)
# Convert to data.table object
data.table::setDT(predDF) # Convert to data.table by reference
data.table::setkey(predDF)
# Join and update column by reference
rstSegmDF[predDF, on = 'SID', predClass := predClass]
# Reorder by cell cell_ID otherwise it will give problems when writing data to raster
data.table::setorder(rstSegmDF, cell_ID, na.last = )
# Make new raster to fill with predicted class labels
newRstPred <- terra::rast(rstSegm)
terra::values(newRstPred) <- rstSegmDF"predClass"]]
(verbose) ("done.\n\n")
(!(filename)){ ## ------------------------------------------------------ ##
(verbose) ("-> Writing data...\n")
# Changes output dataType to INT4U (0 - 4,294,967,296)
#
terra::writeRaster(newRstPred, filename = filename, datatype="INT4U", )
(verbose) ("done.\n\n")
}
(newRstPred)
}#else if(!canProcessInMemory(rstSegm) || forceWriteByLine){
(forceWriteByLine){
## ------------------------------------------------------------------------------ ##
## Use memory-safe ops ----
## ------------------------------------------------------------------------------ ##
(verbose){
("-> Outputting data using memory-safe operations...\n\n")
pb <- ::( = 1, = (rstSegm), style = 3)
}
# Convert factors to integers if needed otherwise class integer codes may come out wrong...
((pred)) pred <- ((pred)[as.integer(pred)])
# Append the segment IDs (SID field) to the predicted object
(predictFor == "train"){
predDF <- (SID = calData$calData$SID, predClass = pred)
} (predictFor == "all"){
predDF <- (SID = calData$classifFeatData$SID, predClass = pred)
}
(pred)
# Convert to data.table object
data.table::setDT(predDF) # Convert to data.table by reference
data.table::setkey(predDF)
#rstSegm <- terra::readStart(rstSegm)
(
(terra::readStart(rstSegm)))
r_out <- terra::rast(rstSegm)
#r_out <- suppressWarnings(terra::writeStart(r_out, filename = filename, datatype="INT4U", ...))
(
(
terra::writeStart(r_out, filename = filename, datatype="INT4U", )))
(nr 1:(rstSegm)){
# Get data on raster segments by line
rstSegmDF <- (cell_ID = 1:(rstSegm),
SID = terra::values(rstSegm, = nr, nrows = 1),1])
(rstSegmDF) <- ("cell_ID", "SID")
data.table::setDT(rstSegmDF) # Convert to data.table by reference
data.table::setkey(rstSegmDF, SID) # Set key
# Join and update column by reference
rstSegmDF[predDF, on = 'SID', predClass := predClass]
# Reorder by cell_ID otherwise it will give problems when writing data to raster
data.table::setorder(rstSegmDF, cell_ID, na.last = )
# write to output file
#r_out <- terra::writeValues(r_out, rstSegmDF$predClass, nr, 1)
terra::writeValues(r_out, rstSegmDF$predClass, nr, 1)
(verbose){
::(pb,nr)
}
}
# close files
#r_out <- terra::writeStop(r_out)
#rstSegm <- terra::readStop(rstSegm)
terra::writeStop(r_out)
terra::readStop(rstSegm)
newRstPred <- terra::rast(filename)
(newRstPred)
}{
("Invalid option set!")
}
}
