Ejercicios que se entregan impresos debido a que son ejercicios esencialmente desarrollados en R.

Ejercicio sobre ACP

Punto 5 del libro

Sea X un vector aleatorio con matriz de varianza–covarianza dada por:

\[ \begin{pmatrix} 2& 0& 0\\ 0& 4& 0\\ 0& 0& 4\\ \end{pmatrix} \] Determine las componentes principales Y1, Y2 y Y3 a partir de \(\sigma\). ¿Que se concluye de este caso?

Se crea la matriz S

#Se crea la matriz S
S4<-matrix(c(2,0,0,0,4,0,0,0,4),nrow=3,ncol=3)
S4
##      [,1] [,2] [,3]
## [1,]    2    0    0
## [2,]    0    4    0
## [3,]    0    0    4

Valores propios de S

vp4<-eigen(S4)$values
vp4
## [1] 4 4 2
barplot(vp4,col='lightblue',ylim=c(0,7),main='valores propios')

Varianza total

#Varianza total
VT4<-sum(diag(S4))
VT4
## [1] 10

Porcentajes de variabilidad total retenidas por X1, X2,X3Esto conforme a la mtriz de varianza y covarianzas muestral.

pvr4<-(c(diag(S4)/VT4))*100
pvr4
## [1] 20 40 40

Vectores propios que generaran las componentes principales

vectores4<-eigen(S4)$vectors
vectores4
##      [,1] [,2] [,3]
## [1,]    0    0    1
## [2,]    0    1    0
## [3,]    1    0    0

Definición de las componentes

De acuerdo a los vectores propios asociados a los valores propios obtenidos, las componentes quedan definidas de la sdiguiente manera, donde en este caso las variables \(X_1\) y \(X_2\) corresponderán a las variables centradas:(A las componentes las llamaremos \(Y_1,Y_2\)):

\[ Y_1=0(X_1)+0(X_2)+X_3=X_3 \]

\[ Y_2=0(X_1)+X_2+0(X_3)=X_2 \] \[ Y_3=X_1+0(X_2)+0(X_3)=X_1 \]

Porcentaje Varianza retenida por cada componente corresponde a:

VR4<-round(c(vp4/VT4)*100,2)
VR4
## [1] 40 40 20

Se obtienen las mismas variables con el mismo porcentaje de varianza retenida dado que \(X_1,X_2,X_3\) son variables independientes, es decir que en este caso no tienen sentido aplicar la metolodía de ACP.

Ejercicio sobre Análisis factorial

Punto 3 del libro

Los datos que se encuentran en el archivo pizzazz.txt, corresponden a las respuestas dadas a una encuesta aplicada a 975 empleados de una cadena nacional de restaurantes en Estados Unidos. En el estudio se registró un total de 144 variables. Mediante el método de la componente principal con una rotación varimax, para determinar si existe un conjunto de caracterı́sticas subyacentes que resuma la información contenida en las variables relativas al compromiso con la organización (preguntas 1 a 15)

A continuación se cargan los datos

library(psych)
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
data = read.delim("C:/Users/Lenovo/Desktop/Análisis_factorial/PIZZAZZ.TXT", sep= " ")

Se inspecciona la matriz de correlaciones

X = na.omit(data[,1:15])
S = cov(X)
R = cov2cor(S)
round(R,2)
##          COMMIT1 COMMIT2 COMMIT3 COMMIT4 COMMIT5 COMMIT6 COMMIT7 COMMIT8
## COMMIT1     1.00    0.25   -0.08    0.17    0.21    0.26   -0.03    0.23
## COMMIT2     0.25    1.00   -0.25    0.35    0.42    0.61   -0.20    0.49
## COMMIT3    -0.08   -0.25    1.00   -0.08   -0.13   -0.20    0.26   -0.13
## COMMIT4     0.17    0.35   -0.08    1.00    0.34    0.42   -0.10    0.39
## COMMIT5     0.21    0.42   -0.13    0.34    1.00    0.49   -0.09    0.40
## COMMIT6     0.26    0.61   -0.20    0.42    0.49    1.00   -0.13    0.51
## COMMIT7    -0.03   -0.20    0.26   -0.10   -0.09   -0.13    1.00   -0.10
## COMMIT8     0.23    0.49   -0.13    0.39    0.40    0.51   -0.10    1.00
## COMMIT9     0.02   -0.11    0.19   -0.01   -0.11   -0.12    0.17   -0.06
## COMMIT10    0.28    0.52   -0.21    0.26    0.45    0.52   -0.17    0.50
## COMMIT11   -0.11   -0.32    0.31   -0.22   -0.22   -0.30    0.24   -0.28
## COMMIT12   -0.02   -0.31    0.22   -0.14   -0.28   -0.23    0.10   -0.21
## COMMIT13    0.29    0.50   -0.20    0.31    0.39    0.49   -0.25    0.49
## COMMIT14    0.19    0.49   -0.16    0.41    0.38    0.52   -0.17    0.47
## COMMIT15   -0.17   -0.41    0.32   -0.13   -0.24   -0.36    0.25   -0.32
##          COMMIT9 COMMIT10 COMMIT11 COMMIT12 COMMIT13 COMMIT14 COMMIT15
## COMMIT1     0.02     0.28    -0.11    -0.02     0.29     0.19    -0.17
## COMMIT2    -0.11     0.52    -0.32    -0.31     0.50     0.49    -0.41
## COMMIT3     0.19    -0.21     0.31     0.22    -0.20    -0.16     0.32
## COMMIT4    -0.01     0.26    -0.22    -0.14     0.31     0.41    -0.13
## COMMIT5    -0.11     0.45    -0.22    -0.28     0.39     0.38    -0.24
## COMMIT6    -0.12     0.52    -0.30    -0.23     0.49     0.52    -0.36
## COMMIT7     0.17    -0.17     0.24     0.10    -0.25    -0.17     0.25
## COMMIT8    -0.06     0.50    -0.28    -0.21     0.49     0.47    -0.32
## COMMIT9     1.00    -0.14     0.21     0.19    -0.17    -0.10     0.26
## COMMIT10   -0.14     1.00    -0.28    -0.26     0.45     0.47    -0.48
## COMMIT11    0.21    -0.28     1.00     0.34    -0.29    -0.31     0.41
## COMMIT12    0.19    -0.26     0.34     1.00    -0.19    -0.19     0.35
## COMMIT13   -0.17     0.45    -0.29    -0.19     1.00     0.51    -0.38
## COMMIT14   -0.10     0.47    -0.31    -0.19     0.51     1.00    -0.38
## COMMIT15    0.26    -0.48     0.41     0.35    -0.38    -0.38     1.00

Se observa el KMO para determinar si los datos son idoneos para el análisis factorial.

Q <- cov2cor(solve(R))
sumQ2 <- sum(Q^2) - sum(diag(Q))
sumR2 <- sum(R^2) - sum(diag(R))
KMO <- sumR2/(sumR2 + sumQ2)
KMO
## [1] 0.9101442

Un resultado por encima de 0.9 sugiere que los datos son excelentes para la aplicación del análisis factorial. Se analizan los valores propios.

# Valores y vectores propios
eig<-eigen(R)
# Matriz P (vectores propios)
P<-eig$vectors
# valores propios
D<-eig$values;D
##  [1] 5.1667559 1.5754411 0.9935285 0.9109953 0.8496025 0.7631218 0.7147814
##  [8] 0.6831422 0.5673392 0.5448415 0.5269990 0.5199801 0.4295051 0.3924188
## [15] 0.3615478
# proporcion de variabilidad acumulada
cumsum(D)/sum(D)
##  [1] 0.3444504 0.4494798 0.5157150 0.5764481 0.6330882 0.6839630 0.7316151
##  [8] 0.7771579 0.8149805 0.8513033 0.8864366 0.9211019 0.9497356 0.9758968
## [15] 1.0000000

Solamente los dos primeros valores propios se encuentran por encima del promedio. Observar la varianza explicada acumulada sugiere que se requiere una gran cantidad de factores para obtener una proporción suficiente, sin embargo, los valores parecen sugerir un punto de codo. Se observa gráficamente

plot(D, type = "s")

Aunque no se recoge información suficiente con dos factores, añadir más factores no aumenta significativamente la comunalidad. Se realiza el método de componente principal con dos factores.

D12<-sqrt(diag(D))
# ponderaciones factoriales
f<-P[,1:2]%*%D12[1:2,1:2];round(f,3)
##         [,1]   [,2]
##  [1,] -0.366 -0.288
##  [2,] -0.760 -0.090
##  [3,]  0.383 -0.511
##  [4,] -0.518 -0.341
##  [5,] -0.624 -0.210
##  [6,] -0.762 -0.223
##  [7,]  0.322 -0.432
##  [8,] -0.694 -0.276
##  [9,]  0.255 -0.524
## [10,] -0.730 -0.074
## [11,]  0.540 -0.398
## [12,]  0.439 -0.365
## [13,] -0.712 -0.086
## [14,] -0.709 -0.171
## [15,]  0.629 -0.376

Se presentan los dos factores. Para facilitar la interpretación, se realiza rotación varimax

# Rotacion varimax
varimax(f)
## $loadings
## 
## Loadings:
##       [,1]   [,2]  
##  [1,] -0.462       
##  [2,] -0.698  0.313
##  [3,]        -0.635
##  [4,] -0.620       
##  [5,] -0.643  0.140
##  [6,] -0.768  0.200
##  [7,]        -0.536
##  [8,] -0.737  0.119
##  [9,]        -0.581
## [10,] -0.665  0.311
## [11,]  0.259 -0.619
## [12,]  0.189 -0.538
## [13,] -0.655  0.291
## [14,] -0.696  0.217
## [15,]  0.347 -0.645
## 
##                 [,1]  [,2]
## SS loadings    4.221 2.521
## Proportion Var 0.281 0.168
## Cumulative Var 0.281 0.449
## 
## $rotmat
##           [,1]       [,2]
## [1,] 0.8583238 -0.5131084
## [2,] 0.5131084  0.8583238

Para nombrar los factores, es necesario conocer el significado de cada una de las quince variables y validar el resultado de la rotación con los expertos en el área. Se observa la relación entre la comunalidad y la especificidad

# Comunalidad
comun<-matrix(rowSums(f^2));comun
##            [,1]
##  [1,] 0.2168682
##  [2,] 0.5854106
##  [3,] 0.4078459
##  [4,] 0.3846534
##  [5,] 0.4332046
##  [6,] 0.6300024
##  [7,] 0.2902843
##  [8,] 0.5575870
##  [9,] 0.3397454
## [10,] 0.5388782
## [11,] 0.4497866
## [12,] 0.3253434
## [13,] 0.5143395
## [14,] 0.5320673
## [15,] 0.5361803
# varianza especifica
1-comun
##            [,1]
##  [1,] 0.7831318
##  [2,] 0.4145894
##  [3,] 0.5921541
##  [4,] 0.6153466
##  [5,] 0.5667954
##  [6,] 0.3699976
##  [7,] 0.7097157
##  [8,] 0.4424130
##  [9,] 0.6602546
## [10,] 0.4611218
## [11,] 0.5502134
## [12,] 0.6746566
## [13,] 0.4856605
## [14,] 0.4679327
## [15,] 0.4638197

Mientras el promedio de la comunalidad es 0.45, el de la especificidad es 0.55. Si bien la especificidad sigue concentrando la mayor parte de la varianza, el modelo es útil en tanto se resumen quince variables en dos factores.

Ejercicio sobre Conglomerados

Punto 5 del libro

Johnson (2000) describe los datos relacionados con un análisis de sustancias nutritivas en pizzas congeladas adquiridas en supermercados. Las variables medidas, por cada 100 gramos de la muestra de la pizza previamente hecha puré, fueron: porcentaje de humedad (MOIS), la cantidad de proteína (PROT), la cantidad de ceniza (ASH), la cantidad de sodio (SODIUM), la cantidad de carbohidratos (CARB), así como las calorías por gramo (CAL). Los datos se encuentran en el archivo pizza.txt que puede descargar de la página web del libro. Seleccione una muestra aleatoria del 20% de los datos (para garantizar siempre la misma muestra use la semilla 341278). De la muestra elimine las filas que no estén completas y estandarice.

# Se cargan los datos
library(readxl)
data<-as.data.frame(read_excel("C:/Users/Lenovo/Desktop/pizza.xlsx"))

# Para garantizar siempre la misma muestra se usa la semilla 341278
set.seed(341278)

# Se selecciona una muestra aleatoria del 20% de los datos
s <- sample(1:nrow(data), size = nrow(data)*0.2)
data2<-data[s,]

# Eliminar las filas que no están completas y estandarizar
data2<-na.omit(data2)
data2_scale<-scale(data2[,c("MOIS","PROT","FAT","ASH","SODIUM","CARB","CAL")], center = T, scale = T)

Parte (a) (a) Con los datos de la muestra desarrolle un análisis por agrupación mediante el método del promedio usando la distancia euclidiana.

#Cálculo de la matriz de distancias euclidianas
dd<-dist(data2_scale,method="euclidean")

#Clasificación método de unión mediante el promedio
cl<-hclust(dd, method="average")
plot(cl,hang = -1, main = "Dendrograma usando el método de unión mediante el promedio")
abline(h=2,lty=2)

Parte (b) (b) A una distancia de dos ¿cuántos agrupamientos se forman?

Respuesta: De acuerdo con el dendrograma de la parte (a) se observa que a una distancia de 2 se forman 5 conglomerados.

Ejercicio sobre Análisis de discriminante

Punto 5 del libro

Los datos del data frame UScereal, disponibles en la librerma MASS de R, describe 65 cereales para el desayuno comznmente disponibles en supermercados de EE.UU., con base en la informacisn disponible en la etiqueta obligatoria en la caja. Las mediciones estan normalizadas a una porcion de una taza estadounidense. Asuma a los fabricantes N, P, Q, R como un solo fabricante, de tal forma que se formen tres grupos. Suponga que se tiene una nueva caja de cereal cuyas mediciones fueron:

calories protein fat sodium
149.41 3.68 1.42 237.84
fibre carbo sugars shelf
3.87 19.97 10.05 2.17 
library(MASS)     
data(UScereal)
UScereal$mfr2<-ifelse(UScereal$mfr %in% c("N","P","Q","R"), "NPQR", ifelse(UScereal$mfr =="G","G","K"))
str(UScereal)
## 'data.frame':    65 obs. of  12 variables:
##  $ mfr      : Factor w/ 6 levels "G","K","N","P",..: 3 2 2 1 2 1 6 4 5 1 ...
##  $ calories : num  212 212 100 147 110 ...
##  $ protein  : num  12.12 12.12 8 2.67 2 ...
##  $ fat      : num  3.03 3.03 0 2.67 0 ...
##  $ sodium   : num  394 788 280 240 125 ...
##  $ fibre    : num  30.3 27.3 28 2 1 ...
##  $ carbo    : num  15.2 21.2 16 14 11 ...
##  $ sugars   : num  18.2 15.2 0 13.3 14 ...
##  $ shelf    : int  3 3 3 1 2 3 1 3 2 1 ...
##  $ potassium: num  848.5 969.7 660 93.3 30 ...
##  $ vitamins : Factor w/ 3 levels "100%","enriched",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ mfr2     : chr  "NPQR" "K" "K" "G" ...
x_nuevo<-c(149.41, 3.68, 1.42, 237.84, 3.87, 19.97, 10.05, 2.17)
x_nuevo<-as.data.frame(t(x_nuevo))
colnames(x_nuevo)<-c("calories","protein","fat","sodium","fibre","carbo","sugars","shelf")
datos_punto12.5<-UScereal[,c(2:9,12)]

(a) Que funcion deberma usarse para clasificar esta nueva observación de acuerdo al fabricante, la discriminante lineal a o cuadratica? Justifique.

# Normalidad
library(MVN)
royston_test <- MVN::mvn(data = datos_punto12.5[,-9], mvnTest = "royston", multivariatePlot = "qq")

royston_test$univariateNormality
royston_test$multivariateNormality
#Homogeneidad en las varianzas
library(biotools)
## Warning: package 'biotools' was built under R version 4.3.2
## ---
## biotools version 4.2
boxM(data = datos_punto12.5[, -9], grouping = datos_punto12.5[, 9])
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  datos_punto12.5[, -9]
## Chi-Sq (approx.) = 160.78, df = 72, p-value = 9.902e-09

Debido a que se No se cumple la prueba de Royston de normalidad multivariada y No hay igualdad de varianzas, ninguna de estas dos funciones se deberma usar.

(b) Mediante la funcisn discriminante lineal y tomando las probabilidades a priori todas iguales, en qui fabricante se clasifica la nueva observación?

library(MASS) 
modelo_lda <- lda(mfr2 ~ ., data = datos_punto12.5)
modelo_lda
## Call:
## lda(mfr2 ~ ., data = datos_punto12.5)
## 
## Prior probabilities of groups:
##         G         K      NPQR 
## 0.3384615 0.3230769 0.3384615 
## 
## Group means:
##      calories  protein      fat   sodium    fibre    carbo    sugars    shelf
## G    137.7879 2.884848 1.784848 240.3939 1.648485 17.69394 10.051515 2.136364
## K    149.6710 3.918530 1.023476 242.7893 5.068602 19.79582 10.798201 2.285714
## NPQR 160.7778 4.258409 1.441152 230.5569 4.949889 22.40529  9.336782 2.090909
## 
## Coefficients of linear discriminants:
##                   LD1          LD2
## calories  0.007709863 -0.017367238
## protein  -0.043058193  0.025913064
## fat      -0.428540858  0.656472020
## sodium   -0.005542740 -0.002827495
## fibre     0.165662299  0.022452311
## carbo     0.055370523  0.155203745
## sugars    0.025008566 -0.005728690
## shelf    -0.285867988 -0.691416062
## 
## Proportion of trace:
##    LD1    LD2 
## 0.7762 0.2238
prediccionesLDA <- predict(object = modelo_lda, newdata = x_nuevo)
prediccionesLDA$class
## [1] NPQR
## Levels: G K NPQR

Mediante la funcisn discriminante lineal y tomando las probabilidades a priori todas iguales la nueva observación se clasifica en el grupo de fabricantes formado por N P Q y R.

(c) Mediante la función discriminante lineal y tomando las probabilidades a priori proporcionales a los tamaños de los grupos (pi = 1/ni), en que fabricante se clasifica la nueva observación? compare con el resultado del inciso anterior.

p<-c(length(datos_punto12.5$mfr2[datos_punto12.5$mfr2=="G"])/length(datos_punto12.5$mfr2),length(datos_punto12.5$mfr2[datos_punto12.5$mfr2=="K"])/length(datos_punto12.5$mfr2),length(datos_punto12.5$mfr2[datos_punto12.5$mfr2=="NPQR"])/length(datos_punto12.5$mfr2))
prediccionesLDA_priori <- predict(object = modelo_lda, newdata = x_nuevo, prior =p)
prediccionesLDA_priori$class
## [1] NPQR
## Levels: G K NPQR

Mediante la función discriminante lineal y tomando las probabilidades a priori proporcionales al numero de observaciones la nueva observación se clasifica en el grupo de fabricantes formado por N P Q y R.

(d) Mediante la función discriminante cuadrática y tomando las probabilidades a priori todas iguales, en qui fabricante se clasifica la nueva observación.

modelo_qda <- qda(mfr2 ~ ., data = datos_punto12.5)
modelo_qda
## Call:
## qda(mfr2 ~ ., data = datos_punto12.5)
## 
## Prior probabilities of groups:
##         G         K      NPQR 
## 0.3384615 0.3230769 0.3384615 
## 
## Group means:
##      calories  protein      fat   sodium    fibre    carbo    sugars    shelf
## G    137.7879 2.884848 1.784848 240.3939 1.648485 17.69394 10.051515 2.136364
## K    149.6710 3.918530 1.023476 242.7893 5.068602 19.79582 10.798201 2.285714
## NPQR 160.7778 4.258409 1.441152 230.5569 4.949889 22.40529  9.336782 2.090909
prediccionesQDA <- predict(object = modelo_qda, newdata = x_nuevo)
prediccionesQDA$class
## [1] G
## Levels: G K NPQR

Mediante la función discriminante ciadratica y tomando las probabilidades a priori iguales, la nueva observación se clasifica en el grupo G.

(e) Mediante la funcisn discriminante cuadrática y tomando las probabilidades a priori proporcionales al los tamaqos de los grupos (pi = 1/ni), en que fabricante se clasifica la nueva observación? compare con el resultado del inciso anterior.

prediccionesQDA_priori <- predict(object = modelo_qda, newdata = x_nuevo, prior =p)
prediccionesQDA_priori$class
## [1] G
## Levels: G K NPQR

Mediante la función discriminante cuadrática y tomando las probabilidades a priori proporcionales al numero de observaciones la nueva observación se clasifica en el grupo G, esto se puede deber a que hay casi las mismas observaciones en cada grupo.

(f) Usando la función discriminante lineal, estime la taza de error de clasicacisn aparente mediante el mitodo de resustitución.

library(caret)
## Warning: package 'caret' was built under R version 4.3.2
## 
## Attaching package: 'caret'
## The following object is masked from 'package:vegan':
## 
##     tolerance
prediccionesLDA <- predict(object=modelo_lda,newdata=datos_punto12.5[,-9])
confusion_matrix <- confusionMatrix(prediccionesLDA$class, as.factor(datos_punto12.5$mfr2))
TEA <- confusion_matrix$overall["Accuracy"]
1-TEA
##  Accuracy 
## 0.4153846

La TEA mediante el método de resustitución es de 0.415

(g) Usando la funcisn discriminante lineal, estime la taza de error de clasificación aparente mediante el mitodo de validación cruzada.

library(caret)
set.seed(123) 
index <- createDataPartition(datos_punto12.5$mfr2, p = 0.8, list = FALSE)
train_data <- datos_punto12.5[index, ]
test_data <- datos_punto12.5[-index, ]
modelo_lda <- lda(mfr2 ~ ., data = train_data)
predicciones <- predict(modelo_lda, newdata = test_data)
tasa_error <- mean(predicciones$class != test_data$mfr2)
tasa_error
## [1] 0.6666667

La TEA mediante el mitodo de validación cruzada es de 0.667.

Ejercicio sobre Escalamiento multidimensional

Punto 6 del libro

6.En una investigacion llevada a cabo en el Centro de Perfeccionamiento para la Educacion Superior de la Universidad de La Habana (CEPES-UH) sobre la formacion psicopedagogica del profesorado universitario, es de interes establecer un diagnostico sobre los aspectos de reexion y criticidad sobre la labor que desempe~na el profesorado. Para ello se seleccionaron aleatoriamente 12 profesores que representan los tres factores siguientes: especialidad, con tresniveles: 1-quimica, 2-lengua inglesa y 3- idioma (servicio). Categoria docente,con dos niveles: 1-Principal, 2- no principal. Experiencia docente, con dos niveles: 1- muy experimentado, 2- menos experimentado. A los profesores seleccionados se les aplico instrumentos elaborados para tal efecto, donde se midieron las caracteristicas sobre su labor pedagogica” en tres dimensiones y sobre su labor pedagogica” en dos dimensiones. Estas dimensiones fueron medidas en una escala ordinal de 1 a 3 que re ejaban las categorias “, ” y “. A partir de la tabla de datos originalesse obtuvo una matriz de disimilaridades utilizando el coefciente de desacuerdo”. La tabla 13.13 muestra esta matriz de disimilaridades, observese que las entradas de esta tabla son los 12 profesores que caracterizan los tres factores mencionados anteriormente y que por simplicidad se denotan con latripla (abc) donde a es el nivel de la especialidad, b es el nivel de la categoria docente y c es la experiencia docente. Realice un analisis por Escalamiento Multidimensional no metrico y obtenga conclusiones.

Tabla_13_13 <- read_excel("C:/Users/Lenovo/Desktop/Tabla_13_13.xlsx")
## New names:
## • `` -> `...1`
tabla13=as.data.frame(Tabla_13_13[,-1])
tabla13[tabla13 == 0] <- 0.0001
rownames(tabla13)<-c("111","112","121","122","211","212","221","222","311","312"
                     ,"321","322")
data13=as.matrix(tabla13)

Empleando las distancias euclideanas obtenemos las siguientes coordenadas: Nota: Se hace mediante distancias euclideana porque así está en el libro.

em33<-metaMDS(dist(tabla13,method = "euclidean"), k=2, trymax=100)
## Run 0 stress 0.003717568 
## Run 1 stress 0.004623014 
## Run 2 stress 0.004795972 
## Run 3 stress 0.328516 
## Run 4 stress 0.004839638 
## Run 5 stress 0.005113499 
## Run 6 stress 0.004666434 
## Run 7 stress 0.004925451 
## Run 8 stress 0.004687198 
## Run 9 stress 0.004851139 
## Run 10 stress 0.004736846 
## Run 11 stress 0.005653056 
## Run 12 stress 0.004056116 
## ... Procrustes: rmse 0.01740807  max resid 0.02667332 
## Run 13 stress 0.004554559 
## Run 14 stress 0.004307226 
## Run 15 stress 0.004776784 
## Run 16 stress 0.004719413 
## Run 17 stress 0.003968072 
## ... Procrustes: rmse 0.01566909  max resid 0.02409649 
## Run 18 stress 0.004622345 
## Run 19 stress 0.004927161 
## Run 20 stress 0.004812743 
## Run 21 stress 0.004492772 
## Run 22 stress 0.004863912 
## Run 23 stress 0.004870398 
## Run 24 stress 0.004241867 
## Run 25 stress 0.006025471 
## Run 26 stress 0.004170351 
## ... Procrustes: rmse 0.009433835  max resid 0.01596481 
## Run 27 stress 0.004985684 
## Run 28 stress 0.004757478 
## Run 29 stress 0.06246044 
## Run 30 stress 0.00372788 
## ... Procrustes: rmse 0.0004084148  max resid 0.0007105604 
## ... Similar to previous best
## *** Best solution repeated 1 times
coordenadas <- scores(em33)

Se contruye el grafico:

plot(em33$points,type="n",xlim = c(-1.2,2), ylim = c(-0.9,0.8))
text(em33$points,colnames(tabla13))

Se obtiene el Stress:

em33$stress
## [1] 0.003717568

El stress es bajo, lo cual indica una buena configuración para el EM. Además, Se puede ver que algunos de estos docentes se traslapan, la razón es el alto nivel de similaridad o porque se diferencian poco. Al respecto, el gráfico muestra en el primer eje oposición entre los profesores de mucha experiencia y aquellos de menos. Con relación al segundo eje los puntos más distantes son los puntos (322 y 122) y (222), lo que indica una amplica diferencia entre Química e Idioma (servicios) y la especialidad de Lengua Inglesa para aquellos docentes con el mismo nivel de experiencia y categoría.

NOTA: Los que se traslapan son 322 y 122, en la parte superior derecha, 321, 311 y 111 en la parte superior izquierda