# R/Summary.R In Matrix: Sparse and Dense Matrix Classes and Methods

```## METHODS FOR GENERIC: Summary (group)
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

## > getGroupMembers("Summary")
## [1] "max"   "min"   "range" "prod"  "sum"   "any"   "all"

## NB: Summary depends on the existence, _not_ count, of zeros and ones.
##     The only exception is 'sum' which ignores zeros and counts ones.

setMethod("Summary", signature(x = "denseMatrix"),
function(x, ..., na.rm = FALSE) {
## Avoid wrong overflow :
if(.Generic == "sum")
return(sum (.Call(R_dense_sum , x, na.rm),
..., na.rm = na.rm))
if(.Generic == "prod")
return(prod(.Call(R_dense_prod, x, na.rm),
..., na.rm = na.rm))
cl <- .M.nonvirtual(x)
kind <- substr(cl, 1L, 1L)
shape <- substr(cl, 2L, 2L)
repr <- substr(cl, 3L, 3L)
zero <- switch(kind, "n" = , "l" = FALSE, "i" = 0L, "d" = 0, "z" = 0+0i)
if(shape != "g") {
if(repr != "p")
x <- .M2packed(x)
if(shape == "t" && x@diag != "N")
diag(x) <- TRUE # copying, sadly
}
n <- x@Dim[2L]
y <- x@x
y1 <- if(kind != "n" || !anyNA(y))
y
else y | is.na(y)
y2 <- if(shape == "t" && n > 1L)
zero
get(.Generic, mode = "function")(y1, y2, ..., na.rm = na.rm)
})

setMethod("Summary", signature(x = "sparseMatrix"),
function(x, ..., na.rm = FALSE) {
## Avoid wrong overflow :
if(.Generic == "sum")
return(sum (.Call(R_sparse_sum , x, na.rm),
..., na.rm = na.rm))
if(.Generic == "prod")
return(prod(.Call(R_sparse_prod, x, na.rm),
..., na.rm = na.rm))
cl <- .M.nonvirtual(x)
kind <- substr(cl, 1L, 1L)
shape <- substr(cl, 2L, 2L)
repr <- substr(cl, 3L, 3L)
switch(kind,
"n" = ,
"l" = { zero <- FALSE; one <- TRUE },
"i" = { zero <- 0L   ; one <- 1L   },
"d" = { zero <- 0    ; one <- 1    },
"z" = { zero <- 0+0i ; one <- 1+0i })
## Handle overallocation (hopefully rare ...) :
if(repr == "T") {
x <- aggregateT(x)
nnz <- length(x@i)
} else {
nnz <- { p <- x@p; p[length(p)] }
if(length(if(repr == "C") x@i else x@j) > nnz) {
h <- seq_len(nnz)
if(repr == "C")
x@i <- x@i[h]
else
x@j <- x@j[h]
if(kind != "n")
x@x <- x@x[h]
}
}
n <- (d <- x@Dim)[2L]
nnz.max <- if(shape == "s") 0.5 * (prod(d) + n) else prod(d)
y1 <- if(kind != "n")
x@x
else if(nnz > 0L)
TRUE
else logical(0L)
y2 <- if(nnz < nnz.max)
zero
y3 <- if(n > 0L && shape == "t" && x@diag != "N")
one
get(.Generic, mode = "function")(y1, y2, y3, ..., na.rm = na.rm)
})

setMethod("Summary", signature(x = "diagonalMatrix"),
function(x, ..., na.rm = FALSE) {
kind <- .M.kind(x)
switch(kind,
"n" = ,
"l" = { zero <- FALSE; one <- TRUE },
"i" = { zero <- 0L   ; one <- 1L   },
"d" = { zero <- 0    ; one <- 1    },
"z" = { zero <- 0+0i ; one <- 1+0i })
n <- x@Dim[2L]
y1 <- if(x@diag == "N") {
y <- x@x
if(kind != "n") {
if(.Generic == "prod" && n > 1L)
## Avoid wrong overflow :
c(y[1L], zero, y[-1L])
else y
}
else if(!anyNA(y))
y
else y | is.na(y)
}
y2 <- if(n > 1L)
zero
y3 <- if(x@diag != "N") {
if(.Generic == "sum")
one * n
else if(n > 0L)
one
else one[0L]
}
get(.Generic, mode = "function")(y1, y2, y3, ..., na.rm = na.rm)
})

setMethod("Summary", signature(x = "indMatrix"),
function(x, ..., na.rm = FALSE) {
nnz <- length(x@perm)
y1 <- if(.Generic == "sum")
nnz
else if(nnz > 0L)
TRUE
else logical(0L)
y2 <- if(nnz < prod(x@Dim))
FALSE
get(.Generic, mode = "function")(y1, y2, ..., na.rm = na.rm)
})

setMethod("Summary", signature(x = "sparseVector"),
function(x, ..., na.rm = FALSE) {
kind <- .M.kind(x)
zero <- switch(kind, "n" = , "l" = FALSE, "i" = 0L, "d" = 0, "z" = 0+0i)
nnz <- length(i <- x@i)
nnz.max <- length(x)
y1 <- if(kind != "n") {
y <- x@x
if(.Generic == "prod" && nnz > 0L && nnz < nnz.max) {
## Avoid wrong overflow :
if(i[1L] > 1L)
c(zero, y)
else if(nnz >= (q <- which.min(i == seq_along(i))))
c(y[1L:(q - 1L)], zero, y[q:nnz])
else y
} else y
}
else if(.Generic == "sum")
nnz
else if(nnz > 0L)
TRUE
else logical(0L)
y2 <- if(nnz < nnz.max)
zero
get(.Generic, mode = "function")(y1, y2, ..., na.rm = na.rm)
})
```

## Try the Matrix package in your browser

Any scripts or data that you put into this service are public.

Matrix documentation built on Nov. 14, 2023, 5:06 p.m.