# R/compose.R In lfl: Linguistic Fuzzy Logic

#### Documented in compose

```#' Composition of Fuzzy Relations
#'
#' Composition of Fuzzy Relations
#'
#' Function composes a fuzzy relation `x` (i.e. a numeric matrix of size
#' \eqn{(u,v)}) with a fuzzy relation `y` (i.e. a numeric matrix of size
#' \eqn{(v,w)}) and possibly with the deprecated use of an exclusion fuzzy relation
#' `e` (i.e. a numeric matrix of size \eqn{(v,w)}).
#'
#' The style of composition is determined by the algebra `alg`, the
#' composition type `type`, and possibly also by a deprecated `quantifier`.
#'
#' This function performs four main composition types, the basic composition (
#' also known as direct product), the Bandler-Kohout subproduct (also subdirect
#' product), the Bandler-Kohout superproduct (also supdirect product), and finally,
#' the Bandler-Kohout square product. More complicated composition operations
#' may be performed by using the [mult()] function and/or by combining multiple
#' composition results with the [algebra()] operations.
#'
#' @param x A first fuzzy relation to be composed. It must be a numeric matrix
#' with values within the \eqn{[0,1]} interval. The number of columns must
#' match with the number of rows of the `y` matrix.
#' @param y A second fuzzy relation to be composed. It must be a numeric matrix
#' with values within the \eqn{[0,1]} interval. The number of columns must
#' match with the number of rows of the `x` matrix.
#' @param e Deprecated. An excluding fuzzy relation. If not NULL,
#' it must be a numeric matrix with dimensions equal to the `y` matrix.
#' @param alg An algebra to be used for composition. It must be one of
#' `'goedel'` (default), `'goguen'`, or `'lukasiewicz'`, or an instance of class `algebra`
#' (see [algebra()]).
#' @param type A type of a composition to be performed. It must be one of
#' `'basic'` (default), `'sub'`, `'super'`, or `'square'`.
#' @param quantifier Deprecated. If not NULL, it must be a function taking a single
#' argument, a vector of relative cardinalities, that would be translated into
#' membership degrees. A result of the [lingexpr()] function is a
#' good candidate for that. Note that the vector of relative cardinalities contains also
#' two attributes, `x` and `y`, which carry the original `R`'s data row (in `x`) and `S`'s
#' feature column (in `y`). These attributes are accessible using the standard [base::attr()]
#' function. Find examples below that define some quantifiers.
#' @param sorting Deprecated. Sorting function used within quantifier application. The given function
#' must sort the membership degrees and allow the `decreasing` argument as in [base::sort()].
#' This function have to be explicitly specified typically if performing compositions that
#' handle `NA` values.
#' @return A matrix with \eqn{v} rows and \eqn{w} columns, where \eqn{v} is the
#' number of rows of `x` and \eqn{w} is the number of columns of `y`.
#' @author Michal Burda
#' @seealso [algebra(), [mult()], [lingexpr()]
#' @keywords models robust multivariate
#' @examples
#'     R <- matrix(c(0.1, 0.6, 1, 0, 0, 0,
#'                   0, 0.3, 0.7, 0.9, 1, 1,
#'                   0, 0, 0.6, 0.8, 1, 0,
#'                   0, 1, 0.5, 0, 0, 0,
#'                   0, 0, 1, 1, 0, 0), byrow=TRUE, nrow=5)
#'
#'     S <- matrix(c(0.9, 1, 0.9, 1,
#'                   1, 1, 1, 1,
#'                   0.1, 0.2, 0, 0.2,
#'                   0, 0, 0, 0,
#'                   0.7, 0.6, 0.5, 0.4,
#'                   1, 0.9, 0.7, 0.6), byrow=TRUE, nrow=6)
#'
#'     RS <- matrix(c(0.6, 0.6, 0.6, 0.6,
#'                    1, 0.9, 0.7, 0.6,
#'                    0.7, 0.6, 0.5, 0.4,
#'                    1, 1, 1, 1,
#'                    0.1, 0.2, 0, 0.2), byrow=TRUE, nrow=5)
#'
#'     compose(R, S, alg='goedel', type='basic') # should be equal to RS
#' @export compose
compose <- function(x,
y,
e=NULL,
alg=c('goedel', 'goguen', 'lukasiewicz'),
type=c('basic', 'sub', 'super', 'square'),
quantifier=NULL,
sorting=sort) {

.mustBeNumericMatrix(x)
.mustBeNumericMatrix(y)
.mustBe(nrow(x) > 0, "'x' must be a matrix with at least 1 row")
.mustBe(ncol(y) > 0, "'y' must be a matrix with at least 1 column")
.mustBe(ncol(x) == nrow(y), "The number of columns of 'x' must be equal to the number of rows of 'y'")

if (!is.null(e)) {
.Deprecated('mult',
msg=paste('The "e" argument is deprecated. Complex compositions',
'have to be computed by using the "compose()" or "mult()"',
'functions and combined with algebra() operations.'))
.mustBeNumericMatrix(e)
.mustBe(nrow(y) == nrow(e) && ncol(y) == ncol(e), "'e' must have the same dimensions as 'y'")

}

if (is.character(alg)) {
alg <- match.arg(alg)
alg <- algebra(alg)
}
.mustBe(is.algebra(alg), "'alg' must be either one of 'goedel', 'goguen', lukasiewicz', or an instance of class 'algebra'")

if (is.character(type)) {
type <- match.arg(type)
if (type == 'basic') {
type <- alg\$pt
merge <- alg\$s
} else if (type == 'sub') {
type <- alg\$r
merge <- alg\$i
} else if (type == 'super') {
type <- function(x, y) { alg\$r(y, x) }
merge <- alg\$i
} else if (type == 'square') {
type <- alg\$b
merge <- alg\$i
} else {
stop('Unrecognized composition type')
}
} else if (is.function(type)) {
.mustBe(is.function(quantifier), "if 'type' is a function then 'quantifier' must be a function too")
}

.mustBe(is.function(type), "'type' must be either one of 'basic', 'sub', 'super', 'square', or a function with 1 argument")

f <- NULL
# TODO: the 'quantifier' argument is not a real quantifier! It is more a linguistic expression giving degrees to relative
# cardinalitites. The quantifiers are tightly related to algebras, e.g. the 'sort' function is a property of algebra (especially
# if considering algebras that work with NAs)
if (is.function(quantifier)) {
.Deprecated('mult',
msg=paste('The "quantifier" argument is deprecated. Complex compositions',
'have to be computed by using the "compose()" or "mult()"',
'functions and combined with algebra() operations.'))
merge <- function(val, x, y) {
res <- sorting(val, decreasing=TRUE)
relcard <- seq_along(res) / length(res)
attr(relcard, 'x') <- x
attr(relcard, 'y') <- y
alg\$s(alg\$pt(res, quantifier(relcard)))
}
f <- function(x, y) {
merge(type(x, y), x, y)
}

} else if (!is.null(quantifier)) {
stop("'quantifier' must be a function or NULL")

} else {
f <- function(x, y) {
merge(type(x, y))
}
}

res <- mult(x, y, f)
if (!is.null(e)) {
# TODO: test excluding features!
# TODO: excluding should not be inside of this function - it should be a separate function
fe <- function(x, y) {
alg\$s(alg\$pt(x, y))
}
e <- mult(x, e, fe)
res <- alg\$pt(res, alg\$n(e))
}
return(res)
}
```

## Try the lfl package in your browser

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

lfl documentation built on Sept. 8, 2022, 5:08 p.m.