Nothing
R/GFS.Methods.R
In frbs: Fuzzy Rule-Based Systems for Classification and Regression Tasks
Defines functions
GFS.FR.MOGUL
GFS.Thrift
GFS.GCCL
FH.GBML
SLAVE
GFS.LT.RS
Documented in
FH.GBML
GFS.FR.MOGUL
GFS.GCCL
GFS.LT.RS
GFS.Thrift
SLAVE
#############################################################################
#
# This file is a part of the R package "frbs".
#
# Author: Lala Septem Riza
# Co-author: Christoph Bergmeir
# Supervisors: Francisco Herrera Triguero and Jose Manuel Benitez
# Copyright (c) DiCITS Lab, Sci2s group, DECSAI, University of Granada.
#
# This package is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 2 of the License, or (at your option) any later version.
#
# This package is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
#############################################################################
#' This is the internal function that implements genetic fuzzy systems for fuzzy rule learning
#' based on the MOGUL methodology (GFS.FR.MOGUL). It is used to solve regression tasks.
#' Users do not need to call it directly, but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was proposed by Herrera et al.
#' GFS.FR.MOGUL implements a genetic algorithm determining the structure
#' of the fuzzy IF-THEN rules and the membership function parameters.
#' There are two general types of fuzzy IF-THEN rules, namely the descriptive
#' and the approximative/free semantic approaches. A descriptive approach means that
#' the linguistic labels represent a real-world semantic; the linguistic labels are
#' uniformly defined for all rules. In contrast, in the approximative approach
#' there isn't any associated linguistic label. This method is based on the latter one.
#' We model a fuzzy IF-THEN rule on a chromosome which consists of the parameter values of
#' the membership function. So, every rule has its own membership function values.
#' A population contains many such generated chromosomes, based on the iterative rule learning
#' approach (IRL). IRL means that the chromosomes will be generated one by one, taking into
#' account the fitness value and covering factor, until there are sufficient chromosomes
#' in the population. After having obtained the population, the genetic algorithm is started,
#' using the genetic operators selection, mutation, and crossover.
#'
#' @title GFS.FR.MOGUL model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process, where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable. Note the data must be normalized between 0 and 1.
#' @param persen_cross a real number between 0 and 1 determining the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.iter the maximal number of iterations.
#' @param max.gen the maximal number of generations of the genetic algorithm.
#' @param max.tune the maximal number of tuning iterations.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @param epsilon a real number between 0 and 1 determining the boundary of covering factor.
#' @seealso \code{\link{GFS.FR.MOGUL.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' F. Herrera, M. Lozano, and J.L. Verdegay,
#' "A learning process for fuzzy control rules using genetic algorithms",
#' Fuzzy Sets and Systems, vol. 100, pp. 143 - 158 (1998).
#'
#' O. Cordon, M.J. del Jesus, F. Herrera, and M. Lozano,
#' "MOGUL: A methodology to obtain genetic fuzzy rule-based systems
#' under the iterative rule learning approach", International Journal of Intelligent Systems,
#' vol. 14, pp. 1123 - 1153 (1999).
# @export
GFS.FR.MOGUL <- function(data.train, persen_cross = 0.6, persen_mutant = 0.3, max.iter = 10, max.gen = 10, max.tune = 10,
range.data.ori, epsilon = 0.4){
## A genetic generation stage
data.train.ori <- data.train
data.sample <- data.train
num.var <- ncol(data.train)
num.inputvar <- num.var - 1
best.rules <- matrix(NA, nrow = 1, ncol = (3 * ncol(data.sample)))
iter <- 1
stop.cr <- FALSE
num.rules.popu <- 10
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.iter, style = 3)
while (stop.cr == FALSE){
## get rule based on data.train
temp.rule <- matrix(NA, nrow = 1, ncol = (3 * ncol(data.sample)))
## check number of rules
if (nrow(data.sample) < num.rules.popu){
num.rules.popu <- nrow(data.sample)
}
## generate initial population
for (i in 1 : num.rules.popu){
rule <- generate.popu(method.type = "GFS.FR.MOGUL", data.train = data.sample[i, ,drop = FALSE])
temp.rule <- rbind(temp.rule, rule)
}
popu <- na.omit(temp.rule)
popu.size <- nrow(popu)
old.best.fit <- -1
gen <- 1
while (gen < max.gen){
##calculate individual fitness
ind.fit <- eval.indv.fitness(data.train = data.sample, rule = popu, method.type = "GFS.FR.MOGUL", epsilon = epsilon)
## combine rule.gen and its fitness
rule.withFit <- cbind(popu, ind.fit)
## get the best individual
new.best.fit <- max(rule.withFit[, ncol(rule.withFit)])
if (new.best.fit > old.best.fit){
indx <- which.max(rule.withFit[, ncol(rule.withFit), drop = FALSE])
new.best.rule <- rule.withFit[indx, -ncol(rule.withFit), drop = FALSE]
old.best.fit <- new.best.fit
}
popu.rule <- rule.withFit[, -ncol(rule.withFit), drop = FALSE]
if (nrow(popu.rule) > 2){
## GA.Crossover
popu <- GA.crossover(popu.rule, persen_cross, type = "MOGUL", num.inputvar)
}
## GA.Mutation
popu <- GA.mutation(popu, persen_mutant, type = "MOGUL", iter = gen,
max.iter = max.gen)
gen = gen + 1
}
best.rules <- rbind(best.rules, new.best.rule)
data.sample <- red.data(data.sample, new.best.rule, epsilon, type = "MOGUL")
iter = iter + 1
## update the number of data after reducing
num.sample.fin <- nrow(data.sample)
if (num.sample.fin <= 3 || iter >= max.iter){
stop.cr <- TRUE
iter <- max.iter
}
## progress bar
setTxtProgressBar(progressbar, iter)
}
close(progressbar)
best.rules <- na.omit(best.rules)
mod <- list(rule = best.rules)
params <- list(mod = mod, data.train = data.train.ori, max.iter = max.tune)
new.mod <- tune.MF(method.type = "GFS.FR.MOGUL", params)
best.rules <- new.mod$rule
mod <- list(rule = best.rules, range.data.ori = range.data.ori, type.tnorm = "MIN",
type.snorm = "SUM", type.model = "APPROXIMATE", type.implication.func = "MIN")
return(mod)
}
#' This is the internal function that implements the Thrift's technique based
#' on a genetic algorithm. It is used to tackle regression tasks. Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was developed by Thrift using Mamdani's model as fuzzy IF-THEN rules.
#' In this method, we consider a table as a genotype with alleles that are fuzzy set indicators
#' over the output domain. The phenotype is produced by the behavior produced
#' by the fuzzification, max-* composition, and defuzzification operations.
#' A chromosome (genotype) is formed from the decision table by going rowwise
#' and producing a string of numbers from the code set. Standard crossover
#' and mutation operators can act on these string.
#'
#' @title GFS.Thrift model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param num.labels a matrix describing the number of linguistic terms.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @param type.defuz the type of the defuzzification method. For more detail, see \code{\link{defuzzifier}}.
#' The default value is \code{WAM}.
#' @param type.tnorm the type of t-norm. For more detail, please have a look at \code{\link{inference}}.
#' @param type.snorm the type of s-norm. For more detail, please have a look at \code{\link{inference}}.
#' @param type.mf the type of shape of membership function. See \code{\link{fuzzifier}}.
#' @param type.implication.func the type of implication function. See \code{\link{WM}}.
#' @seealso \code{\link{GFS.Thrift.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' P. Thrift, "Fuzzy logic synthesis with genetic algorithms", In Proceedings of the Fourth
#' International Conference on Genetic Algorithms (ICGA91), San Diego (United States of
#' America), pp. 509 - 513 (1991).
# @export
GFS.Thrift <- function(data.train, popu.size = 10, num.labels, persen_cross = 0.6, persen_mutant = 0.3,
max.gen = 10, range.data.ori, type.defuz = "WAM", type.tnorm = "MIN", type.snorm = "MAX", type.mf = "TRIANGLE", type.implication.func = "ZADEH"){
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.gen, style = 3)
range.data <- matrix(nrow = 2, ncol = ncol(data.train))
range.data[1, ] <- 0
range.data[2, ] <- 1
## initialize mod
mod <- NULL
#### Initialize population
num.var <- ncol(data.train)
num.inputvar <- num.var - 1
if (popu.size > num.labels[1,1]^num.var){
popu.size = num.labels[1,1]^num.var
}
## generate initial population
complete.popu <- matrix(nrow = (num.labels[1,1]^num.var), ncol = num.var)
x <- list(1:num.labels[1,1])
tmp = expand.grid(rep(x, num.var))
complete.popu <- as.matrix(tmp)
rule.data.num <- complete.popu[sample(nrow(complete.popu)),]
## change scale terms
rule.data.num <- scale.StrToRule(rule.data.num, num.labels)
rule.tmp <- generate.rule(rule.data.num, num.labels)
var.mf <- partition.MF(range.data, num.labels, type.mf)
## Construct parameters
mod$range.input <- range.data[, 1 : (ncol(range.data) - 1), drop = FALSE]
mod$range.output <- range.data[, ncol(range.data), drop = FALSE]
mod$num.varinput <- (ncol(data.train) - 1)
mod$num.fvalinput <- num.labels[1, 1 : (ncol(num.labels) - 1), drop = FALSE]
mod$names.varinput <- rule.tmp$names.varinput
mod$varinp.mf <- var.mf[, 1 : (num.labels[1,1] * (num.var - 1)), drop = FALSE]
colnames(mod$varinp.mf) <- mod$names.varinput
mod$names.varoutput <- rule.tmp$names.varoutput
mod$rule <- rule.tmp$rule
mod$rule.data.num = rule.data.num
mod$varout.mf <- var.mf[, (num.labels[1,1] * (num.var - 1) + 1) : ncol(var.mf), drop = FALSE]
colnames(mod$varout.mf) <- mod$names.varoutput
mod$type.defuz <- type.defuz
mod$type.tnorm <- type.tnorm
mod$type.snorm <- type.snorm
mod$type.model <- "MAMDANI"
mod$method.type <- "GFS.THRIFT"
## calculate cover factor
heu.val <- calc.heu(mod, data.train, num.labels, type.implication.func)
tmp <- cbind(rule.data.num, heu.val)
## sort based on cover factor
rule.data.num.sorted <- tmp[order(tmp[, ncol(tmp)], decreasing = TRUE), ]
## get rule.data.num
rule.data.num.sorted <- rule.data.num.sorted[1 : popu.size, ,drop = FALSE]
rule.data.num <- rule.data.num.sorted[, 1 : (ncol(rule.data.num.sorted) - 1), drop = FALSE]
## make testing data from training data
data.test <- data.train[, 1 : (ncol(data.train) - 1), drop = FALSE]
real.val <- data.train[, ncol(data.train), drop = FALSE]
## initialize for looping
stop <- 0
best.fit <- 1000000000
temp.fit <- matrix()
bench <- matrix(ncol = 2)
while (stop <= max.gen){
## delete or change unnecessary rules
res.rule.data.num <- prune.rule(rule.data.num = rule.data.num, method = "THRIFT", num.labels = num.labels)
mod$rule.data.num <- res.rule.data.num
pred.val <- GFS.Thrift.test(mod, data.test)
bench <- cbind(real.val, pred.val)
## calculate RMSE as fitness function
residuals <- matrix(bench[, 1] - bench[, 2], nrow = 1)
RMSE <- sqrt(mean(residuals^2))
fitness <- RMSE
if (fitness < best.fit){
best.fit <- fitness
best.rule.data.num <- mod$rule.data.num
}
### crossover
rule.data.num <- GA.crossover(rule.data.num, persen_cross, type = "1Pt")
### mutation
rule.data.num <- GA.mutation(rule.data.num, persen_mutant, num.labels, num.inputvar = NULL, type = "MICHIGAN")
stop = stop + 1
## progress bar
setTxtProgressBar(progressbar, stop)
}
close(progressbar)
## get the best rules
mod$rule.data.num <- best.rule.data.num
tmp <- generate.rule(best.rule.data.num, num.labels)
mod$rule <- tmp$rule
mod$range.data.ori <- range.data.ori
mod$type.defuz <- type.defuz
mod$type.tnorm <- type.tnorm
mod$type.snorm <- type.snorm
mod$type.mf <- type.mf
mod$num.labels <- num.labels
mod$type.implication.func <- type.implication.func
return(mod)
}
#' This is the internal function that implements the Ishibuchi's method based on
#' genetic cooperative-competitive learning (GFS.GCCL). It is used to handle classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is based on Ishibuchi's method. In this method, a chromosome describes
#' each linguistic IF-THEN rule using integer as its representation of the antecedent part.
#' In the consequent part of the fuzzy rules, the heuristic method is applied to
#' automatically generate the class. The evaluation is calculated for each rule
#' which means that the performance is not based on the entire rule set.
#' The outline of the method is as follows.
#' \itemize{
#' \item Step 1: Generate an initial population of fuzzy IF-THEN rules.
#' \item Step 2: Evaluate each fuzzy IF-THEN rule in the current population.
#' \item Step 3: Generate new fuzzy IF-THEN rules by genetic operators.
#' \item Step 4: Replace a part of the current population with the newly generated rules.
#' \item Step 5: Terminate the algorithm if a stopping condition is satisfied,
#' otherwise return to Step 2.
#' }
#' Additionally, to handle high dimensional data, this method uses "don't care"
#' attributes on the antecedent fuzzy set.
#'
#' @title GFS.GCCL model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param num.labels a matrix describing the number of linguistic terms.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param range.data.ori a matrix containing the ranges of the input data.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' H. Ishibuchi, T. Nakashima, and T. Murata, "Performance evaluation of fuzzy classifier systems for
#' multidimensional pattern classification problems",
#' IEEE trans. on Systems, Man, and Cybernetics - Part B: Sybernetics, vol. 29. no. 5, pp. 601 - 618 (1999).
# @export
GFS.GCCL <- function(data.train, popu.size = 10, range.data.input, num.labels, persen_cross = 0.6, persen_mutant = 0.3,
max.gen = 10, range.data.ori){
num.labels.inp <- num.labels[1, 1:(ncol(num.labels) - 1), drop = FALSE]
num.inputvar <- (ncol(data.train) - 1)
## make range of data according to class on data training
range.data.out <- matrix(c(min(data.train[, ncol(data.train)], na.rm = TRUE) - 0.4999,
max(data.train[, ncol(data.train)], na.rm = TRUE) + 0.4999), nrow = 2)
range.data <- cbind(range.data.input, range.data.out)
type.mf = "TRIANGLE"
## generate initial model using Wang Mendel/Chi technique as heuristics
if (popu.size < nrow(data.train)){
num.data <- popu.size
} else {
num.data <- nrow(data.train)
}
mod <- WM(data.train[1 : num.data, ,drop = FALSE], num.labels, type.mf, type.tnorm = "PRODUCT", type.implication.func = "ZADEH", classification = TRUE)
rule.data.num <- mod$rule.data.num
num.r <- as.integer(runif(1, min = 1, max = nrow(rule.data.num) + 0.9))
row.r <- as.integer(runif(num.r, min = 1, max = nrow(rule.data.num) + 0.9))
p.dcare <- 0.8
for (j in row.r){
col.r <- as.integer(runif(1, min = 1, max = ((ncol(rule.data.num) - 1) + 0.9)))
rand <- runif(1, min = 0, max = 1)
if (rand <= p.dcare)
rule.data.num[j, col.r] <- 0
}
ant.rules <- rule.data.num[, -ncol(rule.data.num), drop = FALSE]
num.rules <- nrow(ant.rules)
if (popu.size > num.rules){
ant.rules.a <- generate.popu(method.type = "GFS.GCCL", num.var = num.inputvar,
num.labels = num.labels.inp, popu.size = (popu.size - num.rules))
ant.rules <- rbind(ant.rules, ant.rules.a)
}
varinp.mf <- mod$varinp.mf
mod <- GFS.Michigan(data.train, ant.rules, varinp.mf, num.labels, persen_cross, persen_mutant, max.gen, only.GCCL = TRUE)
best.rule <- mod$rule
best.grade.cert <- mod$grade.cert
red.mod <- prune.rule(rule.data.num = best.rule, method = "GCCL", indv.fit = best.grade.cert)
mod$rule.data.num <- red.mod$rule
if (nrow(mod$rule.data.num) < 1){
stop("frbs cannot generate the fuzzy rules, please set the higher value of popu.size")
}
mod$grade.cert <- red.mod$grade.cert
mod$rule <- generate.rule(red.mod$rule, num.labels)$rule
mod$rule[, ncol(mod$rule)] <- mod$rule.data.num[, ncol(mod$rule.data.num)]
mod$num.labels <- num.labels
mod$range.data.ori <- range.data.ori
mod$type.mf <- "TRIANGLE"
mod$type.tnorm <- "PRODUCT"
mod$type.snorm <- "MAX"
mod$type.model <- "FRBCS"
mod$type.implication.func <- "ZADEH"
return(mod)
}
#' This is the internal function that implements the Ishibuchi's method based on
#' hybridization of genetic cooperative-competitive learning (GCCL) and Pittsburgh (FH.GBML). It is used to solve classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is based on Ishibuchi's method using the hybridization
#' of GCCL and the Pittsburgh approach for genetic fuzzy systems.
#' The algorithm of this method is as follows:
#' \itemize{
#' \item Step 1: Generate population where each individual in the population is a fuzzy rule set.
#' \item Step 2: Calculate the fitness value of each rule set in the current population.
#' \item Step 3: Generate new rule sets by the selection, crossover, and mutation in
#' the same manner as the Pittsburgh-style algorithm. Then, apply iterations of
#' the GCCL to each of the generated rule sets with a probability.
#' \item Step 4: Add the best rule set in the current population to newly generated rule sets
#' to form the next population.
#' \item Step 5: Return to Step 2 if the prespecified stopping condition is not satisfied.
#' }
#'
#' @title FH.GBML model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param max.num.rule the maximum number of rules.
#' @param persen_cross a real number between 0 and 1 determining the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithms.
#' @param num.class a number of the classes.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param p.dcare a probability of "don't care" attributes occurred.
#' @param p.gccl a probability of GCCL process occurred.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' H. Ishibuchi, T. Yamamoto, and T. Nakashima, "Hybridization of fuzzy GBML approaches for pattern classification
#' problems," IEEE Trans. on Systems, Man, and Cybernetics-Part B: Cybernetics,
#' vol. 35, no. 2, pp. 359 - 365 (2005).
# @export
FH.GBML <- function(data.train, popu.size = 10, max.num.rule = 5, persen_cross = 0.6, persen_mutant = 0.3, max.gen = 10, num.class, range.data.input, p.dcare = 0.5, p.gccl = 0.5){
## create progress bar
progressbar.gbml <- txtProgressBar(min = 0, max = max.gen, style = 3)
##Inisialitation of Data
range.data <- range.data.input
range.data[1, ] <- 0
range.data[2, ] <- 1
type.mf = 1
num.inputvar <- ncol(data.train) - 1
num.var <- ncol(data.train)
num.labels.inp <- matrix(rep(14, num.inputvar), nrow = 1)
num.labels <- cbind(num.labels.inp, num.class)
##define parameter values of MF on input variables
varinp.mf <- create.MF(num.inputvar)
##Inisialitation of population
popu.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * num.inputvar))
popu.comp.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * (num.inputvar + 1)))
popu.grade.cert <- matrix(NA, nrow = 1, ncol = max.num.rule)
popu.fit.rule <- matrix(NA, nrow = 1, ncol = max.num.rule)
for (i in 1 : popu.size){
num.inputvar <- (ncol(data.train) - 1)
## generate antecent of rules
rule.data.num <- generate.popu(method.type = "FH.GBML", num.var = num.inputvar,
num.labels = num.labels.inp, popu.size = max.num.rule)
num.r <- as.integer(runif(1, min = 1, max = nrow(rule.data.num) + 0.9))
row.r <- as.integer(runif(num.r, min = 1, max = nrow(rule.data.num) + 0.9))
for (j in row.r){
col.r <- as.integer(runif(1, min = 1, max = (ncol(rule.data.num) + 0.9)))
rand <- runif(1, min = 0, max = 1)
if (rand <= p.dcare)
rule.data.num[j, col.r] <- 0
}
## determine Class-q and grade of certainty
buffer.rule <- det.fit.rule(data.train, rule.data.num, varinp.mf, num.labels, type.grade.cert = 2)
## get components on buffer.rule
comp.rule <- buffer.rule$rule
grade.cert <- buffer.rule$grade.cert
fit.rule <- buffer.rule$fit.rule
## get grade of certainty and fit.rule as vector by transposing
temp.grade.cert <- t(grade.cert)
temp.fit.rule <- t(fit.rule)
## make antecendent of rule and complete rule as vector (to be individual on population)
ant.rule.tmp <- convert.MatToVec(comp.rule[, -ncol(comp.rule), drop = FALSE])
comp.rule.tmp <- convert.MatToVec(comp.rule)
## arange all components as population
popu.rule <- rbind(popu.rule, ant.rule.tmp)
popu.comp.rule <- rbind(popu.comp.rule, comp.rule.tmp)
popu.grade.cert <- rbind(popu.grade.cert, temp.grade.cert)
popu.fit.rule <- rbind(popu.fit.rule, temp.fit.rule)
}
## delete element NA on initialization step
popu.rule <- na.omit(popu.rule)
popu.comp.rule <- na.omit(popu.comp.rule)
popu.grade.cert <- na.omit(popu.grade.cert)
popu.fit.rule <- na.omit(popu.fit.rule)
## Initialization
iter = 1
best.err.percent = 100000
data.test <- data.train[, -ncol(data.train), drop = FALSE]
while (iter <= max.gen){
##Evaluate fitness function for each individual (a set of fuzzy rules)
err.percent <- matrix(nrow = nrow(popu.rule), ncol = 1)
for (i in 1 : nrow(popu.rule)){
## get one row of population
rule.vector <- matrix(popu.comp.rule[i, ], nrow = 1)
grade.cert <- matrix(popu.grade.cert[i, ], ncol = 1)
## convert vector of rule into rule.data.num form
rule <- convert.VecToMat(rule.vector, num.var)
## Get the best population by calculating fitness
classifier.rule <- list(rule = rule, grade.cert = grade.cert)
resClass.train <- GFS.GCCL.test(data.test, classifier.rule, varinp.mf)
bench <- cbind(data.train[, ncol(data.train), drop = FALSE], resClass.train)
counter = 0
for (j in 1 : nrow(bench)){
if (bench[j, 1] != bench[j, 2]){
counter = counter + 1
}
}
err.percent[i, 1] <- counter / nrow(bench) * 100
}
min.err.percent <- min(err.percent)
if (min.err.percent < best.err.percent){
indx.best.indv <- which.min(err.percent)
best.err.percent <- min.err.percent
## save the best
best.popu.rule <- popu.rule[indx.best.indv, ,drop = FALSE]
best.popu.comp.rule <- popu.comp.rule[indx.best.indv, ,drop = FALSE]
best.rule <- convert.VecToMat(best.popu.comp.rule, num.var)
best.grade.cert <- matrix(popu.grade.cert[indx.best.indv, ], ncol = 1)
}
##Crossover
new.popu.rule <- GA.crossover(popu.rule, persen_cross, type = "1Pt")
##mutation
new.popu.rule <- GA.mutation(new.popu.rule, persen_mutant, type = "PITTSBURGH", num.labels.inp, num.inputvar)
## GFS-GCCL
popu.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * num.inputvar))
popu.comp.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * (num.inputvar + 1)))
popu.grade.cert <- matrix(NA, nrow = 1, ncol = max.num.rule)
for (i in 1 : nrow(new.popu.rule)){
r.m <- runif(1, min=0, max =1)
## convert rule in vector into matrix
ant.rule.vector <- new.popu.rule[i, ,drop = FALSE]
ant.rules <- convert.VecToMat(ant.rule.vector, num.inputvar)
if (r.m <= p.gccl){
### convert rule as vector into ant.rules
persen_cross.michigan <- persen_cross
persen_mutant.michigan <- persen_mutant
max.gen.michigan <- 1
mod.michigan <- GFS.Michigan(data.train, ant.rules, varinp.mf, num.labels, persen_cross.michigan, persen_mutant.michigan, max.gen.michigan)
## convert matrix into vector
comp.rule.tmp <- mod.michigan$rule
grade.cert.tmp <- mod.michigan$grade.cert
ant.rule.tmp <- comp.rule.tmp[, -ncol(comp.rule.tmp), drop = FALSE]
} else {
## determine grade.cert, fitness
buffer.rule <- det.fit.rule(data.train, ant.rules, varinp.mf, num.labels, type.grade.cert = 2)
comp.rule.tmp <- buffer.rule$rule
grade.cert.tmp <- buffer.rule$grade.cert
ant.rule.tmp <- comp.rule.tmp[, -ncol(comp.rule.tmp), drop = FALSE]
}
comp.rule.tmp <- convert.MatToVec(comp.rule.tmp)
grade.cert.tmp <- t(grade.cert.tmp)
rule.tmp <- convert.MatToVec(ant.rule.tmp)
## make antecendent of rule and complete rule as vector (to be individual on population)
popu.rule <- rbind(popu.rule, rule.tmp)
popu.comp.rule <- rbind(popu.comp.rule, comp.rule.tmp)
popu.grade.cert <- rbind(popu.grade.cert, grade.cert.tmp)
}
popu.rule <- na.omit(popu.rule)
popu.comp.rule <- na.omit(popu.comp.rule)
popu.grade.cert <- na.omit(popu.grade.cert)
iter = iter + 1
## progress bar
setTxtProgressBar(progressbar.gbml, iter)
}
close(progressbar.gbml)
red.mod <- prune.rule(rule.data.num = best.rule, method = "GCCL", indv.fit = best.grade.cert)
rule.data.num <- red.mod$rule
if (nrow(rule.data.num) < 1){
stop("frbs cannot generate the fuzzy rules, please set the higher value of popu.size and max.num.rule")
}
rule <- generate.rule(red.mod$rule, num.labels)$rule
rule[, ncol(rule)] <- rule.data.num[, ncol(rule.data.num)]
best.grade.cert <- red.mod$grade.cert
mod <- list(rule = rule, rule.data.num = rule.data.num, grade.cert = best.grade.cert, varinp.mf = varinp.mf, range.data.ori = range.data.input,
num.labels = num.labels, type.mf = "TRIANGLE", type.tnorm = "PRODUCT", type.model = "FRBCS", type.snorm = "MAX", type.implication.func = "ZADEH")
return(mod)
}
#' This is the internal function that implements
#' the structural learning algorithm on vague environment (SLAVE). It is used to handle classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is adopted from A. Gonzalez and R. Perez's paper which is applied for
#' classification problems. SLAVE is based on the iterative rule learning approach
#' which means that we get only one fuzzy rule in each execution of the genetic algorithm.
#' In order to eliminate the irrelevant variables in a rule,
#' SLAVE has a structure composed of two parts: the first part is to represent
#' the relevance of variables and the second one is to define values of the parameters.
#' The following steps are conducted in order to obtain fuzzy rules:
#' \itemize{
#' \item Step 1: Use the genetic algorithm process to obtain ONE RULE for the system.
#' \item Step 2: Collect the rule into the final set of rules.
#' \item Step 3: Check and penalize this rule.
#' \item Step 4: If the stopping criteria is satisfied,
#' the system returns the set of rules as solution. Otherwise, back to Step 1.
#' }
#' This method uses binary codes as representation of the population and
#' applies the basic genetic operators, i.e., selection, crossover, and mutation on it.
#' And, the best rule is obtained by calculating the degree of consistency and completeness.
#'
#' @title SLAVE model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; The last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.iter the maximal number of iterations.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param num.labels a number of the linguistic terms.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param k.lower a lower bound of the noise threshold.
#' @param k.upper an upper bound of the noise threshold.
#' @param epsilon a value between 0 and 1 representing the covering factor.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' A. Gonzalez and R. Perez, "Selection of relevant features in a fuzzy genetic learning algorithm",
#' IEEE Transactions on Systems, Man, and Cybernetics, Part B: Cybernetics, vol. 31, no. 3,
#' pp. 417 - 425 (2001).
# @export
SLAVE <- function(data.train, persen_cross = 0.6, persen_mutant = 0.3, max.iter = 10, max.gen = 10, num.labels, range.data.input, k.lower = 0.25, k.upper = 0.75, epsilon = 0.1){
if (max.iter < 5){
stop("please set maximum iteration greater than 5")
}
## initialize
type.mf = 1
best.comp.rule <- matrix(ncol = ncol(data.train))
num.inputvar <- (ncol(data.train) - 1)
rule <- matrix(NA, nrow = 1, ncol = (num.inputvar + ncol(data.train)))
## split data.train based on class
num.labels.inp <- num.labels[, -ncol(num.labels), drop = FALSE]
num.class <- num.labels[1, ncol(num.labels)]
## generate varinp.mf
range.data.input.norm <- range.data.input
range.data.input.norm[1, ] <- 0
range.data.input.norm[2, ] <- 1
## create progress bar
progressbar <- txtProgressBar(min = 0, max = (num.class * max.iter), style = 3)
iter.pb <- 1
## iterate for each class on data.train
for (i in 1 : num.class){
max.fit <- matrix(0, nrow = 1, ncol = 1)
popu <- generate.popu(method.type = "SLAVE", data.train = data.train, num.var = num.inputvar,
num.labels = num.labels.inp, range.data = range.data.input.norm,
type.mf = 1, name.class = i)
name.class <- i
data.sample <- data.train[which(data.train[, ncol(data.train)] == name.class), ]
## calculate fitness for each rule
popu.var <- popu$popu.var
comp.rule <- popu$popu.val
varinp.mf <- popu$varinp.mf
res <- eval.indv.fitness(data.train = data.train, rule = comp.rule, method.type = "SLAVE", data.sample = data.sample, varinp.mf = varinp.mf,
num.labels = num.labels, popu.var = popu.var, k.lower = k.lower, k.upper = k.upper)
### get index which has max value
best.indv <- which.max(res)
## get the best rule(VAL) and VAR
best.comp.rule <- comp.rule[best.indv, ,drop = FALSE]
best.var <- popu.var[best.indv, ,drop = FALSE]
rule.new <- cbind(best.var, best.comp.rule)
best.rule <- rule.new
max.fit <- res[best.indv, 1]
## check degree considering with rule.new
VAR.rule.new <- rule.new[, 1 : num.inputvar, drop = FALSE]
VAL.rule.new <- rule.new[, (num.inputvar + 1) : (ncol(rule.new) - 1), drop = FALSE]
## get actual rule (with don't care attributes)
ant.best.rule <- VAR.rule.new * VAL.rule.new
data.sample <- red.data(data.sample, ant.best.rule, epsilon, type = "SLAVE" , varinp.mf)
old.num.data <- nrow(data.sample)
stop.cr <- FALSE
iter <- 1
num.sample.fin <- -1
while (stop.cr == FALSE){
## split class
data.input <- data.sample[, -ncol(data.sample), drop = FALSE]
if (old.num.data != num.sample.fin){
## update the number of data
old.num.data <- num.sample.fin
popu <- generate.popu(method.type = "SLAVE", data.train = data.train, num.var = num.inputvar,
num.labels = num.labels.inp, range.data = range.data.input.norm,
type.mf = 1, name.class = i)
popu.var <- popu$popu.var
comp.rule <- popu$popu.val
ant.rule <- comp.rule[, -ncol(comp.rule), drop = FALSE]
## Genetic Algorithms Procedure
## 1. Representation Individual in binary form
res.popu <- convert.IntToBin(ant.rule, num.labels.inp)
popu.var <- res.popu$popu.var
popu.val <- res.popu$popu.val
popu <- cbind(popu.var, popu.val)
num.popu <- nrow(popu)
}
gen <- 1
init.indv.fit <- -1
while (gen < max.gen && num.popu > 3){
popu.var <- popu[, 1 : num.inputvar, drop = FALSE]
popu.val <- popu[, (num.inputvar + 1) : ncol(popu), drop = FALSE]
## crossover
if (nrow(popu.val) > 3) {
new.popu.val <- GA.crossover(popu.val, persen_cross, type = "VAL", num.inputvar, num.labels)
new.popu.var <- GA.crossover(popu.var, persen_cross, type = "2pt", num.inputvar, num.labels)
new.popu <- cbind(new.popu.var, new.popu.val)
}
## mutation
new.popu <- GA.mutation(new.popu, persen_mutant, type = "IRL-BINARY", num.labels, num.inputvar)
# convert binary into int
new.popu.var <- new.popu[, 1 : num.inputvar ,drop = FALSE]
new.popu.val.bin <- new.popu[, (num.inputvar + 1) : ncol(new.popu) ,drop = FALSE]
new.popu.val.int <- convert.BinToInt(new.popu.val.bin, num.labels.inp)
## convert string to rule form
new.popu.val.int <- scale.StrToRule(new.popu.val.int, num.labels.inp)
## build complete rules
new.popu.val <- cbind(new.popu.val.int, name.class)
## calculate individual fitness
res <- eval.indv.fitness(data.train = data.train, rule = new.popu.val, method.type = "SLAVE", data.sample = data.sample, varinp.mf = varinp.mf,
num.labels = num.labels, popu.var = new.popu.var, k.lower = k.lower, k.upper = k.upper)
## choose the best indv and add into best population
best.indv <- which.max(res)
new.indv.fit <- max(res)
if (new.indv.fit > init.indv.fit) {
## get the best rule(VAL) and VAR
best.comp.rule <- new.popu.val[best.indv, ,drop = FALSE]
best.var <- new.popu.var[best.indv, ,drop = FALSE]
rule.new <- cbind(best.var, best.comp.rule)
init.indv.fit <- new.indv.fit
}
popu <- cbind(new.popu.var, new.popu.val.bin)
gen = gen + 1
}
## adding the rule
best.rule <- rbind(best.rule, rule.new)
## check degree considering with rule.new
VAR.rule.new <- rule.new[, 1 : num.inputvar, drop = FALSE]
VAL.rule.new <- rule.new[, (num.inputvar + 1) : (ncol(rule.new) - 1), drop = FALSE]
## get actual rule (with don't care attributes)
ant.best.rule <- VAR.rule.new * VAL.rule.new
data.sample <- red.data(data.sample, ant.best.rule, epsilon, type = "SLAVE", varinp.mf)
iter = iter + 1
iter.pb = iter.pb + 1
## update the number of data after reducing
num.sample.fin <- nrow(data.sample)
if (num.sample.fin <= 3 || iter >= max.iter){
stop.cr <- TRUE
iter.pb <- i * max.iter
}
## progress bar
setTxtProgressBar(progressbar, iter.pb)
}
## check for fuzzy rule sets for each class
rule <- rbind(rule, best.rule)
}
close(progressbar)
rule <- na.omit(rule)
VAR <- rule[, 1 : num.inputvar, drop = FALSE]
VAL <- rule[, (num.inputvar + 1) : ncol(rule), drop = FALSE]
rule <- VAL * cbind(VAR, 1)
rule.data.num <- unique(rule)
gen.rule.temp <- generate.rule(rule.data.num, num.labels)
rule <- gen.rule.temp$rule
colnames(varinp.mf) <- gen.rule.temp$names.varinput
rule[, ncol(rule)] <- rule.data.num[, ncol(rule.data.num)]
mod <- list(rule = rule, rule.data.num = rule.data.num, varinp.mf = varinp.mf, num.labels = num.labels, range.data.ori = range.data.input, type.model = "FRBCS",
type.mf = "TRIANGLE", type.tnorm = "PRODUCT", type.snorm = "MAX", type.implication.func = "ZADEH")
return(mod)
}
#' This is the internal function that implements genetic lateral tuning and rule selection of linguistic fuzzy systems (GFS.LT.RS).
#' It is used to solve regression tasks.
#' Users do not need to call it directly, but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was proposed by R. Alcala et al.
#' GFS.LT.RS implements a evolutionary algorithm for postprocessing in constructing FRBS model.
#' It uses a new rule representation model based on the linguistic 2-tupples representation that allows
#' the lateral displacement of the labels. This function allows two different tuning which are global and local tuning.
#'
#' Regarding with evolutionary algorithms, the following are main components:
#' \itemize{
#' \item coding scheme and initial gene pool;
#' \item chromosome evalution;
#' \item crossover operator;
#' \item restarting approach;
#' \item evolutionary model;
#' }
#' In first time, population is constructed by Wang & Mendel's technique. Mean square error (MSE) is used to
#' calculate chromosome evaluation. This method performs BLX-a in crossover process.
#' Additionally, rule selection method is performed in order to minimize the number of rules.
#'
#' @title GFS.LT.RS model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process, where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable. Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param range.data a matrix representing interval of data.
#' @param num.labels a matrix representing the number of linguistic terms in each variables.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.gen the maximal number of generations of the genetic algorithm.
#' @param mode.tuning a type of tuning which are \code{"LOCAL"} or \code{"GLOBAL"}.
#' @param type.tnorm a type of t-norm. See \code{\link{inference}}.
#' @param type.snorm a type of s-norm. See \code{\link{inference}}.
#' @param type.implication.func a type of implication function. See \code{\link{WM}}.
#' @param type.defuz a type of defuzzification methods. See \code{\link{defuzzifier}}.
#' @param rule.selection a boolean value representing whether performs rule selection or not.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @seealso \code{\link{GFS.LT.RS.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' R. Alcala, J. Alcala-Fdez, and F. Herrera, "A proposal for the genetic lateral tuning of linguistic fuzzy systems and its interaction with
#' rule selection", IEEE Trans. on Fuzzy Systems, Vol. 15, No. 4, pp. 616 - 635 (2007).
# @export
GFS.LT.RS <- function(data.train, popu.size = 10, range.data, num.labels, persen_mutant, max.gen = 10, mode.tuning = "GLOBAL",
type.tnorm = "MIN", type.snorm = "MAX", type.implication.func = "ZADEH", type.defuz = "WAM", rule.selection = FALSE, range.data.ori) {
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.gen, style = 3)
## make testing data from training data
data.test <- data.train[, 1 : (ncol(data.train) - 1), drop = FALSE]
real.val <- data.train[, ncol(data.train), drop = FALSE]
## generate initial rules and membership function from Wang & Mendel's method
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection, type.tnorm = type.tnorm,
type.implication.func = type.implication.func)
res <- generate.popu(method.type = "GFS.LT.RS", data.train = data.train, range.data = range.data,
num.labels = num.labels, popu.size = popu.size, params = params)
var.mf <- res$var.mf
popu <- res$popu
num.rule <- res$num.rule
rule.data.num <- res$rule.data.num
init.popu <- popu
## iteration of GA
gen = 1
init.err <- 100000
err <- matrix(nrow = popu.size + 1, ncol = 1)
L <- 0
while (gen <= max.gen){
## Calculate fitness
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection)
indv.fit <- eval.indv.fitness(data.train = data.train, rule = rule.data.num, method.type = "GFS.LT.RS", varinp.mf = var.mf,
num.labels = num.labels, popu.var = popu, params = params)
min.err <- min(indv.fit[, 1])
if (min.err < init.err) {
indx.best.indv <- which.min(indv.fit[, 1])
best.indv <- popu[indx.best.indv, , drop = FALSE]
init.err <- min.err
L <- 1
}
## sort population according to individual fitness
temp.popu <- cbind(popu, indv.fit)
temp.popu <- temp.popu[order(temp.popu[, ncol(temp.popu)]), ]
popu.parent <- temp.popu[1:2, -ncol(temp.popu), drop = FALSE]
## perform crossover
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection, num.rule = num.rule)
new.popu <- GA.crossover(population = popu.parent, persen_cross = 1, type = "2tupple", params = params)
## perform mutation for rule selection only
popu.rs <- new.popu[, (ncol(new.popu) - num.rule + 1) : ncol(new.popu), drop = FALSE]
new.popu.rs <- GA.mutation(population = popu.rs, persen_mutant = persen_mutant, type = "BINARY")
new.popu[, (ncol(new.popu) - num.rule + 1) : ncol(new.popu)] <- new.popu.rs
## calculate individual fitness
params$mode.tuning <- mode.tuning
params$rule.selection <- rule.selection
new.indv.fit <- eval.indv.fitness(data.train = data.train, rule = rule.data.num, method.type = "GFS.LT.RS", varinp.mf = var.mf,
num.labels = num.labels, popu.var = new.popu, params = params)
## sort new individual
temp.new.popu <- cbind(new.popu, new.indv.fit)
temp.new.popu <- temp.new.popu[order(temp.new.popu[, ncol(temp.new.popu)]), ]
## add new individual into population
if (temp.popu[(nrow(temp.popu) - 1), ncol(temp.popu)] >= temp.new.popu[2, ncol(temp.new.popu)]){
temp.popu[(nrow(temp.popu) - 1), ] <- temp.new.popu[1, ]
temp.popu[nrow(temp.popu), ] <- temp.new.popu[2, ]
}
## update population
popu <- temp.popu[, -ncol(temp.popu)]
gen = gen + 1
L = L + 1
if (L > (1/3 * max.gen)){
popu <- init.popu
}
## progress bar
setTxtProgressBar(progressbar, gen)
}
close(progressbar)
if (rule.selection == TRUE){
rule.data.num <- check.active.rule(rule.data.num, num.rule, best.indv)
} else {
rule.data.num <- rule.data.num
}
params$popu <- best.indv
params$var.mf <- var.mf
params$num.rule <- num.rule
params$mode.tuning <- mode.tuning
params$rule.selection <- rule.selection
res.tune <- tune.MF(method.type = "GFS.LT.RS", params = params)
var.mf <- res.tune$var.mf
var.mf.tune <- res.tune$var.mf.tune
rule <- generate.rule(rule.data.num, num.labels)$rule
varinp.mf <- var.mf[, 1 : (ncol(var.mf) - num.labels[1, ncol(num.labels)]), drop = FALSE]
varout.mf <- var.mf[, (ncol(varinp.mf) + 1) : ncol(var.mf), drop = FALSE]
mod <- list(rule = rule, rule.data.num = rule.data.num, var.mf = var.mf, varinp.mf = varinp.mf, varout.mf = varout.mf, var.mf.tune = var.mf.tune, num.labels = num.labels,
mode.tuning = mode.tuning, rule.selection = rule.selection, range.data.ori = range.data.ori,
type.defuz = type.defuz, type.tnorm = type.tnorm, type.snorm = type.snorm, type.mf = "TRIANGLE",
type.implication.func = type.implication.func, type.model = "2TUPPLE")
return(mod)
}
Try the frbs package in your browser
Any scripts or data that you put into this service are public.
frbs documentation built on Dec. 16, 2019, 1:19 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions GFS.FR.MOGUL GFS.Thrift GFS.GCCL FH.GBML SLAVE GFS.LT.RS
Documented in FH.GBML GFS.FR.MOGUL GFS.GCCL GFS.LT.RS GFS.Thrift SLAVE
#############################################################################
#
# This file is a part of the R package "frbs".
#
# Author: Lala Septem Riza
# Co-author: Christoph Bergmeir
# Supervisors: Francisco Herrera Triguero and Jose Manuel Benitez
# Copyright (c) DiCITS Lab, Sci2s group, DECSAI, University of Granada.
#
# This package is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, either version 2 of the License, or (at your option) any later version.
#
# This package is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
#############################################################################
#' This is the internal function that implements genetic fuzzy systems for fuzzy rule learning
#' based on the MOGUL methodology (GFS.FR.MOGUL). It is used to solve regression tasks.
#' Users do not need to call it directly, but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was proposed by Herrera et al.
#' GFS.FR.MOGUL implements a genetic algorithm determining the structure
#' of the fuzzy IF-THEN rules and the membership function parameters.
#' There are two general types of fuzzy IF-THEN rules, namely the descriptive
#' and the approximative/free semantic approaches. A descriptive approach means that
#' the linguistic labels represent a real-world semantic; the linguistic labels are
#' uniformly defined for all rules. In contrast, in the approximative approach
#' there isn't any associated linguistic label. This method is based on the latter one.
#' We model a fuzzy IF-THEN rule on a chromosome which consists of the parameter values of
#' the membership function. So, every rule has its own membership function values.
#' A population contains many such generated chromosomes, based on the iterative rule learning
#' approach (IRL). IRL means that the chromosomes will be generated one by one, taking into
#' account the fitness value and covering factor, until there are sufficient chromosomes
#' in the population. After having obtained the population, the genetic algorithm is started,
#' using the genetic operators selection, mutation, and crossover.
#'
#' @title GFS.FR.MOGUL model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process, where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable. Note the data must be normalized between 0 and 1.
#' @param persen_cross a real number between 0 and 1 determining the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.iter the maximal number of iterations.
#' @param max.gen the maximal number of generations of the genetic algorithm.
#' @param max.tune the maximal number of tuning iterations.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @param epsilon a real number between 0 and 1 determining the boundary of covering factor.
#' @seealso \code{\link{GFS.FR.MOGUL.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' F. Herrera, M. Lozano, and J.L. Verdegay,
#' "A learning process for fuzzy control rules using genetic algorithms",
#' Fuzzy Sets and Systems, vol. 100, pp. 143 - 158 (1998).
#'
#' O. Cordon, M.J. del Jesus, F. Herrera, and M. Lozano,
#' "MOGUL: A methodology to obtain genetic fuzzy rule-based systems
#' under the iterative rule learning approach", International Journal of Intelligent Systems,
#' vol. 14, pp. 1123 - 1153 (1999).
# @export
GFS.FR.MOGUL <- function(data.train, persen_cross = 0.6, persen_mutant = 0.3, max.iter = 10, max.gen = 10, max.tune = 10,
range.data.ori, epsilon = 0.4){
## A genetic generation stage
data.train.ori <- data.train
data.sample <- data.train
num.var <- ncol(data.train)
num.inputvar <- num.var - 1
best.rules <- matrix(NA, nrow = 1, ncol = (3 * ncol(data.sample)))
iter <- 1
stop.cr <- FALSE
num.rules.popu <- 10
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.iter, style = 3)
while (stop.cr == FALSE){
## get rule based on data.train
temp.rule <- matrix(NA, nrow = 1, ncol = (3 * ncol(data.sample)))
## check number of rules
if (nrow(data.sample) < num.rules.popu){
num.rules.popu <- nrow(data.sample)
}
## generate initial population
for (i in 1 : num.rules.popu){
rule <- generate.popu(method.type = "GFS.FR.MOGUL", data.train = data.sample[i, ,drop = FALSE])
temp.rule <- rbind(temp.rule, rule)
}
popu <- na.omit(temp.rule)
popu.size <- nrow(popu)
old.best.fit <- -1
gen <- 1
while (gen < max.gen){
##calculate individual fitness
ind.fit <- eval.indv.fitness(data.train = data.sample, rule = popu, method.type = "GFS.FR.MOGUL", epsilon = epsilon)
## combine rule.gen and its fitness
rule.withFit <- cbind(popu, ind.fit)
## get the best individual
new.best.fit <- max(rule.withFit[, ncol(rule.withFit)])
if (new.best.fit > old.best.fit){
indx <- which.max(rule.withFit[, ncol(rule.withFit), drop = FALSE])
new.best.rule <- rule.withFit[indx, -ncol(rule.withFit), drop = FALSE]
old.best.fit <- new.best.fit
}
popu.rule <- rule.withFit[, -ncol(rule.withFit), drop = FALSE]
if (nrow(popu.rule) > 2){
## GA.Crossover
popu <- GA.crossover(popu.rule, persen_cross, type = "MOGUL", num.inputvar)
}
## GA.Mutation
popu <- GA.mutation(popu, persen_mutant, type = "MOGUL", iter = gen,
max.iter = max.gen)
gen = gen + 1
}
best.rules <- rbind(best.rules, new.best.rule)
data.sample <- red.data(data.sample, new.best.rule, epsilon, type = "MOGUL")
iter = iter + 1
## update the number of data after reducing
num.sample.fin <- nrow(data.sample)
if (num.sample.fin <= 3 || iter >= max.iter){
stop.cr <- TRUE
iter <- max.iter
}
## progress bar
setTxtProgressBar(progressbar, iter)
}
close(progressbar)
best.rules <- na.omit(best.rules)
mod <- list(rule = best.rules)
params <- list(mod = mod, data.train = data.train.ori, max.iter = max.tune)
new.mod <- tune.MF(method.type = "GFS.FR.MOGUL", params)
best.rules <- new.mod$rule
mod <- list(rule = best.rules, range.data.ori = range.data.ori, type.tnorm = "MIN",
type.snorm = "SUM", type.model = "APPROXIMATE", type.implication.func = "MIN")
return(mod)
}
#' This is the internal function that implements the Thrift's technique based
#' on a genetic algorithm. It is used to tackle regression tasks. Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was developed by Thrift using Mamdani's model as fuzzy IF-THEN rules.
#' In this method, we consider a table as a genotype with alleles that are fuzzy set indicators
#' over the output domain. The phenotype is produced by the behavior produced
#' by the fuzzification, max-* composition, and defuzzification operations.
#' A chromosome (genotype) is formed from the decision table by going rowwise
#' and producing a string of numbers from the code set. Standard crossover
#' and mutation operators can act on these string.
#'
#' @title GFS.Thrift model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param num.labels a matrix describing the number of linguistic terms.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @param type.defuz the type of the defuzzification method. For more detail, see \code{\link{defuzzifier}}.
#' The default value is \code{WAM}.
#' @param type.tnorm the type of t-norm. For more detail, please have a look at \code{\link{inference}}.
#' @param type.snorm the type of s-norm. For more detail, please have a look at \code{\link{inference}}.
#' @param type.mf the type of shape of membership function. See \code{\link{fuzzifier}}.
#' @param type.implication.func the type of implication function. See \code{\link{WM}}.
#' @seealso \code{\link{GFS.Thrift.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' P. Thrift, "Fuzzy logic synthesis with genetic algorithms", In Proceedings of the Fourth
#' International Conference on Genetic Algorithms (ICGA91), San Diego (United States of
#' America), pp. 509 - 513 (1991).
# @export
GFS.Thrift <- function(data.train, popu.size = 10, num.labels, persen_cross = 0.6, persen_mutant = 0.3,
max.gen = 10, range.data.ori, type.defuz = "WAM", type.tnorm = "MIN", type.snorm = "MAX", type.mf = "TRIANGLE", type.implication.func = "ZADEH"){
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.gen, style = 3)
range.data <- matrix(nrow = 2, ncol = ncol(data.train))
range.data[1, ] <- 0
range.data[2, ] <- 1
## initialize mod
mod <- NULL
#### Initialize population
num.var <- ncol(data.train)
num.inputvar <- num.var - 1
if (popu.size > num.labels[1,1]^num.var){
popu.size = num.labels[1,1]^num.var
}
## generate initial population
complete.popu <- matrix(nrow = (num.labels[1,1]^num.var), ncol = num.var)
x <- list(1:num.labels[1,1])
tmp = expand.grid(rep(x, num.var))
complete.popu <- as.matrix(tmp)
rule.data.num <- complete.popu[sample(nrow(complete.popu)),]
## change scale terms
rule.data.num <- scale.StrToRule(rule.data.num, num.labels)
rule.tmp <- generate.rule(rule.data.num, num.labels)
var.mf <- partition.MF(range.data, num.labels, type.mf)
## Construct parameters
mod$range.input <- range.data[, 1 : (ncol(range.data) - 1), drop = FALSE]
mod$range.output <- range.data[, ncol(range.data), drop = FALSE]
mod$num.varinput <- (ncol(data.train) - 1)
mod$num.fvalinput <- num.labels[1, 1 : (ncol(num.labels) - 1), drop = FALSE]
mod$names.varinput <- rule.tmp$names.varinput
mod$varinp.mf <- var.mf[, 1 : (num.labels[1,1] * (num.var - 1)), drop = FALSE]
colnames(mod$varinp.mf) <- mod$names.varinput
mod$names.varoutput <- rule.tmp$names.varoutput
mod$rule <- rule.tmp$rule
mod$rule.data.num = rule.data.num
mod$varout.mf <- var.mf[, (num.labels[1,1] * (num.var - 1) + 1) : ncol(var.mf), drop = FALSE]
colnames(mod$varout.mf) <- mod$names.varoutput
mod$type.defuz <- type.defuz
mod$type.tnorm <- type.tnorm
mod$type.snorm <- type.snorm
mod$type.model <- "MAMDANI"
mod$method.type <- "GFS.THRIFT"
## calculate cover factor
heu.val <- calc.heu(mod, data.train, num.labels, type.implication.func)
tmp <- cbind(rule.data.num, heu.val)
## sort based on cover factor
rule.data.num.sorted <- tmp[order(tmp[, ncol(tmp)], decreasing = TRUE), ]
## get rule.data.num
rule.data.num.sorted <- rule.data.num.sorted[1 : popu.size, ,drop = FALSE]
rule.data.num <- rule.data.num.sorted[, 1 : (ncol(rule.data.num.sorted) - 1), drop = FALSE]
## make testing data from training data
data.test <- data.train[, 1 : (ncol(data.train) - 1), drop = FALSE]
real.val <- data.train[, ncol(data.train), drop = FALSE]
## initialize for looping
stop <- 0
best.fit <- 1000000000
temp.fit <- matrix()
bench <- matrix(ncol = 2)
while (stop <= max.gen){
## delete or change unnecessary rules
res.rule.data.num <- prune.rule(rule.data.num = rule.data.num, method = "THRIFT", num.labels = num.labels)
mod$rule.data.num <- res.rule.data.num
pred.val <- GFS.Thrift.test(mod, data.test)
bench <- cbind(real.val, pred.val)
## calculate RMSE as fitness function
residuals <- matrix(bench[, 1] - bench[, 2], nrow = 1)
RMSE <- sqrt(mean(residuals^2))
fitness <- RMSE
if (fitness < best.fit){
best.fit <- fitness
best.rule.data.num <- mod$rule.data.num
}
### crossover
rule.data.num <- GA.crossover(rule.data.num, persen_cross, type = "1Pt")
### mutation
rule.data.num <- GA.mutation(rule.data.num, persen_mutant, num.labels, num.inputvar = NULL, type = "MICHIGAN")
stop = stop + 1
## progress bar
setTxtProgressBar(progressbar, stop)
}
close(progressbar)
## get the best rules
mod$rule.data.num <- best.rule.data.num
tmp <- generate.rule(best.rule.data.num, num.labels)
mod$rule <- tmp$rule
mod$range.data.ori <- range.data.ori
mod$type.defuz <- type.defuz
mod$type.tnorm <- type.tnorm
mod$type.snorm <- type.snorm
mod$type.mf <- type.mf
mod$num.labels <- num.labels
mod$type.implication.func <- type.implication.func
return(mod)
}
#' This is the internal function that implements the Ishibuchi's method based on
#' genetic cooperative-competitive learning (GFS.GCCL). It is used to handle classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is based on Ishibuchi's method. In this method, a chromosome describes
#' each linguistic IF-THEN rule using integer as its representation of the antecedent part.
#' In the consequent part of the fuzzy rules, the heuristic method is applied to
#' automatically generate the class. The evaluation is calculated for each rule
#' which means that the performance is not based on the entire rule set.
#' The outline of the method is as follows.
#' \itemize{
#' \item Step 1: Generate an initial population of fuzzy IF-THEN rules.
#' \item Step 2: Evaluate each fuzzy IF-THEN rule in the current population.
#' \item Step 3: Generate new fuzzy IF-THEN rules by genetic operators.
#' \item Step 4: Replace a part of the current population with the newly generated rules.
#' \item Step 5: Terminate the algorithm if a stopping condition is satisfied,
#' otherwise return to Step 2.
#' }
#' Additionally, to handle high dimensional data, this method uses "don't care"
#' attributes on the antecedent fuzzy set.
#'
#' @title GFS.GCCL model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param num.labels a matrix describing the number of linguistic terms.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param range.data.ori a matrix containing the ranges of the input data.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' H. Ishibuchi, T. Nakashima, and T. Murata, "Performance evaluation of fuzzy classifier systems for
#' multidimensional pattern classification problems",
#' IEEE trans. on Systems, Man, and Cybernetics - Part B: Sybernetics, vol. 29. no. 5, pp. 601 - 618 (1999).
# @export
GFS.GCCL <- function(data.train, popu.size = 10, range.data.input, num.labels, persen_cross = 0.6, persen_mutant = 0.3,
max.gen = 10, range.data.ori){
num.labels.inp <- num.labels[1, 1:(ncol(num.labels) - 1), drop = FALSE]
num.inputvar <- (ncol(data.train) - 1)
## make range of data according to class on data training
range.data.out <- matrix(c(min(data.train[, ncol(data.train)], na.rm = TRUE) - 0.4999,
max(data.train[, ncol(data.train)], na.rm = TRUE) + 0.4999), nrow = 2)
range.data <- cbind(range.data.input, range.data.out)
type.mf = "TRIANGLE"
## generate initial model using Wang Mendel/Chi technique as heuristics
if (popu.size < nrow(data.train)){
num.data <- popu.size
} else {
num.data <- nrow(data.train)
}
mod <- WM(data.train[1 : num.data, ,drop = FALSE], num.labels, type.mf, type.tnorm = "PRODUCT", type.implication.func = "ZADEH", classification = TRUE)
rule.data.num <- mod$rule.data.num
num.r <- as.integer(runif(1, min = 1, max = nrow(rule.data.num) + 0.9))
row.r <- as.integer(runif(num.r, min = 1, max = nrow(rule.data.num) + 0.9))
p.dcare <- 0.8
for (j in row.r){
col.r <- as.integer(runif(1, min = 1, max = ((ncol(rule.data.num) - 1) + 0.9)))
rand <- runif(1, min = 0, max = 1)
if (rand <= p.dcare)
rule.data.num[j, col.r] <- 0
}
ant.rules <- rule.data.num[, -ncol(rule.data.num), drop = FALSE]
num.rules <- nrow(ant.rules)
if (popu.size > num.rules){
ant.rules.a <- generate.popu(method.type = "GFS.GCCL", num.var = num.inputvar,
num.labels = num.labels.inp, popu.size = (popu.size - num.rules))
ant.rules <- rbind(ant.rules, ant.rules.a)
}
varinp.mf <- mod$varinp.mf
mod <- GFS.Michigan(data.train, ant.rules, varinp.mf, num.labels, persen_cross, persen_mutant, max.gen, only.GCCL = TRUE)
best.rule <- mod$rule
best.grade.cert <- mod$grade.cert
red.mod <- prune.rule(rule.data.num = best.rule, method = "GCCL", indv.fit = best.grade.cert)
mod$rule.data.num <- red.mod$rule
if (nrow(mod$rule.data.num) < 1){
stop("frbs cannot generate the fuzzy rules, please set the higher value of popu.size")
}
mod$grade.cert <- red.mod$grade.cert
mod$rule <- generate.rule(red.mod$rule, num.labels)$rule
mod$rule[, ncol(mod$rule)] <- mod$rule.data.num[, ncol(mod$rule.data.num)]
mod$num.labels <- num.labels
mod$range.data.ori <- range.data.ori
mod$type.mf <- "TRIANGLE"
mod$type.tnorm <- "PRODUCT"
mod$type.snorm <- "MAX"
mod$type.model <- "FRBCS"
mod$type.implication.func <- "ZADEH"
return(mod)
}
#' This is the internal function that implements the Ishibuchi's method based on
#' hybridization of genetic cooperative-competitive learning (GCCL) and Pittsburgh (FH.GBML). It is used to solve classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is based on Ishibuchi's method using the hybridization
#' of GCCL and the Pittsburgh approach for genetic fuzzy systems.
#' The algorithm of this method is as follows:
#' \itemize{
#' \item Step 1: Generate population where each individual in the population is a fuzzy rule set.
#' \item Step 2: Calculate the fitness value of each rule set in the current population.
#' \item Step 3: Generate new rule sets by the selection, crossover, and mutation in
#' the same manner as the Pittsburgh-style algorithm. Then, apply iterations of
#' the GCCL to each of the generated rule sets with a probability.
#' \item Step 4: Add the best rule set in the current population to newly generated rule sets
#' to form the next population.
#' \item Step 5: Return to Step 2 if the prespecified stopping condition is not satisfied.
#' }
#'
#' @title FH.GBML model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param max.num.rule the maximum number of rules.
#' @param persen_cross a real number between 0 and 1 determining the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.gen the maximal number of generations for the genetic algorithms.
#' @param num.class a number of the classes.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param p.dcare a probability of "don't care" attributes occurred.
#' @param p.gccl a probability of GCCL process occurred.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' H. Ishibuchi, T. Yamamoto, and T. Nakashima, "Hybridization of fuzzy GBML approaches for pattern classification
#' problems," IEEE Trans. on Systems, Man, and Cybernetics-Part B: Cybernetics,
#' vol. 35, no. 2, pp. 359 - 365 (2005).
# @export
FH.GBML <- function(data.train, popu.size = 10, max.num.rule = 5, persen_cross = 0.6, persen_mutant = 0.3, max.gen = 10, num.class, range.data.input, p.dcare = 0.5, p.gccl = 0.5){
## create progress bar
progressbar.gbml <- txtProgressBar(min = 0, max = max.gen, style = 3)
##Inisialitation of Data
range.data <- range.data.input
range.data[1, ] <- 0
range.data[2, ] <- 1
type.mf = 1
num.inputvar <- ncol(data.train) - 1
num.var <- ncol(data.train)
num.labels.inp <- matrix(rep(14, num.inputvar), nrow = 1)
num.labels <- cbind(num.labels.inp, num.class)
##define parameter values of MF on input variables
varinp.mf <- create.MF(num.inputvar)
##Inisialitation of population
popu.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * num.inputvar))
popu.comp.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * (num.inputvar + 1)))
popu.grade.cert <- matrix(NA, nrow = 1, ncol = max.num.rule)
popu.fit.rule <- matrix(NA, nrow = 1, ncol = max.num.rule)
for (i in 1 : popu.size){
num.inputvar <- (ncol(data.train) - 1)
## generate antecent of rules
rule.data.num <- generate.popu(method.type = "FH.GBML", num.var = num.inputvar,
num.labels = num.labels.inp, popu.size = max.num.rule)
num.r <- as.integer(runif(1, min = 1, max = nrow(rule.data.num) + 0.9))
row.r <- as.integer(runif(num.r, min = 1, max = nrow(rule.data.num) + 0.9))
for (j in row.r){
col.r <- as.integer(runif(1, min = 1, max = (ncol(rule.data.num) + 0.9)))
rand <- runif(1, min = 0, max = 1)
if (rand <= p.dcare)
rule.data.num[j, col.r] <- 0
}
## determine Class-q and grade of certainty
buffer.rule <- det.fit.rule(data.train, rule.data.num, varinp.mf, num.labels, type.grade.cert = 2)
## get components on buffer.rule
comp.rule <- buffer.rule$rule
grade.cert <- buffer.rule$grade.cert
fit.rule <- buffer.rule$fit.rule
## get grade of certainty and fit.rule as vector by transposing
temp.grade.cert <- t(grade.cert)
temp.fit.rule <- t(fit.rule)
## make antecendent of rule and complete rule as vector (to be individual on population)
ant.rule.tmp <- convert.MatToVec(comp.rule[, -ncol(comp.rule), drop = FALSE])
comp.rule.tmp <- convert.MatToVec(comp.rule)
## arange all components as population
popu.rule <- rbind(popu.rule, ant.rule.tmp)
popu.comp.rule <- rbind(popu.comp.rule, comp.rule.tmp)
popu.grade.cert <- rbind(popu.grade.cert, temp.grade.cert)
popu.fit.rule <- rbind(popu.fit.rule, temp.fit.rule)
}
## delete element NA on initialization step
popu.rule <- na.omit(popu.rule)
popu.comp.rule <- na.omit(popu.comp.rule)
popu.grade.cert <- na.omit(popu.grade.cert)
popu.fit.rule <- na.omit(popu.fit.rule)
## Initialization
iter = 1
best.err.percent = 100000
data.test <- data.train[, -ncol(data.train), drop = FALSE]
while (iter <= max.gen){
##Evaluate fitness function for each individual (a set of fuzzy rules)
err.percent <- matrix(nrow = nrow(popu.rule), ncol = 1)
for (i in 1 : nrow(popu.rule)){
## get one row of population
rule.vector <- matrix(popu.comp.rule[i, ], nrow = 1)
grade.cert <- matrix(popu.grade.cert[i, ], ncol = 1)
## convert vector of rule into rule.data.num form
rule <- convert.VecToMat(rule.vector, num.var)
## Get the best population by calculating fitness
classifier.rule <- list(rule = rule, grade.cert = grade.cert)
resClass.train <- GFS.GCCL.test(data.test, classifier.rule, varinp.mf)
bench <- cbind(data.train[, ncol(data.train), drop = FALSE], resClass.train)
counter = 0
for (j in 1 : nrow(bench)){
if (bench[j, 1] != bench[j, 2]){
counter = counter + 1
}
}
err.percent[i, 1] <- counter / nrow(bench) * 100
}
min.err.percent <- min(err.percent)
if (min.err.percent < best.err.percent){
indx.best.indv <- which.min(err.percent)
best.err.percent <- min.err.percent
## save the best
best.popu.rule <- popu.rule[indx.best.indv, ,drop = FALSE]
best.popu.comp.rule <- popu.comp.rule[indx.best.indv, ,drop = FALSE]
best.rule <- convert.VecToMat(best.popu.comp.rule, num.var)
best.grade.cert <- matrix(popu.grade.cert[indx.best.indv, ], ncol = 1)
}
##Crossover
new.popu.rule <- GA.crossover(popu.rule, persen_cross, type = "1Pt")
##mutation
new.popu.rule <- GA.mutation(new.popu.rule, persen_mutant, type = "PITTSBURGH", num.labels.inp, num.inputvar)
## GFS-GCCL
popu.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * num.inputvar))
popu.comp.rule <- matrix(NA, nrow = 1, ncol = (max.num.rule * (num.inputvar + 1)))
popu.grade.cert <- matrix(NA, nrow = 1, ncol = max.num.rule)
for (i in 1 : nrow(new.popu.rule)){
r.m <- runif(1, min=0, max =1)
## convert rule in vector into matrix
ant.rule.vector <- new.popu.rule[i, ,drop = FALSE]
ant.rules <- convert.VecToMat(ant.rule.vector, num.inputvar)
if (r.m <= p.gccl){
### convert rule as vector into ant.rules
persen_cross.michigan <- persen_cross
persen_mutant.michigan <- persen_mutant
max.gen.michigan <- 1
mod.michigan <- GFS.Michigan(data.train, ant.rules, varinp.mf, num.labels, persen_cross.michigan, persen_mutant.michigan, max.gen.michigan)
## convert matrix into vector
comp.rule.tmp <- mod.michigan$rule
grade.cert.tmp <- mod.michigan$grade.cert
ant.rule.tmp <- comp.rule.tmp[, -ncol(comp.rule.tmp), drop = FALSE]
} else {
## determine grade.cert, fitness
buffer.rule <- det.fit.rule(data.train, ant.rules, varinp.mf, num.labels, type.grade.cert = 2)
comp.rule.tmp <- buffer.rule$rule
grade.cert.tmp <- buffer.rule$grade.cert
ant.rule.tmp <- comp.rule.tmp[, -ncol(comp.rule.tmp), drop = FALSE]
}
comp.rule.tmp <- convert.MatToVec(comp.rule.tmp)
grade.cert.tmp <- t(grade.cert.tmp)
rule.tmp <- convert.MatToVec(ant.rule.tmp)
## make antecendent of rule and complete rule as vector (to be individual on population)
popu.rule <- rbind(popu.rule, rule.tmp)
popu.comp.rule <- rbind(popu.comp.rule, comp.rule.tmp)
popu.grade.cert <- rbind(popu.grade.cert, grade.cert.tmp)
}
popu.rule <- na.omit(popu.rule)
popu.comp.rule <- na.omit(popu.comp.rule)
popu.grade.cert <- na.omit(popu.grade.cert)
iter = iter + 1
## progress bar
setTxtProgressBar(progressbar.gbml, iter)
}
close(progressbar.gbml)
red.mod <- prune.rule(rule.data.num = best.rule, method = "GCCL", indv.fit = best.grade.cert)
rule.data.num <- red.mod$rule
if (nrow(rule.data.num) < 1){
stop("frbs cannot generate the fuzzy rules, please set the higher value of popu.size and max.num.rule")
}
rule <- generate.rule(red.mod$rule, num.labels)$rule
rule[, ncol(rule)] <- rule.data.num[, ncol(rule.data.num)]
best.grade.cert <- red.mod$grade.cert
mod <- list(rule = rule, rule.data.num = rule.data.num, grade.cert = best.grade.cert, varinp.mf = varinp.mf, range.data.ori = range.data.input,
num.labels = num.labels, type.mf = "TRIANGLE", type.tnorm = "PRODUCT", type.model = "FRBCS", type.snorm = "MAX", type.implication.func = "ZADEH")
return(mod)
}
#' This is the internal function that implements
#' the structural learning algorithm on vague environment (SLAVE). It is used to handle classification tasks.
#' Users do not need to call it directly,
#' but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method is adopted from A. Gonzalez and R. Perez's paper which is applied for
#' classification problems. SLAVE is based on the iterative rule learning approach
#' which means that we get only one fuzzy rule in each execution of the genetic algorithm.
#' In order to eliminate the irrelevant variables in a rule,
#' SLAVE has a structure composed of two parts: the first part is to represent
#' the relevance of variables and the second one is to define values of the parameters.
#' The following steps are conducted in order to obtain fuzzy rules:
#' \itemize{
#' \item Step 1: Use the genetic algorithm process to obtain ONE RULE for the system.
#' \item Step 2: Collect the rule into the final set of rules.
#' \item Step 3: Check and penalize this rule.
#' \item Step 4: If the stopping criteria is satisfied,
#' the system returns the set of rules as solution. Otherwise, back to Step 1.
#' }
#' This method uses binary codes as representation of the population and
#' applies the basic genetic operators, i.e., selection, crossover, and mutation on it.
#' And, the best rule is obtained by calculating the degree of consistency and completeness.
#'
#' @title SLAVE model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process,
#' where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; The last column is the output variable.
#' Note the data must be normalized between 0 and 1.
#' @param persen_cross a real number between 0 and 1 representing the probability of crossover.
#' @param persen_mutant a real number between 0 and 1 representing the probability of mutation.
#' @param max.iter the maximal number of iterations.
#' @param max.gen the maximal number of generations for the genetic algorithm.
#' @param num.labels a number of the linguistic terms.
#' @param range.data.input a matrix containing the ranges of the normalized input data.
#' @param k.lower a lower bound of the noise threshold.
#' @param k.upper an upper bound of the noise threshold.
#' @param epsilon a value between 0 and 1 representing the covering factor.
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' A. Gonzalez and R. Perez, "Selection of relevant features in a fuzzy genetic learning algorithm",
#' IEEE Transactions on Systems, Man, and Cybernetics, Part B: Cybernetics, vol. 31, no. 3,
#' pp. 417 - 425 (2001).
# @export
SLAVE <- function(data.train, persen_cross = 0.6, persen_mutant = 0.3, max.iter = 10, max.gen = 10, num.labels, range.data.input, k.lower = 0.25, k.upper = 0.75, epsilon = 0.1){
if (max.iter < 5){
stop("please set maximum iteration greater than 5")
}
## initialize
type.mf = 1
best.comp.rule <- matrix(ncol = ncol(data.train))
num.inputvar <- (ncol(data.train) - 1)
rule <- matrix(NA, nrow = 1, ncol = (num.inputvar + ncol(data.train)))
## split data.train based on class
num.labels.inp <- num.labels[, -ncol(num.labels), drop = FALSE]
num.class <- num.labels[1, ncol(num.labels)]
## generate varinp.mf
range.data.input.norm <- range.data.input
range.data.input.norm[1, ] <- 0
range.data.input.norm[2, ] <- 1
## create progress bar
progressbar <- txtProgressBar(min = 0, max = (num.class * max.iter), style = 3)
iter.pb <- 1
## iterate for each class on data.train
for (i in 1 : num.class){
max.fit <- matrix(0, nrow = 1, ncol = 1)
popu <- generate.popu(method.type = "SLAVE", data.train = data.train, num.var = num.inputvar,
num.labels = num.labels.inp, range.data = range.data.input.norm,
type.mf = 1, name.class = i)
name.class <- i
data.sample <- data.train[which(data.train[, ncol(data.train)] == name.class), ]
## calculate fitness for each rule
popu.var <- popu$popu.var
comp.rule <- popu$popu.val
varinp.mf <- popu$varinp.mf
res <- eval.indv.fitness(data.train = data.train, rule = comp.rule, method.type = "SLAVE", data.sample = data.sample, varinp.mf = varinp.mf,
num.labels = num.labels, popu.var = popu.var, k.lower = k.lower, k.upper = k.upper)
### get index which has max value
best.indv <- which.max(res)
## get the best rule(VAL) and VAR
best.comp.rule <- comp.rule[best.indv, ,drop = FALSE]
best.var <- popu.var[best.indv, ,drop = FALSE]
rule.new <- cbind(best.var, best.comp.rule)
best.rule <- rule.new
max.fit <- res[best.indv, 1]
## check degree considering with rule.new
VAR.rule.new <- rule.new[, 1 : num.inputvar, drop = FALSE]
VAL.rule.new <- rule.new[, (num.inputvar + 1) : (ncol(rule.new) - 1), drop = FALSE]
## get actual rule (with don't care attributes)
ant.best.rule <- VAR.rule.new * VAL.rule.new
data.sample <- red.data(data.sample, ant.best.rule, epsilon, type = "SLAVE" , varinp.mf)
old.num.data <- nrow(data.sample)
stop.cr <- FALSE
iter <- 1
num.sample.fin <- -1
while (stop.cr == FALSE){
## split class
data.input <- data.sample[, -ncol(data.sample), drop = FALSE]
if (old.num.data != num.sample.fin){
## update the number of data
old.num.data <- num.sample.fin
popu <- generate.popu(method.type = "SLAVE", data.train = data.train, num.var = num.inputvar,
num.labels = num.labels.inp, range.data = range.data.input.norm,
type.mf = 1, name.class = i)
popu.var <- popu$popu.var
comp.rule <- popu$popu.val
ant.rule <- comp.rule[, -ncol(comp.rule), drop = FALSE]
## Genetic Algorithms Procedure
## 1. Representation Individual in binary form
res.popu <- convert.IntToBin(ant.rule, num.labels.inp)
popu.var <- res.popu$popu.var
popu.val <- res.popu$popu.val
popu <- cbind(popu.var, popu.val)
num.popu <- nrow(popu)
}
gen <- 1
init.indv.fit <- -1
while (gen < max.gen && num.popu > 3){
popu.var <- popu[, 1 : num.inputvar, drop = FALSE]
popu.val <- popu[, (num.inputvar + 1) : ncol(popu), drop = FALSE]
## crossover
if (nrow(popu.val) > 3) {
new.popu.val <- GA.crossover(popu.val, persen_cross, type = "VAL", num.inputvar, num.labels)
new.popu.var <- GA.crossover(popu.var, persen_cross, type = "2pt", num.inputvar, num.labels)
new.popu <- cbind(new.popu.var, new.popu.val)
}
## mutation
new.popu <- GA.mutation(new.popu, persen_mutant, type = "IRL-BINARY", num.labels, num.inputvar)
# convert binary into int
new.popu.var <- new.popu[, 1 : num.inputvar ,drop = FALSE]
new.popu.val.bin <- new.popu[, (num.inputvar + 1) : ncol(new.popu) ,drop = FALSE]
new.popu.val.int <- convert.BinToInt(new.popu.val.bin, num.labels.inp)
## convert string to rule form
new.popu.val.int <- scale.StrToRule(new.popu.val.int, num.labels.inp)
## build complete rules
new.popu.val <- cbind(new.popu.val.int, name.class)
## calculate individual fitness
res <- eval.indv.fitness(data.train = data.train, rule = new.popu.val, method.type = "SLAVE", data.sample = data.sample, varinp.mf = varinp.mf,
num.labels = num.labels, popu.var = new.popu.var, k.lower = k.lower, k.upper = k.upper)
## choose the best indv and add into best population
best.indv <- which.max(res)
new.indv.fit <- max(res)
if (new.indv.fit > init.indv.fit) {
## get the best rule(VAL) and VAR
best.comp.rule <- new.popu.val[best.indv, ,drop = FALSE]
best.var <- new.popu.var[best.indv, ,drop = FALSE]
rule.new <- cbind(best.var, best.comp.rule)
init.indv.fit <- new.indv.fit
}
popu <- cbind(new.popu.var, new.popu.val.bin)
gen = gen + 1
}
## adding the rule
best.rule <- rbind(best.rule, rule.new)
## check degree considering with rule.new
VAR.rule.new <- rule.new[, 1 : num.inputvar, drop = FALSE]
VAL.rule.new <- rule.new[, (num.inputvar + 1) : (ncol(rule.new) - 1), drop = FALSE]
## get actual rule (with don't care attributes)
ant.best.rule <- VAR.rule.new * VAL.rule.new
data.sample <- red.data(data.sample, ant.best.rule, epsilon, type = "SLAVE", varinp.mf)
iter = iter + 1
iter.pb = iter.pb + 1
## update the number of data after reducing
num.sample.fin <- nrow(data.sample)
if (num.sample.fin <= 3 || iter >= max.iter){
stop.cr <- TRUE
iter.pb <- i * max.iter
}
## progress bar
setTxtProgressBar(progressbar, iter.pb)
}
## check for fuzzy rule sets for each class
rule <- rbind(rule, best.rule)
}
close(progressbar)
rule <- na.omit(rule)
VAR <- rule[, 1 : num.inputvar, drop = FALSE]
VAL <- rule[, (num.inputvar + 1) : ncol(rule), drop = FALSE]
rule <- VAL * cbind(VAR, 1)
rule.data.num <- unique(rule)
gen.rule.temp <- generate.rule(rule.data.num, num.labels)
rule <- gen.rule.temp$rule
colnames(varinp.mf) <- gen.rule.temp$names.varinput
rule[, ncol(rule)] <- rule.data.num[, ncol(rule.data.num)]
mod <- list(rule = rule, rule.data.num = rule.data.num, varinp.mf = varinp.mf, num.labels = num.labels, range.data.ori = range.data.input, type.model = "FRBCS",
type.mf = "TRIANGLE", type.tnorm = "PRODUCT", type.snorm = "MAX", type.implication.func = "ZADEH")
return(mod)
}
#' This is the internal function that implements genetic lateral tuning and rule selection of linguistic fuzzy systems (GFS.LT.RS).
#' It is used to solve regression tasks.
#' Users do not need to call it directly, but just use \code{\link{frbs.learn}} and \code{\link{predict}}.
#'
#' This method was proposed by R. Alcala et al.
#' GFS.LT.RS implements a evolutionary algorithm for postprocessing in constructing FRBS model.
#' It uses a new rule representation model based on the linguistic 2-tupples representation that allows
#' the lateral displacement of the labels. This function allows two different tuning which are global and local tuning.
#'
#' Regarding with evolutionary algorithms, the following are main components:
#' \itemize{
#' \item coding scheme and initial gene pool;
#' \item chromosome evalution;
#' \item crossover operator;
#' \item restarting approach;
#' \item evolutionary model;
#' }
#' In first time, population is constructed by Wang & Mendel's technique. Mean square error (MSE) is used to
#' calculate chromosome evaluation. This method performs BLX-a in crossover process.
#' Additionally, rule selection method is performed in order to minimize the number of rules.
#'
#' @title GFS.LT.RS model building
#'
#' @param data.train a matrix (\eqn{m \times n}) of normalized data for the training process, where \eqn{m} is the number of instances and
#' \eqn{n} is the number of variables; the last column is the output variable. Note the data must be normalized between 0 and 1.
#' @param popu.size the size of the population which is generated in each generation.
#' @param range.data a matrix representing interval of data.
#' @param num.labels a matrix representing the number of linguistic terms in each variables.
#' @param persen_mutant a real number between 0 and 1 determining the probability of mutation.
#' @param max.gen the maximal number of generations of the genetic algorithm.
#' @param mode.tuning a type of tuning which are \code{"LOCAL"} or \code{"GLOBAL"}.
#' @param type.tnorm a type of t-norm. See \code{\link{inference}}.
#' @param type.snorm a type of s-norm. See \code{\link{inference}}.
#' @param type.implication.func a type of implication function. See \code{\link{WM}}.
#' @param type.defuz a type of defuzzification methods. See \code{\link{defuzzifier}}.
#' @param rule.selection a boolean value representing whether performs rule selection or not.
#' @param range.data.ori a matrix containing the ranges of the original data.
#' @seealso \code{\link{GFS.LT.RS.test}}, \code{\link{frbs.learn}}, and \code{\link{predict}}
# @return list of the model data. please have a look at \code{\link{frbs.learn}} for looking complete components.
#' @references
#' R. Alcala, J. Alcala-Fdez, and F. Herrera, "A proposal for the genetic lateral tuning of linguistic fuzzy systems and its interaction with
#' rule selection", IEEE Trans. on Fuzzy Systems, Vol. 15, No. 4, pp. 616 - 635 (2007).
# @export
GFS.LT.RS <- function(data.train, popu.size = 10, range.data, num.labels, persen_mutant, max.gen = 10, mode.tuning = "GLOBAL",
type.tnorm = "MIN", type.snorm = "MAX", type.implication.func = "ZADEH", type.defuz = "WAM", rule.selection = FALSE, range.data.ori) {
## create progress bar
progressbar <- txtProgressBar(min = 0, max = max.gen, style = 3)
## make testing data from training data
data.test <- data.train[, 1 : (ncol(data.train) - 1), drop = FALSE]
real.val <- data.train[, ncol(data.train), drop = FALSE]
## generate initial rules and membership function from Wang & Mendel's method
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection, type.tnorm = type.tnorm,
type.implication.func = type.implication.func)
res <- generate.popu(method.type = "GFS.LT.RS", data.train = data.train, range.data = range.data,
num.labels = num.labels, popu.size = popu.size, params = params)
var.mf <- res$var.mf
popu <- res$popu
num.rule <- res$num.rule
rule.data.num <- res$rule.data.num
init.popu <- popu
## iteration of GA
gen = 1
init.err <- 100000
err <- matrix(nrow = popu.size + 1, ncol = 1)
L <- 0
while (gen <= max.gen){
## Calculate fitness
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection)
indv.fit <- eval.indv.fitness(data.train = data.train, rule = rule.data.num, method.type = "GFS.LT.RS", varinp.mf = var.mf,
num.labels = num.labels, popu.var = popu, params = params)
min.err <- min(indv.fit[, 1])
if (min.err < init.err) {
indx.best.indv <- which.min(indv.fit[, 1])
best.indv <- popu[indx.best.indv, , drop = FALSE]
init.err <- min.err
L <- 1
}
## sort population according to individual fitness
temp.popu <- cbind(popu, indv.fit)
temp.popu <- temp.popu[order(temp.popu[, ncol(temp.popu)]), ]
popu.parent <- temp.popu[1:2, -ncol(temp.popu), drop = FALSE]
## perform crossover
params <- list(mode.tuning = mode.tuning, rule.selection = rule.selection, num.rule = num.rule)
new.popu <- GA.crossover(population = popu.parent, persen_cross = 1, type = "2tupple", params = params)
## perform mutation for rule selection only
popu.rs <- new.popu[, (ncol(new.popu) - num.rule + 1) : ncol(new.popu), drop = FALSE]
new.popu.rs <- GA.mutation(population = popu.rs, persen_mutant = persen_mutant, type = "BINARY")
new.popu[, (ncol(new.popu) - num.rule + 1) : ncol(new.popu)] <- new.popu.rs
## calculate individual fitness
params$mode.tuning <- mode.tuning
params$rule.selection <- rule.selection
new.indv.fit <- eval.indv.fitness(data.train = data.train, rule = rule.data.num, method.type = "GFS.LT.RS", varinp.mf = var.mf,
num.labels = num.labels, popu.var = new.popu, params = params)
## sort new individual
temp.new.popu <- cbind(new.popu, new.indv.fit)
temp.new.popu <- temp.new.popu[order(temp.new.popu[, ncol(temp.new.popu)]), ]
## add new individual into population
if (temp.popu[(nrow(temp.popu) - 1), ncol(temp.popu)] >= temp.new.popu[2, ncol(temp.new.popu)]){
temp.popu[(nrow(temp.popu) - 1), ] <- temp.new.popu[1, ]
temp.popu[nrow(temp.popu), ] <- temp.new.popu[2, ]
}
## update population
popu <- temp.popu[, -ncol(temp.popu)]
gen = gen + 1
L = L + 1
if (L > (1/3 * max.gen)){
popu <- init.popu
}
## progress bar
setTxtProgressBar(progressbar, gen)
}
close(progressbar)
if (rule.selection == TRUE){
rule.data.num <- check.active.rule(rule.data.num, num.rule, best.indv)
} else {
rule.data.num <- rule.data.num
}
params$popu <- best.indv
params$var.mf <- var.mf
params$num.rule <- num.rule
params$mode.tuning <- mode.tuning
params$rule.selection <- rule.selection
res.tune <- tune.MF(method.type = "GFS.LT.RS", params = params)
var.mf <- res.tune$var.mf
var.mf.tune <- res.tune$var.mf.tune
rule <- generate.rule(rule.data.num, num.labels)$rule
varinp.mf <- var.mf[, 1 : (ncol(var.mf) - num.labels[1, ncol(num.labels)]), drop = FALSE]
varout.mf <- var.mf[, (ncol(varinp.mf) + 1) : ncol(var.mf), drop = FALSE]
mod <- list(rule = rule, rule.data.num = rule.data.num, var.mf = var.mf, varinp.mf = varinp.mf, varout.mf = varout.mf, var.mf.tune = var.mf.tune, num.labels = num.labels,
mode.tuning = mode.tuning, rule.selection = rule.selection, range.data.ori = range.data.ori,
type.defuz = type.defuz, type.tnorm = type.tnorm, type.snorm = type.snorm, type.mf = "TRIANGLE",
type.implication.func = type.implication.func, type.model = "2TUPPLE")
return(mod)
}
Try the frbs package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.