SCM Repository

[matrix] Diff of /pkg/Matrix/R/diagMatrix.R
 [matrix] / pkg / Matrix / R / diagMatrix.R

Diff of /pkg/Matrix/R/diagMatrix.R

revision 2840, Fri Oct 5 22:18:37 2012 UTC revision 2863, Mon Dec 31 20:21:11 2012 UTC
# Line 6  Line 6
6  Diagonal <- function(n, x = NULL)  Diagonal <- function(n, x = NULL)
7  {  {
8      ## Allow  Diagonal(4), Diagonal(x=1:5), and  Diagonal(4, TRUE)      ## Allow  Diagonal(4), Diagonal(x=1:5), and  Diagonal(4, TRUE)
9      if(missing(n))      n <- if(missing(n)) length(x) else {
n <- length(x)
else {
10          stopifnot(length(n) == 1, n == as.integer(n), n >= 0)          stopifnot(length(n) == 1, n == as.integer(n), n >= 0)
11          n <- as.integer(n)          as.integer(n)
12      }      }
13
14      if(missing(x)) ## unit diagonal matrix      if(missing(x)) ## unit diagonal matrix
# Line 224  Line 222
222                         "l" =,                         "l" =,
223                         "n" = TRUE,                         "n" = TRUE,
224                         ## otherwise                         ## otherwise
225                         stop("'", kind,"' kind not yet implemented")), n))                         stop(gettextf("%s kind not yet implemented",
226                                         sQuote(kind)), domain=NA)),
227                    n))
228  }  }
229
230  ## diagonal -> triangular,  upper / lower depending on "partner":  ## diagonal -> triangular,  upper / lower depending on "partner":
# Line 336  Line 336
336            d <- dim(from)            d <- dim(from)
337            if(d[1] != (n <- d[2])) stop("non-square matrix")            if(d[1] != (n <- d[2])) stop("non-square matrix")
338            if(any(from[row(from) != col(from)] != 0))            if(any(from[row(from) != col(from)] != 0))
339                stop("matrix with non-zero off-diagonals cannot be coerced to diagonalMatrix")                stop("matrix with non-zero off-diagonals cannot be coerced to \"diagonalMatrix\"")
340            x <- diag(from)            x <- diag(from)
341            if(is.logical(x)) {            if(is.logical(x)) {
342                cl <- "ldiMatrix"                cl <- "ldiMatrix"
# Line 415  Line 415
415              x[i, ] <- value              x[i, ] <- value
416          else if(na == 3)          else if(na == 3)
417              x[i] <- value              x[i] <- value
418          else stop("Internal bug: nargs()=",na,"; please report")          else stop(gettextf("Internal bug: nargs()=%d; please report",
419                               na), domain=NA)
420      } else      } else
421          x[i,j] <- value          x[i,j] <- value
422      if(isDiagonal(x)) as(x, "diagonalMatrix") else x      if(isDiagonal(x)) as(x, "diagonalMatrix") else x
# Line 759  Line 760
760          }          }
761          else if(is.logical(r))          else if(is.logical(r))
762              e1 <- as(e1, "lMatrix")              e1 <- as(e1, "lMatrix")
763          else stop("intermediate 'r' is of type", typeof(r))          else stop(gettextf("intermediate 'r' is of type %s",
764                               typeof(r)), domain=NA)
765          e1@x <- r          e1@x <- r
766          .diag.2N(e1)          .diag.2N(e1)
767      }      }

Legend:
 Removed from v.2840 changed lines Added in v.2863