The R Project SVN R-packages

setAs("matrix", "lMatrix",
      function(from) { storage.mode(from) <- "logical" ; Matrix(from) })

setAs("lMatrix", "nMatrix",
      function(from) {
      if(any(is.na(from@x)))
          stop("\"lMatrix\" object with NAs cannot be coerced to \"nMatrix\"")
      ## i.e. from@x are only TRUE (or FALSE in dense case)
      cl <- class(from)
      if(extends(cl, "diagonalMatrix")) # have no "ndi*" etc class
          cl <- class(from <- as(from, "sparseMatrix"))
      nCl <- sub("^l", "n", cl)
      sNams <- slotNames(if(extends(cl, "sparseMatrix")) .sp.class(cl) else cl)
      r <- new(nCl)# default => no validity check; and copy slots:
      for(nm in sNams)
          slot(r, nm) <- slot(from, nm)
      r
      })

## and the reverse as well :

setAs("nMatrix", "lMatrix",
      function(from) {
      cl <- class(from)
      nCl <- sub("^n", "l", cl)
      r <- new(nCl)# default => no validity check; and copy slots:
      ## result is "same", for sparse just with an 'x' slot
      if(extends(cl, "sparseMatrix"))
          slot(r, "x") <- rep.int(TRUE, nnzero(from))
      for(nm in slotNames(cl))
          slot(r, nm) <- slot(from, nm)
      r
      })

setAs("dMatrix", "lMatrix",
      function(from) {
      r <- new(class2(class(from), "l"))# default => no validity
      r@x <- as.logical(from@x)
      sNams <- slotNames(r)
      for(nm in sNams[sNams != "x"])
          slot(r, nm) <- slot(from, nm)
      r
      })

setAs("lMatrix", "dMatrix",
      function(from) {
      r <- new(sub("^l", "d", class(from)))
      r@x <- as.double(from@x)
      sNams <- slotNames(r)
      for(nm in sNams[sNams != "x"])
          slot(r, nm) <- slot(from, nm)
      r
      })

## needed at least for lsparse* :
setAs("lMatrix", "dgCMatrix",
      function(from) as(as(from, "lgCMatrix"), "dgCMatrix"))

## all() methods ---> ldenseMatrix.R and lsparseMatrix.R

setMethod("any", signature(x = "lMatrix"),
      function(x, ..., na.rm = FALSE)
      ## logical unit-triangular has TRUE diagonal:
      (prod(dim(x)) >= 1 && is(x, "triangularMatrix") && x@diag == "U") ||
      any(x@x, ..., na.rm = na.rm))