SCM

SCM Repository

[matrix] Diff of /pkg/R/sparseMatrix.R
ViewVC logotype

Diff of /pkg/R/sparseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2093, Thu Nov 22 15:54:17 2007 UTC revision 2094, Tue Dec 4 23:41:41 2007 UTC
# Line 524  Line 524 
524  }  }
525    
526  setAs("factor", "sparseMatrix", function(from) fac2sparse(from, to = "d"))  setAs("factor", "sparseMatrix", function(from) fac2sparse(from, to = "d"))
527    
528    # xtabs returning a sparse matrix.  This should probably be an option
529    # for the xtabs function
530    sxtabs <- function (formula = ~., data = parent.frame(), subset, na.action,
531        exclude = c(NA, NaN), drop.unused.levels = FALSE)
532    {
533        if (missing(formula) && missing(data))
534            stop("must supply either 'formula' or 'data'")
535        if (!missing(formula)) {
536            formula <- as.formula(formula)
537            if (!inherits(formula, "formula"))
538                stop("'formula' missing or incorrect")
539        }
540        if (any(attr(terms(formula, data = data), "order") > 1))
541            stop("interactions are not allowed")
542        m <- match.call(expand.dots = FALSE)
543        if (is.matrix(eval(m$data, parent.frame())))
544            m$data <- as.data.frame(data)
545        m$... <- m$exclude <- m$drop.unused.levels <- NULL
546        m[[1]] <- as.name("model.frame")
547        mf <- eval(m, parent.frame())
548        if(length(formula) == 2) {
549            by <- mf
550            y <- NULL
551        }
552        else {
553            i <- attr(attr(mf, "terms"), "response")
554            by <- mf[-i]
555            y <- mf[[i]]
556        }
557        by <- lapply(by, function(u) {
558            if(!is.factor(u)) u <- factor(u, exclude = exclude)
559            u[ , drop = drop.unused.levels]
560        })
561        if (length(by) != 2)
562            stop("sxtabs applies only to two-way tables")
563        rows <- by[[1]]
564        cols <- by[[2]]
565        rl <- levels(rows)
566        cl <- levels(cols)
567        if (is.null(y))
568            y <- rep(1, length(rows))
569        as(new("dgTMatrix",
570               list(i = as.integer(rows),
571                    j = as.integer(cols),
572                    x = y,
573                    Dim = c(length(rl), length(cl)),
574                    Dimnames = list(rl, cl))), "CsparseMatrix")
575    }

Legend:
Removed from v.2093  
changed lines
  Added in v.2094

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge