class_map <-
function(in.raster, colour.table = NULL, errors = 0, exceptions = NULL, plot.raster = FALSE, raster.summary = FALSE, return.raster=FALSE, save.raster = FALSE, out.file = NULL){
require(terra)
# Stop and provide a useful error message if the in.raster object is not found or not a SpatRaster object or cats/save location aren't specified
if(plot.raster==FALSE & return.raster==FALSE & save.raster==FALSE){
stop("Error: You need to set at least one of plot.raster, return.raster or save.raster to TRUE")
}
if(!class(in.raster)[1] == "SpatRaster"){
stop("Error: Input must be a SpatRaster object")
}
if(save.raster == TRUE & is.null(out.file) == TRUE){
stop("Error: Output file location not specified")
}
if(is.null(colour.table) == TRUE){
stop("Error: No colour table specified")
}
if(!is.null(exceptions) & any(colour.table$cat == exceptions) == FALSE){
stop("Error: Specified outlier category does not exist in colour table input.")
}
if(save.raster==TRUE){ if(file.exists(out.file) == TRUE){
stop("Error: Output file already exists")
}}
colour.table$newvar <- 1:nrow(colour.table)
reclassified.raster <-rast(in.raster, nlyrs=1, vals=0) # create new RasterLayer based on the RGB input, with no values
# loop through each category, take the threshold values for each band from the colour table & perform the
# reclassification.
for(i in colour.table$newvar){
var.cells<-which(values(in.raster$red< colour.table$Rmax[i] + colour.table$Rse[i]*errors) &
values(in.raster$green< colour.table$Gmax[i] + colour.table$Gse[i]*errors) &
values(in.raster$blue< colour.table$Bmax[i] + colour.table$Bse[i]*errors) &
values(in.raster$red > colour.table$Rmin[i] - colour.table$Rse[i]*errors) &
values(in.raster$green > colour.table$Gmin[i] - colour.table$Gse[i]*errors) &
values(in.raster$blue > colour.table$Bmin[i] - colour.table$Bse[i]*errors))
set.values(reclassified.raster,var.cells,values=i)
}
if(!is.null(exceptions)){
set.values(reclassified.raster, which(values(reclassified.raster)==0 & values(!is.na(in.raster[[1]]))), values=which(colour.table$cat == exceptions))
}
# Print map summary if requested
if(raster.summary == TRUE){
ras.summary<-data.frame(cat=colour.table$cat, pixels=sapply(colour.table$cat,function(x) sum(values(reclassified.raster==which(colour.table$cat==x)))),
area= sapply(colour.table$cat,function(x) sum(values(reclassified.raster==which(colour.table$cat==x)))*res(reclassified.raster)[1]),
fraction=sapply(colour.table$cat,function(x) sum(values(reclassified.raster==which(colour.table$cat==x)))/length(values(reclassified.raster))))
cat("\n Summary table for output raster: \n\n",sep="")
print(ras.summary)
}
# Remind user which category is which and which other parameters were chosen
cat("\n Raster categories:")
for(j in colour.table$newvar){
cat("\n\t", as.character(colour.table$cat[j]), " = ", j)
}
cat("\n\n Errors: ", errors, "\n Exceptions: ", exceptions)
cat("\n\n")
# plot if desired
if(plot.raster == TRUE){
# plot next to original
par(mfrow=c(2,round((nrow(colour.table)+2.1)/2))) # create set of panels according to number of map categories
par(col.axis="white",col.lab="white",tck=0);plotRGB(in.raster, axes=TRUE, main="orig.raster") # create 'invisible' axes and plot original raster
for(k in colour.table$newvar){
catlabel <- colour.table$cat[k]
par(col.axis="white",col.lab="white",tck=0); terra::plot(reclassified.raster==k, axes=TRUE, legend=FALSE, main=paste("Category",catlabel)) # create invisible axes and plot raster categories
}
par(col.axis="white",col.lab="white",tck=0); terra::plot(reclassified.raster==0, axes=TRUE, legend=FALSE, main="unclassed") # finally create invisible axes and plot pixels not in a class
# reset plotting window
par(mfrow = c(1,1))
# Print user guidance
cat("\n If this classification looks inaccurate, we recommend: \n\t [1] Changing the 'error' argument to alter the threshold boundaries (currently +/- ",errors,"* the sampled standard error for each colour band) \n\t [2] Altering the 'exceptions' argument to assign unclassed pixels as a specific category (currently ",exceptions,")\n\t [3] Altering the row order in your colour threshold table (plotting order) \n\t [4] Re-running click_sample \n\t [5] Manually editing the colour table.\n\n",sep="")
}
if(save.raster == TRUE){
writeRaster(reclassified.raster, out.file, datatype="INT1U", overwrite = FALSE)
cat("Map saved to ", out.file, "\n")
}
if(return.raster == TRUE){
return(reclassified.raster)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.