#devtools::use_package("assertthat")
usethis::use_package("pracma")
usethis::use_package("class")
usethis::use_package("EBImage")
usethis::use_package("rgdal")
usethis::use_package("sp")
usethis::use_package("raster", type = "Depends")
usethis::use_package("methods")
usethis::use_package("colorspace")
usethis::use_package("exifr", type = "Suggests")
usethis::use_package("imager")
usethis::use_package("conicfit")
usethis::use_package("akima")
# devtools::use_package("akima")
#devtools::use_package("testthat", type = "Suggests")
#' @import raster
#' @importFrom colorspace sRGB
#' @importFrom methods as is new validObject setClass setGeneric setMethod
NULL
setClassUnion("RasterAll", c("RasterStackBrick", "RasterLayer"))
##### LensPolyCoef #####
#' @title An S4 class to represent coefficients that models lens distortion.
#'
#' @description An S4 class to represent coefficients that models lens
#' distortion of hemispherical photographs. Use the helper function
#' \code{\link{lensPolyCoef}} to generate new objects of this class.
#'
#' @slot coef numeric.
#'
#' @examples showClass("LensPolyCoef")
#'
#' @seealso \code{\link{lensPolyCoef}}
#'
setClass(Class = "LensPolyCoef",
slots = c(coef = "numeric"),
validity = function(object) {
tolerance = 0.00001
foo <- all.equal(calcR(asAngle(0), object),
0, tolerance = tolerance)
if (is.logical(foo)) { #the return of all.equal is tricky
return(TRUE)
} else {
stop("Polynomial function is out of range")
}
},
prototype = list(coef = 2 / pi)
)
##### RelativeRadiusImage ####
#' @title An S4 class to represent Relative Radius as an image.
#'
#' @description An S4 class to represent Relative Radius as an image. Use the
#' helper function \code{\link{makeRimage}} to generate a new
#' \code{\linkS4class{RelativeRadiusImage}}.
#'
#' @slot diameter integer.
#' @slot ... Inherited from \code{\linkS4class{RasterLayer}}.
#'
#' @details \code{raster} package offer a wide range of functionalities to
#' manipulate raster files efficiently. It uses georeferenced raster because
#' was designed with a field-based conception of the geographical reality
#' (Galton, 2011). To manipulate such data, \code{raster} package defines "S4
#' classes" grouped in the \code{\linkS4class{Raster}} family that has a complex hierarchical
#' structure of inheritance. These classes have slots that help to precisely
#' locate each cell over the earth because they were designed to represent
#' georeferenced raster. \code{RelativeRadiusImage} was built on top of \code{RasterLayer}
#' to take advantage of \code{raster} package functionality. However,
#' \code{RelativeRadiusImage} requires raster implementation but not georeference.
#' That is why some inherited slots are meaningless for these class.
#'
#' @references Galton, A., 2001. A Formal Theory of Objects and Fields, in:
#' COSIT. pp. 458-473.
#'
#' @seealso \code{\link{makeRimage}}
#'
#' @examples showClass("RelativeRadiusImage")
#'
setClass(Class = "RelativeRadiusImage",
slots = c(diameter = "integer"),
validity = function (object) {
error <- FALSE
x <- object@diameter
if ((x / 2) != round(x / 2) | round(x) != x)
{
stop("diameter must be an even integer")
} else {
return(TRUE)
}
},
contains = "RasterLayer"
)
##### ZenithImage ####
#' @title An S4 class to represent zenith angles as an image.
#'
#' @description An S4 class to represent zenith angles as an image. Use the
#' helper function \code{\link{makeZimage}} to generate new objects of this
#' class.
#'
#' @slot lens \code{\linkS4class{LensPolyCoef}}.
#' @slot ... Inherited from \code{\linkS4class{RelativeRadiusImage}}.
#'
#' @seealso \code{\link{makeZimage}}
#'
#' @examples showClass("ZenithImage")
#'
setClass(Class = "ZenithImage",
slots = c(lens = "LensPolyCoef"),
validity = function (object) {
},
contains = "RelativeRadiusImage"
)
##### AzimuthImage ####
#' @title An S4 class to represent azimuth angles as an image.
#'
#' @description An S4 class to represent azimuth angles as an image. Use the
#' helper function \code{\link{makeAimage}} to generate new objects of this
#' class.
#'
#' @slot ... Inherited from \code{\linkS4class{ZenithImage}}.
#'
#' @seealso \code{\link{makeAimage}}
#'
#' @examples showClass("AzimuthImage")
#'
setClass ("AzimuthImage",
validity = function (object) {
v <- max(object, na.rm = TRUE)
c1 <- v <= 360
c2 <- v >= 359
if (c1 & c2) stop("Incorrect azimuth angle values.")
},
contains = c("RelativeRadiusImage"))
##### Angle ####
#' @title An S4 class to represent angle values.
#'
#' @description An S4 class to represent angle values. It has a slot that sets
#' whether it is in degrees or radians, so the methods and functions can adapt
#' to it instead of users. Only allows positive values. Use the helper
#' function \code{\link{asAngle}} to generate new objects of this class.
#'
#' @slot values numeric.
#' @slot degrees logical.
#'
#' @seealso \code{\link{asAngle}}
#'
#' @examples showClass("Angle")
#'
setClass(Class = "Angle",
slots = c(
values = "numeric",
degrees = "logical"
),
prototype = list(values = seq(0, 90), degrees = TRUE),
validity = function(object) {
# error <- TRUE
# if (!object@degrees & min(object@values) >= 0 & max(object@values) < 2 * pi)
# error <- FALSE
# if (object@degrees & min(object@values) >= 0 & max(object@values) < 360)
# error <- FALSE
#
# if (error)
# {
# stop(
# "\nAngle in degrees must be equal or greater than 0 and less than 360.\nAngle in radians must be equal or greater than 0 and less than 2pi.")
# } else {
# return(TRUE)
# }
}
)
##### FishEye ####
#' @title An S4 class to represent the metadata related with fisheye photographs.
#'
#' @description An S4 class to represent the metadata related with fisheye photographs.
#'
#' @slot is logical.
#' @slot up logical.
#' @slot leveled logical.
#' @slot fullframe logical.
#'
#' @seealso \code{\link{newFishEye}}
#'
#' @examples showClass("FishEye")
#'
setClass(Class = "FishEye",
slots = c(
is = "logical",
up = "logical",
leveled = "logical",
fullframe = "logical"
),
validity = function(object) {
c1 <- length(object@is) == 1
c2 <- length(object@up) == 1
c3 <- length(object@leveled) == 1
c4 <- length(object@fullframe) == 1
if (c1 & c2 & c3 & c4)
{
return(TRUE)
} else {
stop("is, up, leveled and fullframe must have length one.")
}
},
prototype = list(is = FALSE, up = FALSE, leveled = FALSE, fullframe = FALSE)
)
##### CanopyPhoto ####
.datetimeCharacterValidation <- function (x) {
if(length(x) != 1) {stop("The datetime slot must have length one")}
datetime <- x
error <- FALSE
if (nchar(x) != 19) error <- TRUE
x <- unlist(strsplit(x, " "))
if (!min(nchar(x) == c(10, 8))) error <- TRUE
.date <- x[1]
.time <- x[2]
dateSeparator <- c("/", "-")
for (i in seq(1, length(dateSeparator))) {
.date <- unlist(strsplit(.date, dateSeparator[i]))
}
if (length(.date) != 3) error <- TRUE
timeSeparator <- c(":")
for (i in seq(1, length(timeSeparator))) {
.time <- unlist(strsplit(.time, timeSeparator[i]))
}
if (length(.time) != 3) error <- TRUE
if(!error) {
a <- paste(
paste(.date[1], .date[2], .date[3], sep = "-" ),
paste(.time[1], .time[2], .time[3], sep = ":" )
)
b <- as.character(as.POSIXlt(datetime))
if (a != b)
stop(paste("Something is wrong, as.POSIXlt returns", b, "but you input",a ,"."))
}
if (error) {
stop("The only valid formats for the datetime slot are: yyyy/mm/dd hh:mm:ss or yyyy-mm-dd hh:mm:ss")
} else {
return(TRUE)
}
}
.elevationValidation <- function(x) {
if (!x@degrees) x <- switchUnit(x)
if (x@values > 90) stop("An elevation greater than 90 degrees is not possible.")
return(TRUE)
}
#' @title An S4 class to store vegetal canopy photographs.
#'
#' @description An S4 class to store vegetal canopy photographs. Use the
#' helper function \code{\link{loadPhoto}} to build new objects of this class
#' from a file.
#'
#' @slot equipment character.
#' @slot fisheye \code{\linkS4class{FishEye}}.
#' @slot datetime character.
#' @slot geoLocation \code{\link[sp]{SpatialPoints}}.
#' @slot bearing \code{\linkS4class{Angle}}.
#' @slot elevation \code{\linkS4class{Angle}}.
#' @slot slope \code{\linkS4class{Angle}}.
#' @slot exposureTime numeric.
#' @slot fNumber numeric.
#' @slot isoSpeed numeric.
#' @slot ... Inherited from \code{\linkS4class{RasterBrick}}.
#'
#' @details \code{CanopyPhoto} was built on top of \code{RasterBrick} to take
#' advantage of the \code{raster package} functionalities. However,
#' \code{CanopyPhoto} requires raster implementation but not georeference and
#' this is why some inherited slots are meaningless for this class.
#'
#' @seealso \code{\link{loadPhoto}}
#'
#' @examples showClass("CanopyPhoto")
#'
setClass(Class = "CanopyPhoto",
slots = c(
equipment = "character",
fisheye = "FishEye",
datetime = "character",
geoLocation = "SpatialPoints",
bearing = "Angle",
elevation = "Angle",
slope = "Angle",
exposureTime = "numeric",
fNumber = "numeric",
isoSpeed = "numeric"
),
validity = function(object) {
.elevationValidation(object@elevation)
.datetimeCharacterValidation(object@datetime)
c1 <- length(object@geoLocation) == 1
c2 <- length(object@bearing@values) == 1
c3 <- length(object@elevation@values) == 1
c4 <- length(object@slope@values) == 1
c5 <- length(object@exposureTime) == 1
c6 <- length(object@fNumber) == 1
c7 <- length(object@isoSpeed) == 1
if (object@fisheye@is) {
if (!object@fisheye@fullframe) stopifnot(nrow(object) == ncol(object))
if (!object@fisheye@fullframe & round(ncol(object) / 2) != ncol(object) / 2)
stop("The diameter of the fisheye picture must be even.")
}
if (c1 & c2 & c3 & c4 & c5 & c6 & c7) {
return(TRUE)
} else {
stop("At lest one of this slots have length greater than one: geoLocation, bearing, elevation, slope, exposureTime, slope, fNumber, or isoSpeed")
}
},
prototype = list(
fisheye = new("FishEye"),
datetime = "1980/11/20 14:00:00",
geoLocation =
SpatialPoints(coords = matrix(c(-57.95, -34.93333), ncol = 2),
proj4string = CRS("+init=epsg:4326")),
bearing = new("Angle", values = 0, degrees = TRUE),
elevation = new("Angle", values = 0, degrees = TRUE),
slope = new("Angle", values = 0, degrees = TRUE),
exposureTime = 0,
fNumber = 0,
isoSpeed = 0
),
contains = "RasterBrick"
)
##### BinImage ####
#' @title An S4 class to store binarized images.
#'
#' @description An S4 class to store binarized images.
#'
#' @slot threshold One-length numeric.
#' @slot originalData One-length character.
#' @slot processedLayer One-length integer .
#' @slot ... Inherited from \code{\linkS4class{RasterLayer}}.
#'
#' @seealso \code{\link{autoThr}}, \code{\link{presetThr}},
#' \code{\link{doMask}}, \code{\link{doOBIA}}
#'
#' @examples showClass("BinImage")
#'
setClass(Class = "BinImage",
slots = c(
threshold = "numeric",
originalData = "character",
processedLayer = "numeric"
),
validity = function(object) {
getMin(object) == 0
getMax(object) == 1
all(levels(as.factor(object))[[1]][,1] == c(FALSE, TRUE))
},
contains = "RasterLayer"
)
##### PolarSegmentation ####
#' @title An S4 class to store polar segmentations.
#'
#' @description An S4 class to store polar segmentations.
#'
#' @slot angleWidth \code{\linkS4class{Angle}}
#' @slot scaleParameter numeric
#' @slot ... Inherited from \code{\linkS4class{ZenithImage}}.
#'
#' @seealso \code{\link{makeRings}}, \code{\link{makePolarSectors}},
#' \code{\link{makePolarGrid}}
#'
#' @examples showClass("PolarSegmentation")
#'
setClass(Class = "PolarSegmentation",
slots = c(angleWidth = "Angle", scaleParameter = "numeric"),
contains = "ZenithImage"
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.