Commit cd0102cf by Eric Coissac

Internal docs + beginning of considering factors in the model

parent 0a9031a8
......@@ -9,37 +9,60 @@ NULL
#' initial row count
#'
#' @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
#'
#' @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.
#'
#' @author Eric Coissac
#' @author Christelle Gonindard-Melodelima
#' @rdname rep_matrix
#' @author Eric Coissac <eric.coissac@metabarcoding.org>
#' @author Christelle Gonindard-Melodelima <christelle.gonindard@metabarcoding.org>
#' @rdname internal.rep_matrix
#'
.rep_matrix = function(x,length.out) {
.rep_matrix = function(x,nrow) {
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)",
nrows,N),
domain = NA)
rep=x
while (nrow(rep) < length.out)
while (nrow(rep) < nrow)
rep = rbind(rep,x)
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))
as.matrix(x)
else if (is.matrix(x) || inherits(x,'dist'))
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
as.matrix(x)
......@@ -61,7 +84,7 @@ NULL
if (nrows > 0L && N < nrows) {
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",
"replacement has %d rows, data has %d"),
N, nrows),
......@@ -126,7 +149,8 @@ procmod.frame = function(...,
row.names = NULL,
check.rows = FALSE,
check.names = TRUE,
reorder.rows = FALSE)
reorder.rows = FALSE,
contrasts.arg = NULL)
{
has.row.names = ! missing(row.names)
......@@ -150,11 +174,14 @@ procmod.frame = function(...,
types <- character(n)
for (i in seq_len(n)) {
contrasts = contrasts.arg[varnames[i]]
if (i==1)
xi <- .procmod_coerce_value(x[[i]])
xi <- .procmod_coerce_value(x[[i]],
contrasts=contrasts)
else
xi <- .procmod_coerce_value(x[[i]],
nrows = nrows[1])
nrows = nrows[1],
contrasts=contrasts)
if (reorder.rows &&
! is.null(row.names) &&
......
......@@ -7,7 +7,7 @@
\title{The procmod.frame data structure.}
\usage{
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)
......
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