Nothing
# 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
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.