Sección I. 25%

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías.

Los indicadores a considerar son*: el índice de alfabetización (alfabet)[+], el incremento de la población (inc_pob)[+], la esperanza de vida femenina (espvidaf)[+], la mortalidad infantil (mortinf)[-], el número promedio de hijos por mujer (fertilid)[+], la tasa de natalidad (tasa_nat)[+], el logaritmo del PIB (log_pib)[+], la población urbana (urbana)[+] y la tasa de mortalidad (tasa_mor)[-].

Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador.

Todas las varibles se encuentran el archivo data_parcial_2_B.Rdata

Todas los indicadores se encuentran el archivo data_parcial_2_B.Rdata

Usando Análisis Factorial determine cuántos factores deberían retenerse.

¿Qué variables quedan representadas en cada factor?

Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

load("C:/Users/50379/Desktop/practica parcial B 2021/data_parcial_2_B_rev.RData")

library(dplyr)

library(tidyr)
norm_directa<-function(x){(x-min(x))/(max(x)-min(x))}
norm_inversa<-function(x){(max(x)-x)/(max(x)-min(x))}

## Eliminando valores nulos

data_parcial_2%>% replace_na(list(ALFABET=0,INC_POB=0,ESPVIDAF=0,FERTILID=0,TASA_NAT=0,LOG_PIB=0,URBANA=0,MORTINF=0,TASA_MOR=0))->data_parcial_2 

## Seleccionando variables con correlación positiva con desarrollo de economias 
data_parcial_2%>% 
  dplyr::select(ALFABET,INC_POB,ESPVIDAF,FERTILID,TASA_NAT,LOG_PIB,URBANA) %>% 
  apply(MARGIN = 2,FUN = norm_directa) %>% as.data.frame()->var_corr_positiva

## Seleccionando variables con correlación negativa con desarrollo de economias
data_parcial_2 %>% 
  dplyr::select(MORTINF,TASA_MOR) %>% 
  apply(MARGIN = 2,FUN = norm_inversa) %>% as.data.frame()->var_corr_negativa 

## Juntando y reordenando las variables

var_corr_positiva %>% 
  bind_cols(var_corr_negativa) %>% 
  dplyr::select(ALFABET,INC_POB,ESPVIDAF,FERTILID,TASA_NAT,LOG_PIB,URBANA,MORTINF,TASA_MOR)->data_p2_normalizados
head(data_p2_normalizados)

##   ALFABET   INC_POB   ESPVIDAF  FERTILID   TASA_NAT    LOG_PIB URBANA   MORTINF
## 1    0.98 0.3068592 0.82051282 0.3418803 0.30232558 0.60885423   0.54 0.8109756
## 2    0.29 0.5595668 0.02564103 0.8424908 1.00000000 0.09867408   0.18 0.0000000
## 3    0.99 0.1191336 0.92307692 0.1794872 0.02325581 0.94458420   0.85 0.9847561
## 4    0.62 0.6317690 0.69230769 0.8144078 0.65116279 0.76022519   0.77 0.7073171
## 5    0.95 0.2888087 0.82051282 0.3418803 0.23255814 0.63309802   0.86 0.8682927
## 6    0.98 0.3068592 0.82051282 0.3894994 0.30232558 0.70597624   0.68 0.8597561
##     TASA_MOR
## 1 0.70833333
## 2 0.08333333
## 3 0.54166667
## 4 0.75000000
## 5 0.62500000
## 6 0.75000000

## Matriz de correlación
library(PerformanceAnalytics)

chart.Correlation(as.matrix(data_p2_normalizados),histogram = TRUE,pch=12)

library(psych)
options(scipen = 99999)
Barlett<-cortest.bartlett(data_p2_normalizados)

#KMO
library(rela)
KMO<-paf(as.matrix(data_p2_normalizados))$KMO
print(KMO)

## [1] 0.85275

print(Barlett)

## $chisq
## [1] 1478.1
## 
## $p.value
## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000017846
## 
## $df
## [1] 36

Se tiene que puede procederse al análisis factorial porque existe multicolinealidad en los valores de la matriz de información

ANALISIS FACTORIAL

library(FactoMineR)
library(factoextra)

library(kableExtra)

Rx<-cor(data_p2_normalizados)
PC<-princomp(x = data_p2_normalizados,cor = TRUE,fix_sign = FALSE)
variables_pca<-get_pca_var(PC)
factoextra::get_eig(PC) %>% kable(caption="Resumen PCA",
        align = "c",
        digits = 2) %>% 
  kable_material_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("hover"))

Resumen PCA
	eigenvalue	variance.percent	cumulative.variance.percent
Dim.1	6.45	71.63	71.63
Dim.2	1.24	13.81	85.44
Dim.3	0.56	6.18	91.62
Dim.4	0.39	4.36	95.98
Dim.5	0.18	2.01	97.99
Dim.6	0.08	0.86	98.85
Dim.7	0.06	0.64	99.49
Dim.8	0.03	0.32	99.81
Dim.9	0.02	0.19	100.00

fviz_eig(PC,
         choice = "eigenvalue",
         barcolor = "red",
         barfill = "purple",
         addlabels = TRUE, 
       )+labs(title = "Gráfico de Sedimentación",subtitle = "Usando princomp, con Autovalores")+
  xlab(label = "Componentes")+
  ylab(label = "Autovalores")+geom_hline(yintercept = 1)

## En el criterio del autovalor mayor que 1, en el criterio que están por encima del turning point y en que ambos explican más del 70% de la varianza acumulada, se extraen los primeros 2 componentes.

1.2) ¿Qué variables quedan representadas en cada factor?

library(corrplot)

#Modelo de 2 Factores (Rotada)
numero_de_factores<-2
modelo_2_factores<-principal(r = Rx,
                             nfactors = numero_de_factores,
                             covar = FALSE,
                             rotate = "varimax")
print(modelo_2_factores)

## Principal Components Analysis
## Call: principal(r = Rx, nfactors = numero_de_factores, rotate = "varimax", 
##     covar = FALSE)
## Standardized loadings (pattern matrix) based upon correlation matrix
##            RC1   RC2   h2    u2 com
## ALFABET   0.70  0.51 0.74 0.260 1.8
## INC_POB  -0.98  0.04 0.96 0.041 1.0
## ESPVIDAF  0.62  0.76 0.95 0.048 1.9
## FERTILID -0.87 -0.40 0.91 0.091 1.4
## TASA_NAT -0.90 -0.40 0.96 0.036 1.4
## LOG_PIB   0.62  0.59 0.73 0.270 2.0
## URBANA    0.39  0.71 0.66 0.342 1.6
## MORTINF   0.65  0.71 0.92 0.075 2.0
## TASA_MOR -0.03  0.92 0.85 0.148 1.0
## 
##                        RC1  RC2
## SS loadings           4.35 3.34
## Proportion Var        0.48 0.37
## Cumulative Var        0.48 0.85
## Proportion Explained  0.57 0.43
## Cumulative Proportion 0.57 1.00
## 
## Mean item complexity =  1.6
## Test of the hypothesis that 2 components are sufficient.
## 
## The root mean square of the residuals (RMSR) is  0.05 
## 
## Fit based upon off diagonal values = 0.99

#Gráfico de aglomeración de las variables en los factores

correlaciones_modelo<-variables_pca$coord
rotacion<-varimax(correlaciones_modelo[,1:numero_de_factores])
correlaciones_modelo_rotada<-rotacion$loadings

corrplot(correlaciones_modelo_rotada[,1:numero_de_factores],
         is.corr = FALSE,
         method = "circle",
         addCoef.col="black",
         number.cex = 0.75)

En el factor 1 quedan representadas ALFABET, INC_POB, FERTILID, TASA_NAT Y LOG_PIB En el factor 2 quedan representadas ESPVIDAF, URBANA, MORTINF Y TASA_MOR

##1.3) Determine que pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

# Cargas de cada dimensión
library(kableExtra)
cargas<-rotacion$loadings[1:6,1:numero_de_factores]
ponderadores<-prop.table(apply(cargas^2,MARGIN = 2,sum))
t(ponderadores) %>% kable(caption="Ponderadores de los Factores Extraídos",
        align = "c",
        digits = 2) %>% 
  kable_material_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Ponderadores de los Factores Extraídos
Dim.1	Dim.2
0.72	0.28

# Contribuciones

contribuciones<-apply(cargas^2,MARGIN = 2,prop.table)
contribuciones %>% kable(caption="Contribución de las variables en los Factores",
        align = "c",
        digits = 2) %>% 
  kable_material_dark(html_font = "sans-serif") %>% 
  kable_styling(bootstrap_options = c("striped", "hover"))

Contribución de las variables en los Factores
	Dim.1	Dim.2
ALFABET	0.13	0.17
INC_POB	0.25	0.00
ESPVIDAF	0.10	0.38
FERTILID	0.20	0.11
TASA_NAT	0.21	0.11
LOG_PIB	0.10	0.23

En el factor 1 debe asignarsele peso 0.72 y al factor 2 el peso 0.28. Para ALFABET será al facor 1: 0.13 y al factor 2: 0.17 Para INC_POB serán al F1: 0.25 y F2: 0 Para ESPVIDAF serán al F1: 0.1 y F2: 0.38 Para FERTILID serán al F1: 0.2 y F2: 0.11 Para TASA_NAT serán al F1: 0.2 y F2 0.11 Para LOG_PIB serán al F1: 0.1 y F2: 0.23

SECCION II.

Una empresa se encuentra calculando un Indicador del desempeño de sus líneas de producción, para ello no dispone de información previa, pero hay una importante consultora que posee expertos en el sector donde se ubica la empresa en cuestión.

La consultora, ha han determinado 4 variables que definen adecuadamente el desempeño de las líneas de producción:

X1: Mantenimiento de la línea de producción

X2: Tamaño de planta

X3: Logística (entradas y salidas de insumos y producción)

X4: Capacidad de innovación.

La consultora jerarquizó las variables de la siguiente manera:

Dentro de la consultora hay 3 expertos que propusieron la jerarquía anterior, pero también realizaron un ejercicio de comparación por pares y los resultados fueron los siguientes:

Ejercicio 1 [40%]: Calcule los pesos normalizados, de las variables, usando los métodos de ranking directo, por suma, por reciproco y por ranking exponencial (use p=4)

#SUMA 

library(magrittr)

#Vector de Jerarquías
rj<-c(3,4,2,1)
names(rj)<-c("X1","X2","X3","X4")

#Función para generar los pesos
ponderadores_subjetivos_rank_suma<-function(vector_jerarquias){
  n<-length(vector_jerarquias)
  vector_pesos<-n-vector_jerarquias+1
  list(w_brutos=vector_pesos,w_normalizados=vector_pesos/sum(vector_pesos))
}

#Aplicando la función:
pesos_ranking_suma<-ponderadores_subjetivos_rank_suma(rj)

#Pesos brutos
pesos_ranking_suma$w_brutos

## X1 X2 X3 X4 
##  2  1  3  4

#Pesos normalizados
pesos_ranking_suma$w_normalizados %>% round(digits = 3)

##  X1  X2  X3  X4 
## 0.2 0.1 0.3 0.4

### GRAFICO
#Gráfico de los pesos normalizados
barplot(pesos_ranking_suma$w_normalizados,
        main = "Ponderadores Ranking de Suma",
        ylim = c(0,0.5),col = "darkblue")

## Por reciproco

#Vector de Jerarquías

rj<-c(3,4,2,1)
names(rj)<-c("X1","X2","X3","X4")

#Función para generar los pesos
ponderadores_subjetivos_rank_reciproco<-function(vector_jerarquias){
  vector_pesos<-1/vector_jerarquias
  list(w_brutos=vector_pesos,w_normalizados=vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_reciproco<-ponderadores_subjetivos_rank_reciproco(rj)

#Pesos brutos
pesos_ranking_reciproco$w_brutos

##      X1      X2      X3      X4 
## 0.33333 0.25000 0.50000 1.00000

#Pesos normalizados
pesos_ranking_reciproco$w_normalizados %>% round(digits = 3)

##   X1   X2   X3   X4 
## 0.16 0.12 0.24 0.48

### Grafico

#Gráfico de los pesos normalizados
barplot(pesos_ranking_reciproco$w_normalizados,
        main = "Ponderadores Ranking Recíproco",
        ylim = c(0,0.5),col = "cyan4")

#Vector de Jerarquías
rj<-c(3,4,2,1)
names(rj)<-c("X1","X2","X3","X4")

#Función para generar los pesos
ponderadores_subjetivos_rank_exponencial<-function(vector_jerarquias,p=4){
  n<-length(vector_jerarquias)
  vector_pesos<-(n-vector_jerarquias+1)^p
  list(w_brutos=vector_pesos,w_normalizados=vector_pesos/sum(vector_pesos))
}
#Aplicando la función:
pesos_ranking_exponencial<-ponderadores_subjetivos_rank_exponencial(rj)

#Pesos brutos
pesos_ranking_exponencial$w_brutos

##  X1  X2  X3  X4 
##  16   1  81 256

#Pesos normalizados
pesos_ranking_exponencial$w_normalizados %>% round(digits = 3)

##    X1    X2    X3    X4 
## 0.045 0.003 0.229 0.723

### Grafica

#Gráfico de los pesos normalizados (por default p=4)
barplot(pesos_ranking_exponencial$w_normalizados,
        main = "Ponderadores Ranking Exponencial",
        ylim = c(0,0.8),col = "darkmagenta")

comparación por pares, calcule los pesos normalizados para las variables:

comparación por pares

library(FuzzyAHP)

# Matriz_1
valores_matriz_comparacion_1 = c(1,7,4,5,
                                 NA,1,6,3,
                                 NA,NA,1,2,
                                 NA,NA,NA,1)
matriz_comparacion_1<-matrix(valores_matriz_comparacion_1,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_1<-pairwiseComparisonMatrix(matriz_comparacion_1)
matriz_comparacion_1@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_1)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "4"   "5" 
## [2,] "1/7" "1"   "6"   "3" 
## [3,] "1/4" "1/6" "1"   "2" 
## [4,] "1/5" "1/3" "1/2" "1" 
## 
## Slot "values":
##         [,1]    [,2] [,3] [,4]
## [1,] 1.00000 7.00000  4.0    5
## [2,] 0.14286 1.00000  6.0    3
## [3,] 0.25000 0.16667  1.0    2
## [4,] 0.20000 0.33333  0.5    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

# Cálculo de los pesos:
pesos_normalizados_1 = calculateWeights(matriz_comparacion_1)
show(pesos_normalizados_1)

## An object of class "Weights"
## Slot "weights":
##     w_X1     w_X2     w_X3     w_X4 
## 0.606592 0.223310 0.094748 0.075350

barplot(pesos_normalizados_1@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "cadetblue")

# Matriz_2

valores_matriz_comparacion_2 = c(1,7,6,3,
                                 NA,1,5,2,
                                 NA,NA,1,4,
                                 NA,NA,NA,1)
matriz_comparacion_2<-matrix(valores_matriz_comparacion_2,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_2<-pairwiseComparisonMatrix(matriz_comparacion_2)
matriz_comparacion_2@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_2)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "6"   "3" 
## [2,] "1/7" "1"   "5"   "2" 
## [3,] "1/6" "1/5" "1"   "4" 
## [4,] "1/3" "1/2" "1/4" "1" 
## 
## Slot "values":
##         [,1] [,2] [,3] [,4]
## [1,] 1.00000  7.0 6.00    3
## [2,] 0.14286  1.0 5.00    2
## [3,] 0.16667  0.2 1.00    4
## [4,] 0.33333  0.5 0.25    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

# Cálculo de los pesos:
pesos_normalizados_2 = calculateWeights(matriz_comparacion_2)
show(pesos_normalizados_2)

## An object of class "Weights"
## Slot "weights":
##    w_X1    w_X2    w_X3    w_X4 
## 0.60919 0.19879 0.10987 0.08215

barplot(pesos_normalizados_2@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "yellow")

# Matriz_3
valores_matriz_comparacion_3 = c(1,7,5,4,
                                 NA,1,3,2,
                                 NA,NA,1,6,
                                 NA,NA,NA,1)
matriz_comparacion_3<-matrix(valores_matriz_comparacion_3,
                           nrow = 4, ncol = 4, byrow = TRUE)
matriz_comparacion_3<-pairwiseComparisonMatrix(matriz_comparacion_3)
matriz_comparacion_3@variableNames<-c("X1","X2","X3","X4")
show(matriz_comparacion_3)

## An object of class "PairwiseComparisonMatrix"
## Slot "valuesChar":
##      [,1]  [,2]  [,3]  [,4]
## [1,] "1"   "7"   "5"   "4" 
## [2,] "1/7" "1"   "3"   "2" 
## [3,] "1/5" "1/3" "1"   "6" 
## [4,] "1/4" "1/2" "1/6" "1" 
## 
## Slot "values":
##         [,1]    [,2]    [,3] [,4]
## [1,] 1.00000 7.00000 5.00000    4
## [2,] 0.14286 1.00000 3.00000    2
## [3,] 0.20000 0.33333 1.00000    6
## [4,] 0.25000 0.50000 0.16667    1
## 
## Slot "variableNames":
## [1] "X1" "X2" "X3" "X4"

# Cálculo de los pesos:
pesos_normalizados_3 = calculateWeights(matriz_comparacion_3)
show(pesos_normalizados_3)

## An object of class "Weights"
## Slot "weights":
##    w_X1    w_X2    w_X3    w_X4 
## 0.61676 0.17252 0.14259 0.06812

barplot(pesos_normalizados_3@weights,
        main = "Ponderadores por método comparación de pares",
        ylim = c(0,0.7),col = "pink")

2.1 Asumiendo que la opinión de los 3 expertos es igualmente válida.

library(kableExtra)
ponderacion_expertos <-1/3

pesos_tot<-(pesos_normalizados_1@weights+pesos_normalizados_2@weights+
              pesos_normalizados_3@weights)

promedio_tot<-ponderacion_expertos*pesos_tot
show(promedio_tot)

##     w_X1     w_X2     w_X3     w_X4 
## 0.610848 0.198207 0.115739 0.075207

sum(promedio_tot)

## [1] 1

normalizacion_1<-promedio_tot/sum(promedio_tot)
show(normalizacion_1)

##     w_X1     w_X2     w_X3     w_X4 
## 0.610848 0.198207 0.115739 0.075207

2.2 Si el experto 1 se pondera con 0.25, el experto 2 con 0.35 y el experto 3 con 0.4

ponderacion_expertos_distintas<-(pesos_normalizados_1@weights*0.25)+(pesos_normalizados_2@weights*0.35)+(pesos_normalizados_3@weights*0.4)

show(ponderacion_expertos_distintas)

##     w_X1     w_X2     w_X3     w_X4 
## 0.611569 0.194412 0.119180 0.074838

sum(ponderacion_expertos_distintas)

## [1] 1

normalizacion_2<-ponderacion_expertos_distintas/sum(ponderacion_expertos_distintas)
show(normalizacion_2)

##     w_X1     w_X2     w_X3     w_X4 
## 0.611569 0.194412 0.119180 0.074838

SOLUCION_PARCIAL_B

DEBEE BERENICE PEREZ VIDES

2022-10-25

Sección I. 25%

Se pretende construir un indicador multivariado sintético sobre el Desarrollo en las Economías.

Entre Corchetes aparece la correlación teórica esperada entre la variable compleja y el indicador.

Todas las varibles se encuentran el archivo data_parcial_2_B.Rdata

Todas los indicadores se encuentran el archivo data_parcial_2_B.Rdata

Usando Análisis Factorial determine cuántos factores deberían retenerse.

¿Qué variables quedan representadas en cada factor?

Determine qué pesos deben asignarse a cada factor y a las variables dentro de cada uno de ellos.

Se tiene que puede procederse al análisis factorial porque existe multicolinealidad en los valores de la matriz de información

ANALISIS FACTORIAL

1.2) ¿Qué variables quedan representadas en cada factor?

En el factor 1 quedan representadas ALFABET, INC_POB, FERTILID, TASA_NAT Y LOG_PIB En el factor 2 quedan representadas ESPVIDAF, URBANA, MORTINF Y TASA_MOR

SECCION II.

Una empresa se encuentra calculando un Indicador del desempeño de sus líneas de producción, para ello no dispone de información previa, pero hay una importante consultora que posee expertos en el sector donde se ubica la empresa en cuestión.

La consultora, ha han determinado 4 variables que definen adecuadamente el desempeño de las líneas de producción:

X1: Mantenimiento de la línea de producción

X2: Tamaño de planta

X3: Logística (entradas y salidas de insumos y producción)

X4: Capacidad de innovación.

La consultora jerarquizó las variables de la siguiente manera:

La consultora jerarquizó las variables de la siguiente manera:

Dentro de la consultora hay 3 expertos que propusieron la jerarquía anterior, pero también realizaron un ejercicio de comparación por pares y los resultados fueron los siguientes:

Ejercicio 1 [40%]: Calcule los pesos normalizados, de las variables, usando los métodos de ranking directo, por suma, por reciproco y por ranking exponencial (use p=4)

comparación por pares, calcule los pesos normalizados para las variables:

comparación por pares

2.1 Asumiendo que la opinión de los 3 expertos es igualmente válida.

2.2 Si el experto 1 se pondera con 0.25, el experto 2 con 0.35 y el experto 3 con 0.4