# R/sparse_set_operations.R In fcaR: Formal Concept Analysis

#### Defines functions .replicate_col.multiunion.union.difference

```.difference <- function(A, B) {

if (is.numeric(A)) A <- Matrix::Matrix(A, sparse = TRUE)
if (is.numeric(B)) B <- Matrix::Matrix(B, sparse = TRUE)

applicable <- (ncol(A) == ncol(B)) || (ncol(B) == 1) || (ncol(A) == 1)
stopifnot(applicable)

if (ncol(A) == ncol(B)) {

A[B >= A] <- 0

return(A)

}

if (ncol(B) == 1) {

n <- ncol(A)

newB <- .replicate_col(B, n)

A[newB >= A] <- 0

return(A)

}

if (ncol(A) == 1) {

n <- ncol(B)

newA <- .replicate_col(A, n)

newA[B >= newA] <- 0

return(newA)

}

}

.union <- function(A, B) {

if (is.numeric(A)) A <- Matrix::Matrix(A, sparse = TRUE)
if (is.numeric(B)) B <- Matrix::Matrix(B, sparse = TRUE)

applicable <- (ncol(A) == ncol(B)) || (ncol(B) == 1) || (ncol(A) == 1)
stopifnot(applicable)

if (ncol(A) == ncol(B)) {

idx <- Matrix::which(B > A)
A[idx] <- B[idx]

return(A)

}

if (ncol(B) == 1) {

n <- ncol(A)

newB <- .replicate_col(B, n)

idx <- Matrix::which(newB > A)
A[idx] <- newB[idx]

return(A)

}

if (ncol(A) == 1) {

n <- ncol(B)

newA <- .replicate_col(A, n)

idx <- Matrix::which(B > newA)
newA[idx] <- B[idx]

return(newA)

}

}

.multiunion <- function(M) {

v <- flatten_sparse_C(M@p, M@i, M@x, M@Dim)

return(Matrix::Matrix(v, ncol = 1, sparse = TRUE))

}

.replicate_col <- function(A, n) {

new_i <- rep(A@i, n)

stopifnot("x" %in% methods::slotNames(A))

new_p <- c(0, A@p[2] * seq(n))

newA <- Matrix::sparseMatrix(i = new_i + 1,
p = new_p,
x = A@x,
dims = c(nrow(A), n))

return(newA)

}
```

## Try the fcaR package in your browser

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

fcaR documentation built on April 28, 2023, 1:11 a.m.