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

```## METHODS FOR GENERIC: anyNA
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("anyNA", signature(x = "denseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
if(substr(cl, 1L, 1L)  == "n")
return(FALSE)
if((shape <- substr(cl, 2L, 2L)) == "g")
anyNA(x@x)
else {
if(shape == "t" && x@diag != "N") {
x@diag <- "N"
if(anyNA(diag(x, names = FALSE)))
diag(x) <- TRUE
}
anyNA(pack(x)@x)
}
})

setMethod("anyNA", signature(x = "sparseMatrix"),
function(x) .M.kind(x) != "n" && anyNA(x@x))

setMethod("anyNA", signature(x = "diagonalMatrix"),
function(x) .M.kind(x) != "n" && length(y <- x@x) > 0L && anyNA(y))

setMethod("anyNA", signature(x = "indMatrix"),
function(x) FALSE)

setMethod("anyNA", signature(x = "sparseVector"),
function(x) .M.kind(x) != "n" && anyNA(x@x))

## METHODS FOR GENERIC: is.na
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("is.na", signature(x = "denseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- substr(cl, 1L, 1L) == "n"
substr(cl, 1L, 1L) <- "n"
r <- new(cl)
r@Dim <- x@Dim
r@Dimnames <- x@Dimnames
if((shape <- substr(cl, 2L, 2L)) != "g") {
r@uplo <- x@uplo
if(!never && shape == "t" && x@diag != "N") {
x@diag <- "N"
if(anyNA(diag(x, names = FALSE)))
diag(x) <- TRUE
}
}
r@x <- if(never)
logical(length(x@x))
else is.na(x@x)
r
})

setMethod("is.na", signature(x = "sparseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- substr(cl, 1L, 1L) == "n"
substr(cl, 1L, 1L) <- if(never) "n" else "l"
r <- new(cl)
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
if(substr(cl, 2L, 2L) != "g")
r@uplo <- x@uplo
if(never) {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- integer(d[2L] + 1) },
"R" = { r@p <- integer(d[1L] + 1) })
r
} else {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- x@p; r@i <- x@i },
"R" = { r@p <- x@p; r@j <- x@j },
"T" = { r@i <- x@i; r@j <- x@j })
r@x <- is.na(x@x)
.M2kind(.drop0(r), "n")
}
})

setMethod("is.na", signature(x = "diagonalMatrix"),
function(x) {
r <- new("ndiMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@x <- if(x@diag != "N" || .M.kind(x) == "n")
logical(d[1L])
else is.na(x@x)
r
})

setMethod("is.na", signature(x = "indMatrix"),
function(x) {
m <- x@margin
r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@p <- integer(d[m] + 1)
r
})

setMethod("is.na", signature(x = "sparseVector"),
function(x) {
r <- new("nsparseVector")
r@length <- x@length
if(.M.kind(x) != "n")
r@i <- x@i[is.na(x@x)]
r
})

## METHODS FOR GENERIC: is.nan
## NB: mostly parallel to is.na, completely parallel to is.infinite
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("is.nan", signature(x = "denseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE)
substr(cl, 1L, 1L) <- "n"
r <- new(cl)
r@Dim <- x@Dim
r@Dimnames <- x@Dimnames
if((shape <- substr(cl, 2L, 2L)) != "g") {
r@uplo <- x@uplo
if(!never && shape == "t" && x@diag != "N") {
x@diag <- "N"
if(any(is.nan(diag(x, names = FALSE))))
diag(x) <- TRUE
}
}
r@x <- if(never)
logical(length(x@x))
else is.nan(x@x)
r
})

setMethod("is.nan", signature(x = "sparseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE)
substr(cl, 1L, 1L) <- if(never) "n" else "l"
r <- new(cl)
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
if(substr(cl, 2L, 2L) != "g")
r@uplo <- x@uplo
if(never) {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- integer(d[2L] + 1) },
"R" = { r@p <- integer(d[1L] + 1) })
r
} else {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- x@p; r@i <- x@i },
"R" = { r@p <- x@p; r@j <- x@j },
"T" = { r@i <- x@i; r@j <- x@j })
r@x <- is.nan(x@x)
.M2kind(.drop0(r), "n")
}
})

setMethod("is.nan", signature(x = "diagonalMatrix"),
function(x) {
r <- new("ndiMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@x <- if(x@diag != "N")
logical(d[1L])
else switch(.M.kind(x), "d" = , "z" = is.nan(x@x),
logical(d[1L]))
r
})

setMethod("is.nan", signature(x = "indMatrix"),
function(x) {
m <- x@margin
r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@p <- integer(d[m] + 1)
r
})

setMethod("is.nan", signature(x = "sparseVector"),
function(x) {
r <- new("nsparseVector")
r@length <- x@length
switch(.M.kind(x), "d" = , "z" = { r@i <- x@i[is.nan(x@x)] })
r
})

## METHODS FOR GENERIC: is.infinite
## NB: mostly parallel to is.na, completely parallel to is.nan
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("is.infinite", signature(x = "denseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE)
substr(cl, 1L, 1L) <- "n"
r <- new(cl)
r@Dim <- x@Dim
r@Dimnames <- x@Dimnames
if((shape <- substr(cl, 2L, 2L)) != "g") {
r@uplo <- x@uplo
if(!never && shape == "t" && x@diag != "N") {
x@diag <- "N"
if(any(is.infinite(diag(x, names = FALSE))))
diag(x) <- TRUE
}
}
r@x <- if(never)
logical(length(x@x))
else is.infinite(x@x)
r
})

setMethod("is.infinite", signature(x = "sparseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
never <- switch(substr(cl, 1L, 1L), "d" = , "z" = FALSE, TRUE)
substr(cl, 1L, 1L) <- if(never) "n" else "l"
r <- new(cl)
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
if(substr(cl, 2L, 2L) != "g")
r@uplo <- x@uplo
if(never) {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- integer(d[2L] + 1) },
"R" = { r@p <- integer(d[1L] + 1) })
r
} else {
switch(substr(cl, 3L, 3L),
"C" = { r@p <- x@p; r@i <- x@i },
"R" = { r@p <- x@p; r@j <- x@j },
"T" = { r@i <- x@i; r@j <- x@j })
r@x <- is.infinite(x@x)
.M2kind(.drop0(r), "n")
}
})

setMethod("is.infinite", signature(x = "diagonalMatrix"),
function(x) {
r <- new("ndiMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@x <- if(x@diag != "N")
logical(d[1L])
else switch(.M.kind(x), "d" = , "z" = is.infinite(x@x),
logical(d[1L]))
r
})

setMethod("is.infinite", signature(x = "indMatrix"),
function(x) {
m <- x@margin
r <- new(if(m == 1L) "ngRMatrix" else "ngCMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@p <- integer(d[m] + 1)
r
})

setMethod("is.infinite", signature(x = "sparseVector"),
function(x) {
r <- new("nsparseVector")
r@length <- x@length
switch(.M.kind(x), "d" = , "z" = { r@i <- x@i[is.infinite(x@x)] })
r
})

## METHODS FOR GENERIC: is.finite
## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("is.finite", signature(x = "denseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
always <- substr(cl, 1L, 1L) == "n"
packed <- substr(cl, 3L, 3L) == "p"
if((shape <- substr(cl, 2L, 2L)) != "s")
r <- new("ngeMatrix")
else {
r <- new(if(!packed) "nsyMatrix" else "nspMatrix")
r@uplo <- x@uplo
}
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@x <-
if(shape != "t") {
if(always)
rep.int(TRUE, length(x@x))
else is.finite(x@x)
} else {
if(always)
rep.int(TRUE, prod(d))
else if(!packed) {
tmp <- is.finite(x@x)
tmp[indTri(d[1L], x@uplo != "U", x@diag != "N", FALSE)] <-
TRUE
tmp
} else {
tmp <- rep.int(TRUE, prod(d))
tmp[indTri(d[1L], x@uplo == "U",          TRUE, FALSE)] <-
is.finite(x@x)
if(x@diag != "N") {
dim(tmp) <- d
diag(tmp) <- TRUE
dim(tmp) <- NULL
}
tmp
}
}
r
})

setMethod("is.finite", signature(x = "sparseMatrix"),
function(x) {
cl <- .M.nonvirtual(x)
always <- substr(cl, 1L, 1L) == "n"
if(substr(cl, 2L, 2L) != "s")
r <- new("ngeMatrix")
else {
r <- new("nsyMatrix")
r@uplo <- x@uplo
}
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
tmp <- rep.int(TRUE, prod(d))
if(!always && !all(k <- is.finite(x@x))) {
if(substr(cl, 3L, 3L) != "T") {
x <- .M2T(x)
if(length(k) > length(x@x)) # was overallocated
k <- is.finite(x@x)
}
i <- c(x@i, x@j) + 1L
dim(i) <- c(length(k), 2L)
dim(tmp) <- d
tmp[i] <- k
dim(tmp) <- NULL
}
r@x <- tmp
r
})

setMethod("is.finite", signature(x = "diagonalMatrix"),
function(x) {
r <- new("nsyMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
tmp <- rep.int(TRUE, prod(d))
if(x@diag == "N" && .M.kind(x) != "n" && !all(k <- is.finite(x@x))) {
dim(tmp) <- d
diag(tmp) <- k
dim(tmp) <- NULL
}
r@x <- tmp
r
})

setMethod("is.finite", signature(x = "indMatrix"),
function(x)  {
r <- new("ngeMatrix")
r@Dim <- d <- x@Dim
r@Dimnames <- x@Dimnames
r@x <- rep.int(TRUE, prod(d))
r
})

setMethod("is.finite", signature(x = "sparseVector"),
function(x)  {
r <- rep.int(TRUE, x@length)
if(.M.kind(x) != "n")
r[x@i[!is.finite(x@x)]] <- FALSE
r
})
```

## 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.