Métodos subjetivos de ponderación
MSF. Ademir Pérez
Docente de la Facultad de Ciencias Económicas de la Universidad de El Salvador
Implementación de Funciones para los Métodos de ponderación por Jerarquía
# Definir una función para calcular ponderadores subjetivos utilizando el método de ranking suma
ponderadores_subjetivos_rank_suma <- function(vector_jerarquias) {
n <- length(vector_jerarquias)
# Calcular pesos brutos sumando de la jerarquía
vector_pesos <- n - vector_jerarquias + 1
# Normalizar los pesos dividiendo por la suma total de los pesos
list(w_brutos = vector_pesos,
w_normalizados = prop.table(vector_pesos))
}
# Definir una función para calcular ponderadores subjetivos utilizando el método de ranking recíproco
ponderadores_subjetivos_rank_reciproco <- function(vector_jerarquias) {
# Calcular pesos brutos tomando el inverso de la jerarquía
vector_pesos <- 1 / vector_jerarquias
# Normalizar los pesos dividiendo por la suma total de los pesos
list(w_brutos = vector_pesos,
w_normalizados = prop.table(vector_pesos))
}
# Definir una función para calcular ponderadores subjetivos utilizando el método de ranking exponencial
ponderadores_subjetivos_rank_exponencial <- function(vector_jerarquias, p = 2) {
n <- length(vector_jerarquias)
# Calcular pesos brutos elevando a la potencia "p" los valores de la jerarquía de suma
vector_pesos <- (n - vector_jerarquias + 1) ^ p
# Normalizar los pesos dividiendo por la suma total de los pesos
list(w_brutos = vector_pesos,
w_normalizados = prop.table(vector_pesos))
}Métodos básados en el ranking
Se fundamentan en la asignación de jerarquía en las variables, esto con base en el criterio del investigador, fundamentado lo mejor que se pueda en evidencias lógicas de la teoría o de la experiencia derivada de otras investigaciones similares.
library(dplyr)
library(gt)
library(gtExtras)
#Vector de Jerarquías
rj<-c(4,2,5,1,3)
names(rj)<-c("X1","X2","X3","X4","X5")
tabla<-data.frame(variables=paste0("x",1:5),jerarquia=rj,
Ws=ponderadores_subjetivos_rank_suma(rj)$w_brutos,
Wns=round(ponderadores_subjetivos_rank_suma(rj)$w_normalizados,3),
Wr=round(ponderadores_subjetivos_rank_reciproco(rj)$w_brutos,3),
Wnr=round(ponderadores_subjetivos_rank_reciproco(rj)$w_normalizados,3),
We=ponderadores_subjetivos_rank_exponencial(rj)$w_brutos,
Wne=round(ponderadores_subjetivos_rank_exponencial(rj)$w_normalizados,3)) %>% as_tibble()
#Tabla
tabla<-as_tibble(tabla)
tabla %>% gt(rowname_col = "variables") %>%
tab_header(title = md("**Métodos de ponderación por Jerarquía (Malczewski 1999**)")) %>%
tab_stubhead(label = "Variables") %>%
tab_spanner(label = md("**Ranking Suma**"),
columns = c(Ws,Wns)) %>%
tab_spanner(label = md("**Ranking Recíproco**"),
columns = c(Wr,Wnr)) %>%
tab_spanner(label = md("**Ranking Exponencial**"),
columns = c(We,Wne)) %>%
cols_label(Ws=html("w<sub>bruto</sub><br>n-r<sub>j</sub>+1</br>"),
Wns=html("W<sub>normalizado"),
Wr=html("w<sub>bruto</sub><br>1/r<sub>j</sub></br>"),
Wnr=html("W<sub>normalizado"),
We=html("w<sub>bruto</sub><br>(n-r<sub>j</sub>+1)<sup> p </sup></br>"),
Wne=html("W<sub>normalizado")) %>%
grand_summary_rows(
fns = list(label = "Total", id = "totals", fn = "sum"),
fmt = ~ fmt_number(.,decimals = 3),
side = "bottom"
) %>%
cols_align(
align = "center",
columns = everything()
) %>%
tab_style(
style = cell_text(
size = "smaller",
weight = "bold",
transform = "uppercase",align = "center"
),
locations = cells_stub()
) | Métodos de ponderación por Jerarquía (Malczewski 1999) | |||||||
| Variables | jerarquia | Ranking Suma | Ranking Recíproco | Ranking Exponencial | |||
|---|---|---|---|---|---|---|---|
| wbruto n-rj+1 |
Wnormalizado | wbruto 1/rj |
Wnormalizado | wbruto (n-rj+1) p |
Wnormalizado | ||
| x1 | 4 | 2 | 0.133 | 0.250 | 0.109 | 4 | 0.073 |
| x2 | 2 | 4 | 0.267 | 0.500 | 0.219 | 16 | 0.291 |
| x3 | 5 | 1 | 0.067 | 0.200 | 0.088 | 1 | 0.018 |
| x4 | 1 | 5 | 0.333 | 1.000 | 0.438 | 25 | 0.455 |
| x5 | 3 | 3 | 0.200 | 0.333 | 0.146 | 9 | 0.164 |
| Total | 15.000 | 15.000 | 1.000 | 2.283 | 1.000 | 55.000 | 1.001 |
1. Jerarquía de Suma
Supongase que hay 5 variables: X1, X2,X3,X4,X5 y se asígna el siguiente ranking:
| Variables | X1 | X2 | X3 | X4 | X5 |
|---|---|---|---|---|---|
| Ranking (Jerarquía) | 4 | 2 | 5 | 1 | 3 |
El peso (bruto) se asigna mediante la expresión: \[w_{j}=n-r_j+1 \] y los pesos normalizados mediante: \[ \bar{w}_j=\frac{w_j}{\sum{w_j}}\]
library(magrittr)
#Vector de Jerarquías
rj<-c(4,2,5,1,3)
names(rj)<-c("X1","X2","X3","X4","X5")
#Aplicando la función:
pesos_ranking_suma<-ponderadores_subjetivos_rank_suma(rj)
#Pesos brutos
pesos_ranking_suma$w_brutos## X1 X2 X3 X4 X5
## 2 4 1 5 3## X1 X2 X3 X4 X5
## 0.133 0.267 0.067 0.333 0.200#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma$w_normalizados,
main = "Ponderadores Ranking de Suma",
ylim = c(0,0.5),col = "red")
2. Jerarquía Reciproca
El peso (bruto) se asigna mediante la expresión: \[w_{j}=1/r_j\] y los pesos normalizados mediante: \[ \bar{w}_j=\frac{w_j}{\sum{w_j}}\]
library(magrittr)
#Vector de Jerarquías
rj<-c(4,2,5,1,3)
names(rj)<-c("X1","X2","X3","X4","X5")
#Aplicando la función:
pesos_ranking_reciproco<-ponderadores_subjetivos_rank_reciproco(rj)
#Pesos brutos
pesos_ranking_reciproco$w_brutos## X1 X2 X3 X4 X5
## 0.2500000 0.5000000 0.2000000 1.0000000 0.3333333## X1 X2 X3 X4 X5
## 0.109 0.219 0.088 0.438 0.146#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco$w_normalizados,
main = "Ponderadores Ranking Recíproco",
ylim = c(0,0.5),col = "green")
3. Jerarquía Exponencial
El peso (bruto) se asigna mediante la expresión: \[w_{j}=(n-r_j+1)^p \] y los pesos normalizados mediante: \[ \bar{w}_j=\frac{w_j}{\sum{w_j}}\]
library(magrittr)
#Vector de Jerarquías
rj<-c(4,2,5,1,3)
names(rj)<-c("X1","X2","X3","X4","X5")
#Aplicando la función:
pesos_ranking_exponencial<-ponderadores_subjetivos_rank_exponencial(rj)
#Pesos brutos
pesos_ranking_exponencial$w_brutos## X1 X2 X3 X4 X5
## 4 16 1 25 9## X1 X2 X3 X4 X5
## 0.073 0.291 0.018 0.455 0.164#Gráfico de los pesos normalizados (por default p=2)
barplot(pesos_ranking_suma$w_normalizados,
main = "Ponderadores Ranking Exponencial",
ylim = c(0,0.5),col = "blue")
#Comparación de valores de "p"
par(mfrow=c(1,3))
for(p in 2:4){
pesos<-ponderadores_subjetivos_rank_exponencial(vector_jerarquias = rj,p = p)
barplot(pesos$w_normalizados,main = paste0("p=",p),ylim = c(0,0.7),col = "blue",cex.main=3,cex.axis = 3)
}
Comparativa de Métodos de ponderación por Jerarquía
# Cargar las bibliotecas necesarias
library(fmsb)
library(dplyr)
# Extraer los pesos normalizados de diferentes rankings
pesos1 <- pesos_ranking_suma$w_normalizados
pesos2 <- pesos_ranking_reciproco$w_normalizados
pesos3 <- pesos_ranking_exponencial$w_normalizados
# Crear una tabla de pesos combinando los resultados de diferentes rankings
tabla_pesos <-
rep(.5, 5) %>% # Inicializar la primera fila con pesos iguales
rbind(rep(0, 5)) %>% # Agregar una fila de ceros para espacio visual
rbind(pesos1) %>% # Agregar pesos normalizados del primer ranking
rbind(pesos2) %>% # Agregar pesos normalizados del segundo ranking
rbind(pesos3) %>% # Agregar pesos normalizados del tercer ranking
as.data.frame() # Convertir la matriz resultante en un data frame
# Crear un gráfico de radar (radar chart) utilizando la biblioteca fmsb
radarchart(
df = tabla_pesos,
# Utilizar la tabla de pesos como datos
title = "Métodos de ponderación por Jerarquía (Malczewski 1999)",
# Título del gráfico
cglty = 2,
# Tipo de línea para las guías circulares
cglcol = "gray",
# Color de las guías circulares
pcol = 2:4 # Colores de los polígonos para cada conjunto de datos
)
# Agregar una leyenda al gráfico
legend(
"topright",
# Posición de la leyenda en la esquina superior derecha
legend = c("Ranking Suma", # Etiquetas de leyenda
"Ranking Reciproco",
"Ranking Exponencial"),
bty = "n",
# Eliminar el recuadro alrededor de la leyenda
pch = 20,
# Tipo de punto en la leyenda
col = 2:4,
# Colores correspondientes a los conjuntos de datos
text.col = "grey25",
# Color del texto en la leyenda
pt.cex = 2
) # Tamaño de los puntos en la leyenda
4. Ponderación por comparación de Pares
En este caso la obtención de los pesos se logrará asignando importancia relativa a pares de variables, para el ejemplo se utilizarán 3 variables price, slope y view.
referencia del paquete “FuzzyAHP”
library(FuzzyAHP)
valores_matriz_comparacion = c(1,4,7,
NA,1,5,
NA,NA,1)
matriz_comparacion<-matrix(valores_matriz_comparacion,
nrow = 3, ncol = 3, byrow = TRUE)
matriz_comparacion<-pairwiseComparisonMatrix(matriz_comparacion)
matriz_comparacion@variableNames<-c("price","slope","view")
show(matriz_comparacion)## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
## [,1] [,2] [,3]
## [1,] "1" "4" "7"
## [2,] "1/4" "1" "5"
## [3,] "1/7" "1/5" "1"
##
## Slot "values":
## [,1] [,2] [,3]
## [1,] 1.0000000 4.0 7
## [2,] 0.2500000 1.0 5
## [3,] 0.1428571 0.2 1
##
## Slot "variableNames":
## [1] "price" "slope" "view"# Cálculo de los pesos:
pesos_normalizados = calculateWeights(matriz_comparacion)
show(pesos_normalizados)## An object of class "Weights"
## Slot "weights":
## w_price w_slope w_view
## 0.68708616 0.24374097 0.06917288barplot(pesos_normalizados@weights,
main = "Ponderadores por comparación de pares",
ylim = c(0,0.7),col = "blue")