R/rbcoverage.R

In lfl: Linguistic Fuzzy Logic

#' Compute rule base coverage of data
#'
#' This function computes rule base coverage, i.e. a an average of maximum
#' membership degree at which each row of data fires the rules in rule base.
#'
#' Let \eqn{f_{ij}} be a truth value of \eqn{i}-th rule on \eqn{j}-th row of
#' data \code{x}.  Then \eqn{m_j = max(f_{.j})} is a maximum truth value that
#' is reached for the \eqn{j}-th data row with the rule base. Then the rule
#' base coverage is a mean of that truth values, i.e.  \eqn{rbcoverage =
#' mean(m_.)}.
#'
#' @param x Data for the rules to be evaluated on. Could be either a numeric
#' matrix or numeric vector.  If matrix is given then the rules are evaluated
#' on rows. Each value of the vector or column of the matrix represents a
#' predicate - it's numeric value represents the truth values (values in the
#' interval \eqn{[0, 1]}).
#' @param rules Either an object of class "farules" or list of character
#' vectors where each vector is a rule with consequent being the first element
#' of the vector. Elements of the vectors (predicate names) must correspond to
#' the `x`'s names (of columns if `x` is a matrix).
#' @param tnorm A character string representing a triangular norm to be used
#' (either `"goedel"`, `"goguen"`, or `"lukasiewicz"`) or an
#' arbitrary function that takes a vector of truth values and returns a t-norm
#' computed of them.
#' @param onlyAnte TRUE if only antecedent-part of a rule should be evaluated.
#' Antecedent-part of a rule are all predicates in rule vector starting from
#' the 2nd position. (First element of a rule is the consequent - see above.)
#'
#' If FALSE, then the whole rule will be evaluated (antecedent part together
#' with consequent).
#' @return A numeric value of the rule base coverage of given data.
#' @author Michal Burda
#' @seealso [fire()], [reduce()]
#' @references M. Burda, M. Štěpnička, Reduction of Fuzzy Rule Bases Driven by
#' the Coverage of Training Data, in: Proc. 16th World Congress of the
#' International Fuzzy Systems Association and 9th Conference of the European
#' Society for Fuzzy Logic and Technology (IFSA-EUSFLAT 2015), Advances in
#' Intelligent Systems Research, Atlantic Press, Gijon, 2015.
#' @keywords models robust multivariate
#' @examples
#'
#'     x <- matrix(1:20 / 20, nrow=2)
#'     colnames(x) <- letters[1:10]
#'
#'     rules <- list(c('a', 'c', 'e'),
#'                   c('b'),
#'                   c('d', 'a'),
#'                   c('c', 'a', 'b'))
#'     rbcoverage(x, rules, "goguen", TRUE)  # returns 1
#'
#'
#'     rules <- list(c('d', 'a'),
#'                   c('c', 'a', 'b'))
#'     rbcoverage(x, rules, "goguen", TRUE)  # returns 0.075)
#'
#' @export
rbcoverage <- function(x,
                       rules,
                       tnorm=c("goedel", "goguen", "lukasiewicz"),
                       onlyAnte=TRUE) {
    if (is.vector(x)) {
        x <- matrix(x, nrow=1, dimnames=list(NULL, names(x)))
    }
    .mustBe(is.matrix(x) && is.numeric(x), "'x' must be a numeric vector or matrix")
    .mustBeInInterval(x, 0, 1)

    if (is.farules(rules)) {
        rules <- rules$rules
    } else if (is.vector(rules) && is.character(rules)) {
        rules <- list(rules)
    }

    .mustBe(is.list(rules), "'rules' must be a list of rules, a valid farules object, or a character vector")

    fired <- fire(x, rules, tnorm, onlyAnte)
    return(mean(do.call('pmax', fired)))
}