# R/core-opn-bezier.R In Momocs: Morphometrics using R

#### Documented in bezierbezier_i

# bezier core --------
#' Calculates Bezier coefficients from a shape
#'
#' @param coo a matrix or a list of (x; y) coordinates
#' @param n the degree, by default the number of coordinates.
#' @return a list with components:
#' \itemize{
#' \item \code{$J} matrix of Bezier coefficients #' \item \code{$B} matrix of Bezier vertices.
#' }
#' @note Directly borrowed for Claude (2008), and also called \code{bezier} there.
#' Not implemented for open outlines but may be useful for other purposes.
#' @references Claude, J. (2008) \emph{Morphometrics with R}, Use R! series,
#' Springer 316 pp.
#' @family bezier functions
#' @examples
#' set.seed(34)
#' x <- coo_sample(efourier_shape(), 5)
#' plot(x, ylim=c(-3, 3), asp=1, type='b', pch=20)
#' b <- bezier(x)
#' bi <- bezier_i(b$B) #' lines(bi, col='red') #' @export bezier <- function(coo, n) { coo <- coo_check(coo) if (missing(n)) n <- nrow(coo) p <- nrow(coo) if (n != p) { n <- n + 1 } coo1 <- coo/coo_perimcum(coo)[p] t1 <- 1 - coo_perimcum(coo1) J <- matrix(NA, p, p) for (i in 1:p) { for (j in 1:p) { J[i, j] <- (factorial(p - 1)/(factorial(j - 1) * factorial(p - j))) * (((1 - t1[i])^(j - 1)) * t1[i]^(p - j)) } } B <- MASS::ginv(t(J[, 1:n]) %*% J[, 1:n]) %*% (t(J[, 1:n])) %*% coo coo <- J[, 1:n] %*% B B <- MASS::ginv(t(J[, 1:n]) %*% J[, 1:n]) %*% (t(J[, 1:n])) %*% coo list(J = J, B = B) } #' Calculates a shape from Bezier coefficients #' #' @param B a matrix of Bezier vertices, such as those produced by \link{bezier} #' @param nb.pts the number of points to sample along the curve. #' @return a matrix of (x; y) coordinates #' @note Directly borrowed for Claude (2008), and called \code{beziercurve} there. #' Not implemented for open outlines but may be useful for other purposes. #' @references Claude, J. (2008) \emph{Morphometrics with R}, Use R! series, #' Springer 316 pp. #' @family bezier functions #' @examples #' set.seed(34) #' x <- coo_sample(efourier_shape(), 5) #' plot(x, ylim=c(-3, 3), asp=1, type='b', pch=20) #' b <- bezier(x) #' bi <- bezier_i(b$B)
#' lines(bi, col='red')
#' @export
bezier_i <- function(B, nb.pts = 120) {
if (any(names(B)=="B")) B <- B\$B
x <- y <- numeric(nb.pts)
n <- nrow(B) - 1
t1 <- seq(0, 1, length = nb.pts)
coef <- choose(n, k = 0:n)
b1 <- 0:n
b2 <- n:0
for (j in 1:nb.pts) {
vectx <- vecty <- NA
for (i in 1:(n + 1)) {
vectx[i] <- B[i, 1] * coef[i] * t1[j]^b1[i] * (1 -
t1[j])^b2[i]
vecty[i] <- B[i, 2] * coef[i] * t1[j]^b1[i] * (1 -
t1[j])^b2[i]
}
x[j] <- sum(vectx)
y[j] <- sum(vecty)
}
coo <- cbind(x, y)
return(coo)
}

##### end Bezier


## Try the Momocs package in your browser

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

Momocs documentation built on March 23, 2018, 1:04 a.m.