part of #13 and #106

DESCRIPTION

@@ -1,47 +1,54 @@
 Package: Momocs
 Title: Morphometrics using R
-Version: 0.9.57
-Date: 2015-11-26
+Version: 0.9.58
+Date: 2015-11-27
 Authors@R: c( person("Vincent", "Bonhomme", ,
-        "bonhomme.vincent@gmail.com", c("aut", "cre")), person("Julien",
-        "Claude", , , c("aut")) )
-Description: Aiming to provide a complete and convenient toolkit for
-        morphometrics, Momocs is intended for scientists interested in
-        describing quantitatively the shape, and its variations, of the
-        objects they study. In the last decade, R has become the
-        open-source lingua franca for statistics, and morphometrics
-        known its so-called 'revolution'. Nevertheless, morphometric
-        analyses still have to be carried out using various software
-        packages, for which source code is mostly unavailable or
-        copyrighted. Moreover, existing software packages cannot be
-        extended and their bugs are hard to detect and thus correct.
-        This situation is detrimental to morphometrics; time is wasted,
-        analyses are restricted to available methods, and last but not
-        least, are poorly reproducible. This impedes collaborative
-        effort both in software development and in morphometric studies.
-        By gathering the common morphometric approaches in an
-        open-source environment and welcoming contributions, Momocs is
-        an (work-in-progress) attempt to solve this twofold problem and
-        to push morphometrics one step further. It hinges on the core
-        functions published in the book Morphometrics using R (Claude,
-        2008), but has been further extended to allow other shape
-        description systems. So far, configurations of landmarks,
-        outlines and open outline analyses, along with some facilities
-        for traditional morphometrics have been implemented. Prior to
-        analysis, Momocs can be used to acquire and manipulate data or
-        to import/export from/to other formats. Momocs also has the
-        facility for a wide range of multivariate analyses and
-        production of the companion graphics. Thus a researcher will
-        find that just a few lines of code will provide initial results,
-        but the methods implemented can be finely tuned and extended
-        according to the user's needs.
+      "bonhomme.vincent@gmail.com", c("aut", "cre")),
+      person("Julien", "Claude", , , c("aut")) )
+Description: Aiming to provide a complete and convenient
+      toolkit for morphometrics, Momocs is intended for
+      scientists interested in describing quantitatively
+      the shape, and its variations, of the objects they
+      study. In the last decade, R has become the
+      open-source lingua franca for statistics, and
+      morphometrics known its so-called 'revolution'.
+      Nevertheless, morphometric analyses still have to be
+      carried out using various software packages, for
+      which source code is mostly unavailable or
+      copyrighted. Moreover, existing software packages
+      cannot be extended and their bugs are hard to detect
+      and thus correct. This situation is detrimental to
+      morphometrics; time is wasted, analyses are
+      restricted to available methods, and last but not
+      least, are poorly reproducible. This impedes
+      collaborative effort both in software development and
+      in morphometric studies. By gathering the common
+      morphometric approaches in an open-source environment
+      and welcoming contributions, Momocs is an
+      (work-in-progress) attempt to solve this twofold
+      problem and to push morphometrics one step further.
+      It hinges on the core functions published in the book
+      Morphometrics using R (Claude, 2008), but has been
+      further extended to allow other shape description
+      systems. So far, configurations of landmarks,
+      outlines and open outline analyses, along with some
+      facilities for traditional morphometrics have been
+      implemented. Prior to analysis, Momocs can be used to
+      acquire and manipulate data or to import/export
+      from/to other formats. Momocs also has the facility
+      for a wide range of multivariate analyses and
+      production of the companion graphics. Thus a
+      researcher will find that just a few lines of code
+      will provide initial results, but the methods
+      implemented can be finely tuned and extended
+      according to the user's needs.
 License: GPL-2 | GPL-3
 URL: http://www.vincentbonhomme.fr/Momocs
 BugReports: https://github.com/vbonhomme/Momocs
 Depends: R(>= 3.1)
 LazyData: true
-Imports: ape, dplyr, magrittr, graphics, geometry, ggplot2, jpeg, MASS,
-        plyr, reshape2, sp, utils
+Imports: ape, dplyr, magrittr, graphics, geometry, ggplot2,
+      jpeg, MASS, plyr, reshape2, sp, utils
 Suggests: devtools, ggtree, knitr, rmarkdown
 VignetteBuilder: knitr
 RoxygenNote: 5.0.1

Momocs.Rproj

@@ -18,4 +18,4 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageInstallArgs: --no-multiarch
 PackageCheckArgs: --as-cran
-PackageRoxygenize: rd,collate,namespace,vignette
+PackageRoxygenize: rd,collate,namespace

NAMESPACE

@@ -187,6 +187,8 @@ S3method(filter,PCA)
 S3method(filter,default)
 S3method(get_cur_binded,Coo)
 S3method(get_cur_binded,Ldk)
+S3method(get_curcoo_binded,Ldk)
+S3method(get_curcoo_binded,default)
 S3method(get_ldk,Ldk)
 S3method(get_ldk,Opn)
 S3method(get_ldk,Out)
@@ -490,6 +492,7 @@ export(filter)
 export(get_chull_area)
 export(get_chull_volume)
 export(get_cur_binded)
+export(get_curcoo_binded)
 export(get_ldk)
 export(get_pairs)
 export(harm_pow)
@@ -515,6 +518,10 @@ export(is.OpnCoe)
 export(is.Out)
 export(is.OutCoe)
 export(is.PCA)
+export(is.cur)
+export(is.fac)
+export(is.ldk)
+export(is.links)
 export(is_closed)
 export(l2a)
 export(l2m)
@@ -531,6 +538,7 @@ export(links_delaunay)
 export(m2a)
 export(m2d)
 export(m2l)
+export(m2ll)
 export(measure)
 export(mshapes)
 export(mutate)

R/babel-bridges.R

@@ -16,15 +16,14 @@
 #' l
 #' m <- l2m(l)
 #' m
-#' @family babel functions
+#' @family bridges functions
 #' @export
 l2m <- function(l) {
     m <- cbind(l$x, l$y)
     colnames(m) <- c("x", "y")
     return(m)
 }
 
-
 #' Converts a list of coordinates to an array of coordinates
 #'
 #' l2a converts a list of \code{k} matrices with \code{m} rows
@@ -36,14 +35,14 @@ l2m <- function(l) {
 #' @usage l2a(l)
 #' @param l \code{list} of matrices of the same dimension.
 #' @return an array of coordinates.
-#' @seealso \link{a2l}.
+#' @family bridges functions
 #' @examples
 #' data(wings)
 #' l <- wings$coo
 #' l
 #' a <- l2a(l)
 #' a
-#' @family babel functions
+#' @family bridges functions
 #' @export
 l2a <- function(l) {
     .check(length(unique(sapply(l, length))) == 1,
@@ -73,7 +72,7 @@ l2a <- function(l) {
 #' l
 #' a <- l2a(l)
 #' a
-#' @family babel functions
+#' @family bridges functions
 #' @export
 a2l <- function(a) {
     .check(is.array(a) & length(dim(a)==3),
@@ -101,7 +100,7 @@ a2l <- function(a) {
 #' data(wings)
 #' a <- l2a(wings$coo)
 #' a
-#' @family babel functions
+#' @family bridges functions
 #' @export
 a2m <- function(a) {
     # ugly
@@ -130,7 +129,7 @@ a2m <- function(a) {
 #' data(wings)
 #' m <- a2m(l2a(wings$coo))
 #' m2a(m)
-#' @family babel functions
+#' @family bridges functions
 #' @export
 m2a <- function(m) {
     # ugly
@@ -153,7 +152,7 @@ m2a <- function(m) {
 #' @examples
 #' data(wings)
 #' m2d(wings[3])
-#' @family babel functions
+#' @family bridges functions
 #' @export
 m2d <- function(m){
   m <- coo_check(m)
@@ -176,12 +175,37 @@ m2d <- function(m){
 #' l
 #' m <- l2m(l)
 #' m
-#' @family babel functions
+#' @family bridges functions
 #' @export
 m2l <- function(m) {
   return(list(x = m[, 1], y = m[, 2]))
 }
 
+#’ Converts a matrix of coordinates into a list of matrices
+#'
+#' Used internally to hanle coo and cur in \code{Ldk} objects but may be
+#' useful elsewhere
+#' @param m \code{matrix}, typically of (x; y) coordinates
+#' @param index \code{numeric}, the number of coordinates for every slice.
+#' @examples
+#' m2ll(wings[1], c(6, 4, 3, 5))
+#' @family bridges functions
+#' @export
+m2ll <- function(m, index=NULL){
+  # no slicing case, we return a matrix
+  if (is.null(index))
+    return(m)
+  # slicing case, we slices
+  .check(sum(index)==nrow(m),
+         "nrow(m) and sum(index) must match")
+  start <- cumsum(c(1, index[-length(index)]))
+  end   <- cumsum(index)
+  ll <- vector("list", length(start))
+  for (i in seq_along(start)){
+    ll[[i]] <- m[start[i]:end[i], ]
+  }
+  return(ll)
+}
 
 # as_df --------------------------------
 
@@ -199,7 +223,7 @@ m2l <- function(m) {
 #' head(as_df(bot.p))
 #' bot.l <- LDA(bot.p, "type")
 #' head(as_df(bot.l))
-#' @family babel functions
+#' @family bridges functions
 #' @export
 as_df <- function(x){
   UseMethod("as_df")

R/cl-def-CooCoe.R

@@ -423,9 +423,13 @@ names.Coe <- function(x) {
 }
 
 # component testers ---------
-is.fac <- function(x) length(x$fac) > 0
-is.ldk <- function(x) length(x$ldk) > 0
-is.cur <- function(x) length(x$cur) > 0
+#' @export
+is.fac   <- function(x) length(x$fac) > 0
+#' @export
+is.ldk   <- function(x) length(x$ldk) > 0
+#' @export
+is.cur   <- function(x) length(x$cur) > 0
+#' @export
 is.links <- function(x) is.matrix(x$links)
 
 

R/cl-def-Opn.R

@@ -164,17 +164,17 @@ print.OpnCoe <- function(x, ...) {
   cat("An OpnCoe object [", met)
   cat(rep("-", 20), "\n", sep = "")
   coo_nb <- nrow(OpnCoe$coe)  #nrow method ?
+  cat(" - $coe:", coo_nb, "open outlines described\n")
   if (combined) {
     degree <- ncol(OpnCoe$coe)
     # p==3 is the case for dfourier all along the method
     # if (p==3) degree <- degree/2
     # number of outlines and harmonics
-    cat(" - $coe:", coo_nb, "open outlines described\n")
-#     if (p==3){
-#       cat(degree, " harmonics\n", sep="")
-#     } else {
-#       cat(degree, "th degree (+Intercept)\n", sep="")
-#     }
+    #     if (p==3){
+    #       cat(degree, " harmonics\n", sep="")
+    #     } else {
+    #       cat(degree, "th degree (+Intercept)\n", sep="")
+    #     }
     # we print the baselines
     if (!is.null(c(x$baseline1, x$baseline2))) {
       cat(" - $baseline1: (", paste(x$baseline1, collapse="; "), ")\n", sep="")
@@ -190,16 +190,20 @@ print.OpnCoe <- function(x, ...) {
     print(round(OpnCoe$coe[row.eg, col.eg], 3))
     cat("etc.\n")
   } else {
-    cat(" - $baseline1, $baseline2: baselines registrations\n")
-    cat(" - $coe: coefficients\n")}
-#   if (p != 3) {
-#     # r2 quick summary
-#     r2  <- OpnCoe$r2
-#     cat(" - $r2: min=", signif(min(r2), 3),
-#         ", median=",    signif(median(r2), 3),
-#         ", mean=",      signif(mean(r2), 3),
-#         ", sd=",        signif(mean(r2), 3),
-#         ", max=",       signif(max(r2), 3), "\n", sep="")}
+    # we print the baselines
+    if (!is.null(c(x$baseline1, x$baseline2))) {
+      cat(" - $baseline1: (", paste(x$baseline1, collapse="; "), "), ", sep="")
+      cat("$baseline2: (", paste(x$baseline2, collapse="; "), ")\n", sep="")
+    }
+  }
+  #   if (p != 3) {
+  #     # r2 quick summary
+  #     r2  <- OpnCoe$r2
+  #     cat(" - $r2: min=", signif(min(r2), 3),
+  #         ", median=",    signif(median(r2), 3),
+  #         ", mean=",      signif(mean(r2), 3),
+  #         ", sd=",        signif(mean(r2), 3),
+  #         ", max=",       signif(max(r2), 3), "\n", sep="")}
   # we print the fac
   .print.fac(OpnCoe$fac)
 }

R/cl-utilities.R

@@ -399,12 +399,13 @@ get_ldk.Out <- function(Coo) {
 #' @export
 get_ldk.Opn <- get_ldk.Out
 
-#' Retrieves semi-landmarks coordinates from Ldk objects
+#' Binds semi-landmarks coordinates from Ldk objects
 #'
 #' Binds groups (if any) of landmarks from the \code{$cur}
 #' on \link{Ldk} objects
 #' @param Ldk an \link{Ldk} object
 #' @return a list of matrices
+#' @family get_cur functions
 #' @export
 get_cur_binded <- function(Ldk){
   UseMethod("get_cur_binded")
@@ -423,6 +424,36 @@ function(Ldk){
   lapply(Ldk$cur, function(x) do.call(rbind, x))
 }
 
+#' Binds landmarks and semi-landmarks coordinates from Ldk objects
+#'
+#' Binds \code{$coo} with groups (if any) of landmarks from the \code{$cur}
+#' on \link{Ldk} objects
+#' @param Ldk an \link{Ldk} object
+#' @family get_cur functions
+#' @return a list of matrices
+#' @export
+get_curcoo_binded <- function(x){
+  UseMethod("get_curcoo_binded")
+}
+
+#' @export
+get_curcoo_binded.default <- function(x){
+  cat("* only defined on Ldk objects")
+}
+
+#' @export
+get_curcoo_binded.Ldk <- function(x){
+  # if there are cur, we bind them after Coo
+  if (is.cur(x)){
+    x$nb_cur <- c(nrow(x$coo[[1]]), sapply(x$cur[[1]], nrow))
+    x$coo <- mapply("rbind", x$coo, get_cur_binded(x), SIMPLIFY=FALSE)
+    x$cur    <- NULL
+  }
+  return(x)
+  # curve case. we bind
+}
+
+
 # class testers -------------
 #' Tests if an object is of a given class
 #'

R/coo-utilities.R

@@ -489,6 +489,7 @@ coo_trans.Coo <- function(coo, x = 0, y = 0) {
   return(Coo)
 }
 
+# coo_slice------------------
 #' Slices shapes between successive coordinates
 #'
 #' Takes a shape with n coordinates. When you pass this function with at least