##### Core function for tangent angle Fourier analyses
#' Tangent angle Fourier transform
#'
#' \code{tfourier} computes tangent angle Fourier analysis from a matrix or a
#' list of coordinates.
#'
#' @param x A list or matrix of coordinates or an \code{Out}
#' @param nb.h \code{integer}. The number of harmonics to use. If missing, 12 is used on shapes;
#' 99 percent of harmonic power on Out objects, both with messages.
#' @param smooth.it \code{integer}. The number of smoothing iterations to
#' perform
#' @param norm \code{logical}. Whether to scale and register new coordinates so
#' that the first point used is sent on the origin.
#' @param ... useless here
#' @note Silent message and progress bars (if any) with `options("verbose"=FALSE)`.
#' @return A list with the following components:
#' \itemize{
#' \item \code{ao} ao harmonic coefficient
#' \item \code{an} vector of \eqn{a_{1->n}} harmonic coefficients
#' \item \code{bn} vector of \eqn{b_{1->n}} harmonic coefficients
#' \item \code{phi} vector of variation of the tangent angle
#' \item \code{t} vector of distance along the perimeter expressed in radians
#' \item \code{perimeter} numeric. The perimeter of the outline
#' \item \code{thetao} numeric. The first tangent angle
#' \item \code{x1} The x-coordinate of the first point
#' \item \code{y1} The y-coordinate of the first point.
#' }
#' @family tfourier
#' @note Directly borrowed for Claude (2008), and called \code{fourier2} there.
#' @references Zahn CT, Roskies RZ. 1972. Fourier Descriptors for Plane Closed
#' Curves. \emph{IEEE Transactions on Computers} \bold{C-21}: 269-281.
#'
#' Claude, J. (2008) \emph{Morphometrics with R}, Use R! series, Springer 316
#' pp.
#' @examples
#' coo <- bot[1]
#' coo_plot(coo)
#' tf <- tfourier(coo, 12)
#' tf
#' tfi <- tfourier_i(tf)
#' coo_draw(tfi, border='red', col=NA) # the outline is not closed...
#' coo_draw(tfourier_i(tf, force2close=TRUE), border='blue', col=NA) # we force it to close.
#' @rdname tfourier
#' @export
tfourier <- function(x, ...) {
UseMethod("tfourier")
}
#' @rdname tfourier
#' @export
tfourier.default <- function(x, nb.h, smooth.it = 0, norm = FALSE, ...) {
coo <- x
if (missing(nb.h)) {
nb.h <- 12
message("'nb.h' not provided and set to ", nb.h)
}
if (is.list(coo)) {
coo <- l2m(coo)
}
if (coo_is_closed(coo)) {
coo <- coo_unclose(coo)
}
if (nb.h * 2 > nrow(coo)) {
nb.h = floor(nrow(coo)/2)
if (.is_verbose()) {
message("'nb.h' must be lower than half the number of points and has been set to ",
nb.h)
}
}
if (nb.h == -1) {
nb.h = floor(nrow(coo)/2)
if (.is_verbose()) {
message("'nb.h' must be lower than half the number of points. It has been set to ", nb.h, " harmonics")
}
}
if (smooth.it != 0) {
coo <- coo_smooth(coo, smooth.it)
}
if (norm) {
coo <- coo_scale(coo_center(coo))
coo <- coo_trans(coo, -coo[1, 1], -coo[1, 2])
}
p <- nrow(coo)
an <- bn <- numeric(nb.h)
tangvect <- coo - rbind(coo[p, ], coo[-p, ])
perim <- sum(sqrt(apply((tangvect)^2, 1, sum)))
v0 <- coo[1, ] - coo[p, ]
tet1 <- Arg(complex(real = tangvect[, 1], imaginary = tangvect[,
2]))
tet0 <- tet1[1]
t1 <- seq(0, 2 * pi, length = (p + 1))[1:p]
phi <- (tet1 - tet0 - t1)%%(2 * pi)
ao <- 2 * sum(phi)/p
for (i in 1:nb.h) {
an[i] <- (2/p) * sum(phi * cos(i * t1))
bn[i] <- (2/p) * sum(phi * sin(i * t1))
}
list(ao = ao, an = an, bn = bn, phi = phi, t = t1, perimeter = perim,
thetao = tet0, x1 = coo[1, 1], y1 = coo[1, 2])
}
#' @rdname tfourier
#' @export
tfourier.Out <- function(x, nb.h = 40, smooth.it = 0, norm = TRUE, ...) {
Out <- x
# verify
Out %<>% verify()
q <- floor(min(sapply(Out$coo, nrow)/2))
if (missing(nb.h)) {
nb.h <- calibrate_harmonicpower_tfourier(Out,
thresh = 99, plot=FALSE)$minh
if (.is_verbose()) message("'nb.h' not provided and set to ", nb.h, " (99% harmonic power)")
}
if (nb.h > q) {
nb.h <- q # should not be 1
message("at least one outline has no more than ", q * 2,
" coordinates. 'nb.h' has been set to ", q,
" harmonics")
}
coo <- Out$coo
col.n <- paste0(rep(LETTERS[1:2], each = nb.h), rep(1:nb.h,
times = 2))
coe <- matrix(ncol = 2 * nb.h, nrow = length(coo), dimnames = list(names(coo),
col.n))
for (i in seq(along = coo)) {
tf <- tfourier(coo[[i]], nb.h = nb.h, smooth.it = smooth.it,
norm = norm)
coe[i, ] <- c(tf$an, tf$bn)
}
res <- OutCoe(coe = coe, fac = Out$fac, method = "tfourier",norm = norm)
res$cuts <- ncol(res$coe)
return(res)
}
#' @rdname tfourier
#' @export
tfourier.list <- function(x, ...){
lapply(x, tfourier, ...)
}
#' Inverse tangent angle Fourier transform
#'
#' \code{tfourier_i} uses the inverse tangent angle Fourier transformation to
#' calculate a shape, when given a list with Fourier coefficients, typically
#' obtained computed with \link{tfourier}.
#'
#' See \link{tfourier} for the mathematical background.
#'
#' @param tf a list with ao, an and bn components, typically as returned by
#' tfourier
#' @param nb.h \code{integer}. The number of harmonics to calculate/use
#' @param nb.pts \code{integer}. The number of points to calculate
#' @param force2close \code{logical}. Whether to force the outlines calculated
#' to close (see \link{coo_force2close}).
#' @param rescale \code{logical}. Whether to rescale the points calculated so
#' that their perimeter equals \code{perim}.
#' @param perim The perimeter length to rescale shapes.
#' @param thetao \code{numeric}. Radius angle to the reference (in radians)
#' @return A list with components: \item{x }{\code{vector} of
#' \code{x}-coordinates.} \item{y }{\code{vector} of \code{y}-coordinates.}
#' \item{phi }{\code{vector} of interpolated changes on the tangent angle.}
#' \item{angle }{\code{vector} of position on the perimeter (in radians).}
#' @family tfourier
#' @note Directly borrowed for Claude (2008), and called \code{ifourier2} there.
#' @references Zahn CT, Roskies RZ. 1972. Fourier Descriptors for Plane Closed
#' Curves. \emph{IEEE Transactions on Computers} \bold{C-21}: 269-281.
#'
#' Claude, J. (2008) \emph{Morphometrics with R}, Use R! series, Springer 316
#' pp.
#' @examples
#' tfourier(bot[1], 24)
#' tfourier_shape()
#' @export
tfourier_i <- function(tf, nb.h, nb.pts = 120, force2close = FALSE,
rescale = TRUE, perim = 2 * pi, thetao = 0) {
if (!all(c("an", "bn") %in% names(tf))) {
stop("a list containing 'an' and 'bn' harmonic coefficients must be provided")
}
ao <- ifelse(is.null(tf$ao), 0, tf$ao)
if (missing(thetao)) {
thetao <- ifelse(is.null(tf$thetao), 0, tf$thetao)
}
an <- tf$an
bn <- tf$bn
if (missing(nb.h)) {
nb.h <- length(an)
}
if (nb.h > length(an)) {
nb.h <- length(an)
}
theta <- seq(0, 2 * pi, length = nb.pts)
harm <- matrix(NA, nrow = nb.h, ncol = nb.pts)
for (i in 1:nb.h) {
harm[i, ] <- an[i] * cos(i * theta) + bn[i] * sin(i *
theta)
}
phi <- (ao/2) + apply(harm, 2, sum)
vect <- matrix(NA, 2, nb.pts)
Z <- complex(modulus = (2 * pi)/nb.pts, argument = phi +
theta + thetao)
Z1 <- cumsum(Z)
coo <- cbind(Re(Z1), Im(Z1))
if (force2close) {
coo <- coo_force2close(coo)
}
if (rescale) {
if (missing(perim)) {
perim <- ifelse(is.null(tf$perim), 2 * pi, tf$perim)
}
coo <- coo_scale(coo, coo_perim(coo)/perim)
}
if (!all(is.null(tf$x1) & is.null(tf$x1))) {
coo <- coo_trans(coo, tf$x1, tf$y1)
}
# return(list(x=coo[, 1], y=coo[, 2], angle=theta, phi=phi))}
colnames(coo) <- c("x", "y")
return(coo)
}
#' Calculates and draws 'tfourier' shapes.
#'
#' \code{tfourier_shape} calculates a 'Fourier tangent angle shape' given
#' Fourier coefficients (see \code{Details}) or can generate some 'tfourier'
#' shapes.
#'
#' @param an \code{numeric}. The \eqn{a_n} Fourier coefficients on which to
#' calculate a shape.
#' @param bn \code{numeric}. The \eqn{b_n} Fourier coefficients on which to
#' calculate a shape.
#' @param ao \code{ao} Harmonic coefficient.
#' @param nb.h \code{integer}. The number of harmonics to use.
#' @param nb.pts \code{integer}. The number of points to calculate.
#' @param alpha \code{numeric}. The power coefficient associated with the
#' (usually decreasing) amplitude of the Fourier coefficients (see
#' \bold{Details}).
#' @param plot \code{logical}. Whether to plot or not the shape.
#' @return A matrix of (x; y) coordinates.
#' @family tfourier
#' @references Claude, J. (2008) \emph{Morphometrics with R}, Use R! series,
#' Springer 316 pp.
#' @examples
#' tf <- tfourier(bot[1], 24)
#' tfourier_shape(tf$an, tf$bn) # equivalent to rfourier_i(rf)
#' tfourier_shape()
#' tfourier_shape(nb.h=6, alpha=0.4, nb.pts=500)
#' panel(Out(a2l(replicate(100,
#' coo_force2close(tfourier_shape(nb.h=6, alpha=2, nb.pts=200, plot=FALSE)))))) # biological shapes
#' @export
tfourier_shape <- function(an, bn, ao = 0, nb.h, nb.pts = 80,
alpha = 2, plot = TRUE) {
if (missing(nb.h) & missing(an))
nb.h <- 1
if (missing(nb.h) & !missing(an))
nb.h <- length(an)
if (missing(an))
an <- runif(nb.h, -pi, pi)/(1:nb.h)^alpha
if (missing(bn))
bn <- runif(nb.h, -pi, pi)/(1:nb.h)^alpha
tf <- list(an = an, bn = bn, ao = ao)
shp <- tfourier_i(tf, nb.h = nb.h, nb.pts = nb.pts)
if (plot)
coo_plot(shp)
return(shp)
}
##### end tfourier
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.