Commit cd0102cf by Eric Coissac

Internal docs + beginning of considering factors in the model

parent 0a9031a8
...@@ -9,37 +9,60 @@ NULL ...@@ -9,37 +9,60 @@ NULL
#' initial row count #' initial row count
#' #'
#' @param x The matrix to replicate #' @param x The matrix to replicate
#' @param length.out an interger value specifying the number of row #' @param nrow an interger value specifying the number of row
#' of the returned matrix #' of the returned matrix
#' #'
#' @return a new matrix with the same number of columns but with `length.out` #' @return a new matrix with the same number of columns but with `nrow`
#' rows. #' rows.
#' #'
#' @author Eric Coissac #' @author Eric Coissac <eric.coissac@metabarcoding.org>
#' @author Christelle Gonindard-Melodelima #' @author Christelle Gonindard-Melodelima <christelle.gonindard@metabarcoding.org>
#' @rdname rep_matrix #' @rdname internal.rep_matrix
#' #'
.rep_matrix = function(x,length.out) { .rep_matrix = function(x,nrow) {
N = nrow(x) N = nrow(x)
if ((length.out %% N != 0L)) if ((nrow %% N != 0L))
stop(sprintf("The size of the longest object (%d) is not a multiple of the size of the shortest (%d)", stop(sprintf("The size of the longest object (%d) is not a multiple of the size of the shortest (%d)",
nrows,N), nrows,N),
domain = NA) domain = NA)
rep=x rep=x
while (nrow(rep) < length.out) while (nrow(rep) < nrow)
rep = rbind(rep,x) rep = rbind(rep,x)
return(rep) return(rep)
} }
.procmod_coerce_value = function(x,nrows=0) { #' Internal function coercing the data to a matrix.
#'
#' @description Transforme the \code{x} value into a \code{numeric matrix} of
#' the correct size or into a \code{dist} object.
#'
#' @param x The data to coerce
#' @param nrows an interger value specifying the number of row
#' of the returned matrix
#'
#' @return a new numeric matrix with correct size.
#'
#' @author Eric Coissac <eric.coissac@metabarcoding.org>
#' @author Christelle Gonindard-Melodelima <christelle.gonindard@metabarcoding.org>
#' @rdname internal.procmod_coerce_value
#'
.procmod_coerce_value = function(x,nrows=0,contrasts=NULL) {
xi <- if (is.data.frame(x)) xi <- if (is.data.frame(x))
as.matrix(x) as.matrix(x)
else if (is.matrix(x) || inherits(x,'dist')) else if (is.matrix(x) || inherits(x,'dist'))
x x
else if (is.factor(x)) {
if (is.null(contrasts))
contrasts(x)[x,]
else if (is.character(contrasts) || is.function(contrasts))
match.fun(contrasts,descend=FALSE)(x)[x,]
else
contrasts[x,]
}
else else
as.matrix(x) as.matrix(x)
...@@ -61,7 +84,7 @@ NULL ...@@ -61,7 +84,7 @@ NULL
if (nrows > 0L && N < nrows) { if (nrows > 0L && N < nrows) {
if (N > 0L && (nrows %% N == 0L)) if (N > 0L && (nrows %% N == 0L))
xi <- .rep_matrix(xi, length.out = nrows) xi <- .rep_matrix(xi, nrow = nrows)
else stop(sprintf(ngettext(N, "replacement has %d row, data has %d", else stop(sprintf(ngettext(N, "replacement has %d row, data has %d",
"replacement has %d rows, data has %d"), "replacement has %d rows, data has %d"),
N, nrows), N, nrows),
...@@ -126,7 +149,8 @@ procmod.frame = function(..., ...@@ -126,7 +149,8 @@ procmod.frame = function(...,
row.names = NULL, row.names = NULL,
check.rows = FALSE, check.rows = FALSE,
check.names = TRUE, check.names = TRUE,
reorder.rows = FALSE) reorder.rows = FALSE,
contrasts.arg = NULL)
{ {
has.row.names = ! missing(row.names) has.row.names = ! missing(row.names)
...@@ -150,11 +174,14 @@ procmod.frame = function(..., ...@@ -150,11 +174,14 @@ procmod.frame = function(...,
types <- character(n) types <- character(n)
for (i in seq_len(n)) { for (i in seq_len(n)) {
contrasts = contrasts.arg[varnames[i]]
if (i==1) if (i==1)
xi <- .procmod_coerce_value(x[[i]]) xi <- .procmod_coerce_value(x[[i]],
contrasts=contrasts)
else else
xi <- .procmod_coerce_value(x[[i]], xi <- .procmod_coerce_value(x[[i]],
nrows = nrows[1]) nrows = nrows[1],
contrasts=contrasts)
if (reorder.rows && if (reorder.rows &&
! is.null(row.names) && ! is.null(row.names) &&
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
\title{The procmod.frame data structure.} \title{The procmod.frame data structure.}
\usage{ \usage{
procmod.frame(..., row.names = NULL, check.rows = FALSE, procmod.frame(..., row.names = NULL, check.rows = FALSE,
check.names = TRUE, reorder.rows = FALSE) check.names = TRUE, reorder.rows = FALSE, contrasts.arg = NULL)
is.procmod.frame(x) is.procmod.frame(x)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment