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 #' @author Christelle Gonindard-Melodelima #' @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 #' @author Christelle Gonindard-Melodelima #' @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!