## Funcions d'agregació en R (R-project) i implementació de mètodes que resolen 
##   els exemples del capítol 8 del llibre: 
##         Vicenç Torra, Yasuo Narukawa (2007) 
##              Modelització de decisions: fusió d'informació i operadors d'agregació. 
##              Edicions UAB, ISBN: 978-84-490-2529-7. 
## Aggregation Function in R (R-project) and implementation of methods that solve
##   the examples in Chapter 8 of the book:
##         Vicenç Torra, Yasuo Narukawa (2007) 
##              Modeling Decisions: Information Fusion and Aggregation Operators
##              Springer, ISBN: 978-3-540-68789-4.
## 
## Pàgina web del llibre: http://www.mdai.cat/ifao
## Web page of the book: http://www.mdai.cat/ifao
##
## Aquest fitxer es pot llegir mitjançant "source": 
## This file can be loaded in R with "source": 
##        source("http://www.mdai.cat/ifao/ifao.models.r")
## or
##        source("c:\\path\\path\\ifao.models.r")
## 

## Implementació d'algunes funcions d'agregació en R
## Implementation of some aggregation functions in R

AM <- function (data) { sum(data) / length(data) }
WM <- function (data, weightsVect) { return (data %*% weightsVect) }
OWA <- function (data, weightsVect) { return (sort(data, decreasing=TRUE) %*% weightsVect) }
QWM <- function (data, weightsVect, ff, ffInverse) { return (mapply(ffInverse, (mapply(ff, data) %*% weightsVect))) }

GM <- function (data, weightsVect) { return (QWM (data, weightsVect, function (x) { return(x*x) }, sqrt))}

## Dades de la Taula 8.5 ("ML", "P", "M", "L", "G", "Avaluació subjectiva")
## Data from Table 8.5 ("ML", "P", "M", "L", "G", "Subjective evaluation")

data <- 
rbind(
c(     0.8  ,  0.9  ,  0.8 ,   0.1 ,   0.1, 0.7),
c(     0.7  ,  0.6  ,  0.9 ,   0.2 ,   0.3, 0.6),
c(     0.7  ,  0.7  ,  0.7 ,   0.2 ,   0.6, 0.6),
c(     0.6  ,  0.9  ,  0.9 ,   0.4 ,   0.4, 0.8),
c(     0.8  ,  0.6  ,  0.3 ,   0.9 ,   0.9, 0.8),
c(     0.2  ,  0.4  ,  0.2 ,   0.8 ,   0.1, 0.3),
c(     0.1  ,  0.2  ,  0.4 ,   0.1 ,   0.2, 0.1),
c(     0.3  ,  0.3  ,  0.3 ,   0.8 ,   0.3, 0.4),
c(     0.5  ,  0.2  ,  0.1 ,   0.2 ,   0.1, 0.3),
c(     0.8  ,  0.2  ,  0.2 ,   0.5 ,   0.1, 0.5))

## Construcció de models segons la secció 8.3
## 8.3 Extracció de paràmetres a partir d'exemples: resultats esperats
## Construction of models according to Section 8.3
## 8.3 Extracting Parameters from Examples: Expected Outcome

## La construcció de models es basa en el paquet kappalab
##    http://cran.r-project.org/web/packages/kappalab/index.html
## Models are built using the package kappalab
##    http://cran.r-project.org/web/packages/kappalab/index.html
library(kappalab)

solveWM <- function (data) {
   numOfSubjects <- ncol(data)-1
   columnSE <- (numOfSubjects+1)
   kAdditive <- 1
   solucio <- least.squares.capa.ident(numOfSubjects,kAdditive,data[,1:numOfSubjects],data[,columnSE:columnSE])
}

solveOWA <- function (data) {
  novaData <- rbind(c(sort(data[1,1:ncol(data)-1], decreasing=TRUE), data[1,ncol(data)]))
  for (i in 2:nrow(data)) {
    novaData <- rbind(novaData, c(sort(data[i,1:ncol(data)-1], decreasing=TRUE), data[i,ncol(data)]))
  }
  solveWM (novaData)
}

solveCI <- function (data) {
   numOfSubjects <- ncol(data)-1
   columnSE <- (numOfSubjects+1)
   kAdditive <- numOfSubjects
   solucio <- least.squares.capa.ident(numOfSubjects,kAdditive,data[,1:numOfSubjects],data[,columnSE:columnSE])
}

solveCIkAdd <- function (data, kAdditive) {
   numOfSubjects <- ncol(data)-1
   columnSE <- (numOfSubjects+1)
   solucio <- least.squares.capa.ident(numOfSubjects,kAdditive,data[,1:numOfSubjects],data[,columnSE:columnSE])
}

## Solució de l'exemple 8.6
## Solution of Example 8.6
resultWM <-solveWM(data)

## Solució de l'exemple 8.12
## Solution of Example 8.12
resultOWA <-solveOWA(data)

## Solució de l'exemple 8.14
##   La implementació de kappaLab no permet calcular aquesta solució. 
##   S'inclou la crida només per il·lustrar com es faria la crida
## Solution of Example 8.14 
##   The implementation given in kappaLab does not permit us to compute this solution. 
##   We include the call for completeness
## resultCI <-solveCI(data)

## Exemple no inclòs en el text, correspon al problema descrit a la pàgina 267: 
##    Aprenentatge de mesures difuses restringides
##    Mesures difuses additives d'ordre k: en aquest cas k=3
## Example not included in the text. It corresponds to the problem described in page 240:
##    Learning constrained fuzzy measures
##    k-order additive fuzzy measures: in this case k=3
resultCIkAdd <-solveCIkAdd(data, 3)

## Funció que reordena una taula per tal de poder aprendre els pesos de l'OWA. 
##    Permet calcular la taula 8.7 a partir de la taula 8.5 (vegeu l'exemple 8.12)
## Function that permits us to reorder a table to learn OWA weights
##    It permits us to compute Table 8.7 from Table 8.5 (see Example 8.12)

# prepareDataOWA(data)
prepareDataOWA <- function (data) {
  novaData <- rbind(c(sort(data[1,1:ncol(data)-1], decreasing=TRUE), data[1,ncol(data)]))
  for (i in 2:nrow(data)) {
    novaData <- rbind(novaData, c(sort(data[i,1:ncol(data)-1], decreasing=TRUE), data[i,ncol(data)]))
  }
  return(novaData)
}