Entorno de trabajo

#Agrego librerias base que se van a necesitar y voy sumando a medida que surjan nuevas
library(ggplot2) #
library(dplyr)#manejo de datos
library(tidyverse)#manejo de datos
library(DT)
library(kableExtra)# hacer tablas bonitas
library(lubridate)#manejo de fechas
library(GGally)
library(moments)
library(reshape2)
library(car)
library(plotly)
library(fmsb)
library(geomtextpath)
library(MASS)
#Funciones auxiliares
create_beautiful_radarchart <- function(data, color = "#00AFBB", 
                                        vlabels = colnames(data), vlcex = 0.7,
                                        caxislabels = NULL, title = NULL, ...){
  radarchart(
    data, axistype = 1,
    # Customize the polygon
    pcol = color, pfcol = scales::alpha(color, 0.5), plwd = 2, plty = 1,
    # Customize the grid
    cglcol = "grey", cglty = 1, cglwd = 0.8,
    # Customize the axis
    axislabcol = "grey", 
    # Variable labels
    vlcex = vlcex, vlabels = vlabels,
    caxislabels = caxislabels, title = title, ...
  )
}

#Seteo el directorio de trabajo
setwd("C:/Users/marco/Dropbox/Austral/Analisis_inteligente_de_datos/Clase_01")

Ejercicio 1 (Transformaciones de datos).

Seis candidatas son evaluadas para el puesto de recepcionista en una empresa, para ello pasan por dos entrevistas. En la primera las evalúa el responsable de recursos humanos de la empresa (juez 1) y en la segunda el responsable del área de la cual van a depender (juez 2). La asignación de puntajes es en cordialidad, presencia y manejo de idiomas. Los puntajes asignados independientemente por estos jueces se encuentran en el archivo recepcionistas.xls.

SETUP

datosEj1 =  readxl::read_excel("recepcionistas.xls")

(a) Calcule en promedio por juez de cada una de las aspirantes. ¿Cuál le parece que seleccionaría cada uno de ellos? ¿Existe coincidencia?

datosEj1 <- datosEj1 %>% mutate(avg_juez1=rowMeans(datosEj1[2:4]), .after = idiom.juez1)
datosEj1 <- datosEj1 %>% mutate(avg_juez2=rowMeans(datosEj1[6:8]))
datosEj1[c(1,5,9)] %>% kbl(caption = "Promedios") %>% kable_classic(full_width =F)
Promedios
candidatos avg_juez1 avg_juez2
Mariana 80.00000 72.66667
Maia 76.66667 73.33333
Sabrina 66.66667 60.00000
Daniela 60.00000 56.00000
Alejandra 60.00000 63.33333
Carla 78.33333 70.00000

Juez1

datosEj1[which.max(datosEj1$avg_juez1),c(1,5)]  %>% kbl() %>% kable_classic(full_width =F)
candidatos avg_juez1
Mariana 80

Juez 2

datosEj1[which.max(datosEj1$avg_juez2),c(1,9)]  %>% kbl() %>% kable_classic(full_width =F)
candidatos avg_juez2
Maia 73.33333

No coinciden en la elección

(b) Calcule el promedio de cada una de las aspirantes tomando en cuenta todos los rubros y ambos jueces.

Ok. el promedio de cada aspirante, como no hay ponderación por rubro, es el promedio de la totalidad. Eso es relativamente sencillo ya que es calcular el promedio para todas las columnas. Pero, para probarlo de otra manera, podemos hacer el promedio de los promedios por juez que es lo mismo.

datosEj1 <- datosEj1 %>% mutate(avg_Tota=rowMeans(datosEj1[c(2,9)]))
datosEj1[c(1,9)] %>% kbl(caption = "Promedios") %>% kable_classic(full_width =F)
Promedios
candidatos avg_juez2
Mariana 72.66667
Maia 73.33333
Sabrina 60.00000
Daniela 56.00000
Alejandra 63.33333
Carla 70.00000

(c) Transformar las puntuaciones observadas de modo tal que cada una de las seis variables tenga media 0 y dispersión 1. ¿Cuál sería el objetivo de esta transformación?

Llevar las variables a media 0 y dispersión 1 es equivalente a decir que se la convierte en una distribución normal. Hacemos esto para poder trabajar con más facilidad con los cálculos y poder comparar distribuciones de forma más fácil, eliminando las diferencias de criterio entre jueces.

Exploremos con la variable cord.juez1

summary((datosEj1$`cord.juez 1`-mean(datosEj1$`cord.juez 1`))/sd(datosEj1$`cord.juez 1`))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.5498 -0.2214 -0.2214  0.0000  0.7749  1.1070

Esto normaliza la variable, pero vemos que hay otra función que lo hace más fácil

summary(scale(datosEj1[c(2)]))
##   cord.juez 1     
##  Min.   :-1.5498  
##  1st Qu.:-0.2214  
##  Median :-0.2214  
##  Mean   : 0.0000  
##  3rd Qu.: 0.7749  
##  Max.   : 1.1070

Por tal motivo podemos hacerlo para todas las columnas en un sólo paso pasando el resultado de tipo dataframe, agregandole la columna de nombres y convirtiendo de nuevo a tipo

normalEj1 <-as_tibble(as.data.frame(scale(datosEj1[c(2:4,6:8)])) %>% mutate(datosEj1[,1],.before=c(1)))
normalEj1 %>% kbl(caption = "Promedios") %>% kable_classic(full_width =F)
Promedios
candidatos cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
Mariana -0.2214037 0.9821237 1.6329932 -0.7613870 0.2598796 1.4564382
Maia -0.2214037 0.9821237 0.4082483 -0.1903467 1.1103946 0.5201565
Sabrina 1.1070186 -0.7015169 -0.8164966 0.3806935 -1.0158929 -0.4161252
Daniela -0.2214037 -1.2627304 -0.8164966 0.3806935 -1.1576454 -1.0403130
Alejandra -1.5498260 -0.7015169 -0.8164966 -1.3324272 -0.3071304 0.5201565
Carla 1.1070186 0.7015169 0.4082483 1.5227740 1.1103946 -1.0403130

Comprobamos que son normales con el promedio ….

as_tibble(lapply(colMeans(normalEj1[2:7]),function(x) round(x,1))) %>% kbl(caption = "Promedios x columna") %>% kable_classic(full_width =F)
Promedios x columna
cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
0 0 0 0 0 0

y la SD

as_tibble(lapply(normalEj1[2:7], sd)) %>% kbl(caption = "Desv. Std.x Columna") %>% kable_classic(full_width =F)
Desv. Std.x Columna
cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
1 1 1 1 1 1

(d) Transformar las puntuaciones de modo tal que cada candidata tenga para cada juez media 0 y dispersión 1. ¿Cuál sería el objetivo de esta transformación?

para cada fila normalizo la fila, para cada juez. Es decir le restpo su promedio y divido por la desv. std. de los puntajes por categoria de cada juez

temp1 <- datosEj1[2:4] - rowMeans(datosEj1[2:4])
temp2 <- datosEj1[6:8] - rowMeans(datosEj1[6:8])
temp1_2 <-  t(apply(temp1,1, function(x) x/sd(x)))
temp2_2 <-  t(apply(temp2,1, function(x) x/sd(x)))
#Junto los resultados y le agrego los nombres
result1d <- as_data_frame(cbind(datosEj1[1],temp1_2,temp2_2)) 
## Warning: `as_data_frame()` was deprecated in tibble 2.0.0.
## Please use `as_tibble()` instead.
## The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
result1d  %>% kbl(caption = "Normalizacion x Fila") %>% kable_classic(full_width =F)
Normalizacion x Fila
candidatos cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
Mariana 0.0000000 1.0000000 -1.0000000 -1.1499323 0.4841820 0.6657503
Maia 0.2182179 0.8728716 -1.0910895 -0.5773503 1.1547005 -0.5773503
Sabrina 1.1208971 -0.3202563 -0.8006408 1.0000000 0.0000000 -1.0000000
Daniela 1.1547005 -0.5773503 -0.5773503 0.9271726 0.1324532 -1.0596259
Alejandra 1.0000000 0.0000000 -1.0000000 -1.0910895 0.8728716 0.2182179
Carla 0.7258662 0.4147807 -1.1406469 0.3779645 0.7559289 -1.1338934

Ahora, esto es lo mismo que antes (b) pero con la matriz de datos traspuesta….

as_data_frame(cbind(datosEj1[1],t(scale(t(datosEj1[c(2:4)]))),t(scale(t(datosEj1[c(6:8)]))))) %>% kbl(caption = "Normalizacion x Fila") %>% kable_classic(full_width =F)
Normalizacion x Fila
candidatos cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
Mariana 0.0000000 1.0000000 -1.0000000 -1.1499323 0.4841820 0.6657503
Maia 0.2182179 0.8728716 -1.0910895 -0.5773503 1.1547005 -0.5773503
Sabrina 1.1208971 -0.3202563 -0.8006408 1.0000000 0.0000000 -1.0000000
Daniela 1.1547005 -0.5773503 -0.5773503 0.9271726 0.1324532 -1.0596259
Alejandra 1.0000000 0.0000000 -1.0000000 -1.0910895 0.8728716 0.2182179
Carla 0.7258662 0.4147807 -1.1406469 0.3779645 0.7559289 -1.1338934

Analizo el resultado para verificar:

cbind(avg_juez1=rowMeans(result1d[2:4]),
      avg_juez2=rowMeans(result1d[5:7]),
      sd_juez1=apply(result1d[2:4],1,sd),
      sd_juez2=apply(result1d[5:7],1,sd)) %>% 
  kbl(caption = "Normalizacion x Fila") %>% kable_classic(full_width =F)
Normalizacion x Fila
avg_juez1 avg_juez2 sd_juez1 sd_juez2
0 0 1 1
0 0 1 1
0 0 1 1
0 0 1 1
0 0 1 1
0 0 1 1

Entiendo que la utilidad de esto es normalizar los criterios de juicio a una misma escala para que sea comparable que evaluo mas o menos cada juez en relación a su criterio base, no interesa mucho el nivel general que cada uno asigne sino la diferencia entre los candidatos. (pp57 item 2.5.2)

(e) Grafique los perfiles multivariados de cada una de las candidatas para ambas transformaciones. ¿Qué observa?

No entiendo muy bien que quiere decir los perfiles multivariados en un gráfico para las candidatas, no tengo una media que calcular sino que solo hay un punto. Tomo eso como la media. Se puede hacer la media si se hace sobre los dos jueces, pero no entiendo que comparación podriamos hacer ahí.

colnames(datosEj1) = c("Candidatas", "cord_juez1","pres_juez1","idiom_juez1","avg_juez1", "cord_juez2","pres_juez2","idiom_juez2","avg_juez2")

juez1Multi <- cbind(datosEj1[1:4],Juez="juez1") 
colnames(juez1Multi) = c("Candidatas", "Cordialidad","Presencia","Idioma","juez")
juez2Multi <-  cbind(datosEj1[c(1,6:8)],Juez="juez2")
colnames(juez2Multi) = c("Candidatas", "Cordialidad","Presencia","Idioma","juez")

newDataset1 = gather(rbind(juez1Multi,juez2Multi),key="Tipo", value="Puntos",2:4)

ggplot(newDataset1 ,aes(x=Tipo, y=Puntos,group=Candidatas)) +
 geom_line(aes(color=Candidatas)) +
  facet_wrap(~juez) +
  theme_minimal()

Sacando la media entre jueces

newDataset1bis <- newDataset1[c(1,3,4)] %>% group_by(Candidatas, Tipo)  %>% summarise(Puntos = mean(Puntos))

ggplot(newDataset1bis ,aes(x=Tipo, y=Puntos,group=Candidatas)) +
 geom_line(aes(color=Candidatas)) +
  theme_minimal()

Ahora para la segunda distribución

colnames(result1d) = c("Candidatas", 
                       "cord_juez1","pres_juez1","idiom_juez1",
                       "cord_juez2","pres_juez2","idiom_juez2")

juez1NormMulti <- cbind(result1d[1:4],Juez="juez1") 
colnames(juez1NormMulti ) = c("Candidatas", "Cordialidad","Presencia","Idioma","juez")
juez2NormMulti <-  cbind(result1d[c(1,5:7)],Juez="juez2")
colnames(juez2NormMulti) = c("Candidatas", "Cordialidad","Presencia","Idioma","juez")

newDataset1 = gather(rbind(juez1NormMulti,juez2NormMulti),key="Tipo", value="Puntos",2:4)

ggplot(newDataset1 ,aes(x=Tipo, y=Puntos,group=Candidatas)) +
 geom_line(aes(color=Candidatas)) +
  facet_wrap(~juez) +
  theme_minimal()

x juez

newDataset1bis <- newDataset1[c(1,3,4)] %>% group_by(Candidatas, Tipo)  %>% summarise(Puntos = mean(Puntos))

ggplot(newDataset1bis ,aes(x=Tipo, y=Puntos,group=Candidatas)) +
 geom_line(aes(color=Candidatas)) +
  theme_minimal()

En la comparación de la segunda transformación lo que resulta mas claro es en que puntuaron diferente los jueces a cada candidata. Sin embargo la forma es igual si hacemos el perfilado x Juez

Ejercicio 2 (Tipos de variables resúmenes).

(Datos: Internet. 2013) Se han registrado sobre 1500 individuos las variables siguientes:

  • ID: número de identificación del registro.
  • Nacionalidad
  • Edad: cumplida en años
  • Sexo: Masculino (1) Femenino (2)
  • Estatura: en m
  • Sitio: sitio preferido al que se conecta; 1- chat 2 - correo electrónico 3- buscadores 4 – software 5 – música 6 – deportes 7 - otros
  • Uso: Tiempo de uso promedio por día en minutos
  • Temperatura: media anual de la zona de residencia
  • Autos: cantidad de autos en la manzana donde reside
  • Cigarrillos: Cantidad de cigarrillos consumidos mientras utiliza Internet

SETUP

datosEj2 =  readxl::read_excel("Internet2013.xls")

(a) Clasificar las variables de la base. Para las variables numéricas construir un gráfico de coordenadas paralelas.

datosEj2a <- datosEj2[-c(1,4,6)]

ggparcoord(data = datosEj2a,
           columns = 2:7,
           groupColumn = "Nacionalidad",
           showPoints = TRUE
           )

Eliminemos los outliers para ver si se ve mejor….

outAutos <- boxplot(datosEj2a$Autos, plot=FALSE)$out
outTemp <- boxplot(datosEj2a$Temperatura, plot=FALSE)$out
outEdad <- boxplot(datosEj2a$Edad, plot=FALSE)$out
outCiga <- boxplot(datosEj2a$Cigarrillos, plot=FALSE)$out

datosOut <- datosEj2a
datosOut<- datosOut[-which(datosOut$Autos %in% outAutos),]
datosOut<- datosOut[-which(datosOut$Temperatura %in% outTemp),]
datosOut<- datosOut[-which(datosOut$Edad %in% outEdad),]
datosOut<- datosOut[-which(datosOut$Cigarrillos %in% outCiga),]

ggparcoord(data = datosOut,
           columns = 2:7,
           groupColumn = "Nacionalidad",
           showPoints = TRUE
           )

Nah….

(b) Construir la tabla de frecuencias de la variable sexo. ¿Hay algún valor que llame la atención? ¿Qué tipo de error considera que es?

table(datosEj2$Sexo) %>% 
  kbl(caption = "Sexo = 0") %>% kable_classic(full_width =F)
Sexo = 0
Var1 Freq
0 1
1 684
2 815

Hay un valor que me da 0, eso no corresponde a ninguna opcion tabulada

datosEj2[which(datosEj2$Sexo == 0),]  %>% 
  kbl(caption = "Sexo = 0") %>% kable_classic(full_width =F)
Sexo = 0
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
1039 CANADA 26 0 1.79 3 174 -9 9 5

Puede ser un error de carga (no ofrece opcion 0) o un dato nulo.

(c) Ordenar los datos por la variable Edad. ¿Encontró algún valor extraño? ¿Qué tipo de error puede ser? item Construir la tabla de frecuencias de la variable Sitio. ¿Encuentra algún valor que le llame la atención? ¿Qué tipo de error puede ser?

rbind(head(arrange(datosEj2,desc(Edad))),tail(arrange(datosEj2,desc(Edad))))  %>% 
  kbl(caption = "Ordenado x Edad") %>% kable_classic(full_width =F)
Ordenado x Edad
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
319 ARGENTINA 280 2 1.62 2 51 20 49 1
1466 BRASIL 180 1 1.65 2 146 17 30 5
398 ARGENTINA 120 2 1.69 7 158 12 19 12
1490 ARGENTINA 99 2 1.66 7 -2 40 0 100
1365 ARGENTINA 88 2 1.62 7 0 32 2 75
328 ARGENTINA 60 1 1.57 5 34 7 177 3
646 CANADA 11 1 1.69 2 137 17 115 0
1257 ARGENTINA 11 1 1.55 1 78 19 129 0
417 ARGENTINA 10 2 1.59 2 280 -7 56 29
1171 ARGENTINA 9 2 1.61 7 16 7 20 19
1432 BRASIL 1 2 1.64 7 30 25 58 1
661 ARGENTINA -44 2 1.65 7 42 5 68 0

Claramente hay un error de carga. El signo negativo es imposible en la edad y 120, 180 y 280 tampoco son posibles o plausibles… los otros valores pueden ser…

(d) Proceda de forma similar para las variables Temperatura, Autos y Cigarrillos.

Para ver anomalias debo ver la cabeza y la cola, el caso de edad mostro esto claramente.

Temperatura:

rbind(head(arrange(datosEj2,desc(Temperatura))),tail(arrange(datosEj2,desc(Temperatura))))  %>% 
  kbl(caption = "Ordenado x Temperatura") %>% kable_classic(full_width =F)
Ordenado x Temperatura
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
1112 BRASIL 19 1 1.56 3 15 131 70 1
1157 ARGENTINA 29 2 1.68 1 8 94 189 0
1490 ARGENTINA 99 2 1.66 7 -2 40 0 100
374 BRASIL 36 2 1.63 2 92 36 70 2
1004 BRASIL 22 1 1.71 2 65 36 86 1
68 BRASIL 29 1 1.75 6 152 35 86 3
788 CANADA 39 2 1.54 4 43 -12 98 0
812 CANADA 45 1 1.71 2 280 -12 78 16
1063 CANADA 24 1 1.68 3 67 -12 39 0
513 CANADA 48 2 1.66 2 308 -13 123 14
469 CANADA 51 2 1.64 7 122 -14 195 1
470 CANADA 36 2 1.69 5 131 -14 89 8

Temperatura:

rbind(head(arrange(datosEj2,desc(Autos))),tail(arrange(datosEj2,desc(Autos))))  %>% 
  kbl(caption = "Ordenado x Autos") %>% kable_classic(full_width =F)
Ordenado x Autos
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
836 CANADA 37 1 1.60 5 65 11 2680 2
115 BRASIL 44 1 1.59 5 85 20 200 1
217 BRASIL 28 1 1.75 7 132 21 200 0
467 CANADA 58 2 1.71 7 204 4 200 1
493 BRASIL 48 2 1.73 2 190 30 200 0
651 BRASIL 48 2 1.51 5 143 6 200 1
1098 ARGENTINA 17 2 1.64 2 46 -1 6 0
1500 ARGENTINA 45 2 1.67 6 117 32 6 10
1267 ARGENTINA 54 1 1.78 7 48 14 5 4
1392 ARGENTINA 41 2 1.60 1 251 20 5 1
1365 ARGENTINA 88 2 1.62 7 0 32 2 75
1490 ARGENTINA 99 2 1.66 7 -2 40 0 100

Cigarrillos

rbind(head(arrange(datosEj2,desc(Cigarrillos))),tail(arrange(datosEj2,desc(Cigarrillos))))  %>% 
  kbl(caption = "Ordenado x Cigarrillos") %>% kable_classic(full_width =F)
Ordenado x Cigarrillos
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
1490 ARGENTINA 99 2 1.66 7 -2 40 0 100
1365 ARGENTINA 88 2 1.62 7 0 32 2 75
1149 BRASIL 17 1 1.63 1 310 18 137 30
417 ARGENTINA 10 2 1.59 2 280 -7 56 29
120 ARGENTINA 27 2 1.76 5 4 30 18 28
156 ARGENTINA 53 2 1.67 7 308 5 147 26
1487 CANADA 32 2 1.69 5 32 1 196 0
1488 ARGENTINA 25 1 1.64 2 230 7 39 0
1489 ARGENTINA 29 1 1.81 2 241 16 38 0
1491 ARGENTINA 44 2 1.63 6 32 7 73 0
1493 CANADA 37 1 1.68 4 30 6 173 0
1498 BRASIL 54 1 1.59 7 3 29 69 0

aca no queda claro, 100 parece un numero excesivo sobre todo considerando que el tiempo de uso es imposible -2.

Lo que lleva a pensar que hay que hacer lo mismo para “USO”:

rbind(head(arrange(datosEj2,desc(Uso))),tail(arrange(datosEj2,desc(Uso))))  %>% 
  kbl(caption = "Ordenado x Uso") %>% kable_classic(full_width =F)
Ordenado x Uso
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
827 BRASIL 19 1 1.67 3 350 18 187 1
502 ARGENTINA 56 2 1.67 7 341 9 37 8
361 CANADA 53 2 1.63 7 340 10 69 1
428 CANADA 42 2 1.67 4 340 -3 77 19
1002 ARGENTINA 25 2 1.61 5 337 17 94 8
1060 ARGENTINA 56 2 1.61 7 337 9 113 19
1445 ARGENTINA 49 1 1.62 7 6 -1 66 1
120 ARGENTINA 27 2 1.76 5 4 30 18 28
1498 BRASIL 54 1 1.59 7 3 29 69 0
1365 ARGENTINA 88 2 1.62 7 0 32 2 75
1490 ARGENTINA 99 2 1.66 7 -2 40 0 100
69 CANADA 31 1 1.86 5 -10 23 61 9

Acá los dos valores de la cola hay que eliminarlos también. No hay minutos negativos… y ya que estamos veamos la estatura

rbind(head(arrange(datosEj2,desc(Estatura))),tail(arrange(datosEj2,desc(Estatura))))  %>% 
  kbl(caption = "Ordenado x Estatura") %>% kable_classic(full_width =F)
Ordenado x Estatura
ID Nacionalidad Edad Sexo Estatura Sitio Uso Temperatura Autos Cigarrillos
769 BRASIL 21 1 1.93 3 55 7 21 1
56 ARGENTINA 23 1 1.91 3 304 8 67 4
568 ARGENTINA 13 1 1.91 1 236 -1 69 3
604 ARGENTINA 34 1 1.91 5 111 -6 103 3
535 CANADA 20 1 1.90 3 62 -7 50 0
807 ARGENTINA 22 1 1.90 3 71 19 108 0
1050 ARGENTINA 50 1 1.50 7 74 12 91 0
1351 CANADA 13 2 1.50 2 24 -3 12 1
78 CANADA 15 2 1.49 2 72 8 98 5
848 BRASIL 17 2 1.49 2 28 25 8 1
1114 ARGENTINA 16 2 1.49 2 130 6 70 1
354 BRASIL 30 2 1.47 2 41 18 92 3

Acá estamos ok.

(e) Elimine de la base los valores que no son posibles y que seguramente corresponde a un error de tipeo. Detalle valores/registros que le hayan llamado la atención pero no deban ser eliminados necesariamente.

Bueno, en cada sección salieron candidatos a ser eliminados. El intento inicial por eliminar los outliers segun el criterio de +- 1.5 desv. std. arrojo que había algunos casos que era dudos que fueran errores de carga, pese a ser outliers (la edad y la temperatura por ejemplo). Así que la revisión se hizo a mano por criterios de factibilidad. Los eliminados son los ID: (1039,1112,1157,319,1466,398,1490,69,836)

ids <- c(1039,1112,1157,319,1466,398,1490,69,836)
datosEj2 <- datosEj2[-which(datosEj2$ID %in% ids),]

(f) ¿Para cuáles de las variables tiene sentido calcular la media? ¿Y la mediana?¿Para cuáles de las variables tiene sentido calcular la media? ¿Y la mediana?

En las variables númericas tiene sentido calcular la media. En el caso de variables categoricas como sexo, sitio y nacionalidad uno no puede calcularlas porque no son variables ni siquiera ordinales (que permitirian al menos calcular la mediana). Ahora para saber si tiene sentido calcular la mediana como mediad de tendencia central hay que ver si las distribuciones son simétricas. Podemos aplicar para esto el coeficiente de fisher.

apply(datosEj2[c(3,5,7:10)], 2,function(x) skewness(x)) %>% 
  kbl(caption = "Coeficientes de Fisher") %>% kable_classic(full_width =F)
Coeficientes de Fisher
x
Edad -0.0085420
Estatura 0.4021227
Uso 0.9227676
Temperatura -0.0394665
Autos 0.0689256
Cigarrillos 4.8012333

El uso y los cigarrillos tienen una asimetria hacia la derecha (cola larga a la izquierda). La estatura tiene un poco de asimetría también, pero es menor a 0.5, que es considerado el límite usual. Las otras variables no son asimétricas. Por tal motivo, calcular la mediana tiene sentido en aquellas variables asimétricas (aunque en el resto de las variables puede calcularse igual, como ya se mencionó).

(g) ¿Cuáles de las variables le parecen simétricas a partir de estos resúmenes? Confirme estas observaciones mediante un boxplot.

Encontre una forma más sencilla en el caso anterior para preparar los datos para la graficación

data_mod <- melt(datosEj2, id.vars='ID', 
                  measure.vars=c('Edad', 'Autos','Temperatura','Estatura','Uso','Cigarrillos'))

ggplot(data_mod) +
geom_boxplot(aes(x=ID, y=value, fill=variable,alpha=0.2)) +
  theme_minimal()

Acá se puede ver como uso y cigarrillos tienen outliers hacia arriba que le dan una asimetría positiva (a la derecha). Esto esta dado porque tiene la mayor parte de los datos en los valores más pequeños y algunos en la parte más larga que le “alargan” la cola.

(h) Calcular la desviación intercuartil y detectar presencia de valores salvajes moderados y severos.

De los boxplot anteriores (y de lo visto en puntos anteriores) vemos que hay 4 variables que tienen outliers y ya los calculamos. Ahora el problema es entender cuales son moderados y cuales severos. Para esto hay que considerar que los que estan a mas de 3 sigma son severos y entre 1.5 y 3 son moderados. El tema es que muchos ya los hemos filtrado en puntos anteriores asi que hay que recalcularlos. Vamos a hacerllo a mano sin usar boxplot Primero calculamos los cuartiles y luego las distancias intercuartiles

Q <- as_data_frame(apply(datosEj2[c(3,5,7:10)], 2, function(x) quantile(x, probs=c(.25, .75), na.rm = FALSE)) )

iqr <- as_data_frame(t(apply(datosEj2[c(3,5,7:10)],2, function (x) IQR(x))))
colnames(iqr) <- colnames(Q)


modCiga <- subset(datosEj2, 
       datosEj2$Cigarrillos < (Q$Cigarrillos[1] - 1.5*iqr$Cigarrillos) |
       datosEj2$Cigarrillos > (Q$Cigarrillos[2] + 1.5*iqr$Cigarrillos))

extreCiga <- subset(modCiga, 
       modCiga$Cigarrillos < (Q$Cigarrillos[1] - 3*iqr$Cigarrillos) |
       modCiga$Cigarrillos > (Q$Cigarrillos[2] + 3*iqr$Cigarrillos))


modUso <- subset(datosEj2, 
       datosEj2$Uso < (Q$Uso[1] - 1.5*iqr$Uso) |
       datosEj2$Uso > (Q$Uso[2] + 1.5*iqr$Uso))

extreUso <- subset(modUso, 
       modUso$Uso < (Q$Uso[1] - 3*iqr$Uso) |
       modUso$Uso > (Q$Uso[2] + 3*iqr$Uso))

modEdad <- subset(datosEj2, 
       datosEj2$Edad < (Q$Edad[1] - 1.5*iqr$Edad) |
       datosEj2$Edad > (Q$Edad[2] + 1.5*iqr$Edad))

extreEdad <- subset(modEdad , 
       modEdad$Edad < (Q$Edad[1] - 3*iqr$Edad) |
       modEdad$Edad > (Q$Edad[2] + 3*iqr$Edad))

modEstatura <- subset(datosEj2, 
       datosEj2$Estatura < (Q$Estatura[1] - 1.5*iqr$Estatura) |
       datosEj2$Estatura > (Q$Estatura[2] + 1.5*iqr$Estatura))

extreEstatura <- subset(modEstatura , 
       modEstatura$Estatura < (Q$Estatura[1] - 3*iqr$Estatura) |
       modEstatura$Estatura > (Q$Estatura[2] + 3*iqr$Estatura))


modAutos <- subset(datosEj2, 
       datosEj2$Autos < (Q$Autos[1] - 1.5*iqr$Autos) |
       datosEj2$Autos > (Q$Autos[2] + 1.5*iqr$Autos))

extreAutos <- subset(modAutos , 
       modAutos$Autos < (Q$Autos[1] - 3*iqr$Autos) |
       modAutos$Autos > (Q$Autos[2] + 3*iqr$Autos))

modTemperatura <- subset(datosEj2, 
       datosEj2$Temperatura < (Q$Temperatura[1] - 1.5*iqr$Temperatura) |
       datosEj2$Temperatura > (Q$Temperatura[2] + 1.5*iqr$Temperatura))

extreTemperatura <- subset(modTemperatura , 
       modTemperatura$Temperatura < (Q$Temperatura[1] - 3*iqr$Temperatura) |
       modTemperatura$Temperatura > (Q$Temperatura[2] + 3*iqr$Temperatura))

Calculados los outliers presentamos los resultados

outliers <- data.frame( rbind(nrow(modAutos),nrow(modTemperatura),nrow(modEdad),
        nrow(modEstatura),nrow(modCiga),nrow(modUso)),
        rbind(nrow(extreAutos),nrow(extreTemperatura),nrow(extreEdad),
        nrow(extreEstatura),nrow(extreCiga),nrow(extreUso)),
  row.names = c('Autos','Temperatura','Edad','Estatura','Cigarrillos','Uso')
  )
colnames(outliers) <- c('Moderados','Extremos')
                         

outliers %>% kbl(caption = "Outliers x Severidad") %>% kable_classic(full_width =F)
Outliers x Severidad
Moderados Extremos
Autos 0 0
Temperatura 0 0
Edad 2 0
Estatura 24 0
Cigarrillos 81 25
Uso 27 0

Ejercicio 3. Gráficos univariados y multivariados

(Datos: Gorriones.xls) Base de datos: Se han registrado para 49 gorriones las siguientes variables zoo métricas:

  • Largo total
  • Extensión alar
  • Largo del pico y cabeza
  • Largo del húmero
  • Largo de la quilla del esternón
  • Sobrevida (1) Si, (-1) No

SETUP

datosEj3 =  readxl::read_excel("gorriones.xlsx")

(a) Indicar en cada caso de que tipo de variable se trata.

Largos y extensiones son variables continuas. Id es una variable nominal en primer lugar pero como corresponde al orden de carga puede ser una variable ordinal. La variable sobrevida es un factor, una variable categorial binaria.

(b) Confeccionar un informe para cada variable( univariado).

summary(datosEj3)
##      pajaro     largototal    extension         cabeza          humero     
##  Min.   : 1   Min.   :152   Min.   :230.0   Min.   :30.10   Min.   :17.20  
##  1st Qu.:13   1st Qu.:155   1st Qu.:238.0   1st Qu.:30.90   1st Qu.:18.10  
##  Median :25   Median :158   Median :242.0   Median :31.50   Median :18.50  
##  Mean   :25   Mean   :158   Mean   :241.3   Mean   :31.46   Mean   :18.45  
##  3rd Qu.:37   3rd Qu.:161   3rd Qu.:245.0   3rd Qu.:32.00   3rd Qu.:18.80  
##  Max.   :49   Max.   :165   Max.   :252.0   Max.   :33.40   Max.   :19.80  
##     esternon       sobrevida      
##  Min.   :18.60   Min.   :-1.0000  
##  1st Qu.:20.20   1st Qu.:-1.0000  
##  Median :20.70   Median :-1.0000  
##  Mean   :20.83   Mean   :-0.1429  
##  3rd Qu.:21.50   3rd Qu.: 1.0000  
##  Max.   :23.10   Max.   : 1.0000

(c) Realizar en el caso que corresponda un histograma. Ensayar el número de intervalos que conviene en cada variable, indicar si utiliza algún criterio.

Hay varios criterios para ensayar un número de intervalo Dixon y Kronmal (1965), Velleman (1976), Sturges (1926), Scott (1979), Freedman y Diaconis (1981) entre otros. Como no encontré una libreria apropiada (la que encontre en car no funcionó) creo una función.

#' bins_fd  
#' @description returns the number of bins according to the Freedman-Diaconis rule
#' @param vec numeric vector
#' @return number of bins
bins_fd <- function(vec) {
  diff(range(vec)) / (2 * IQR(vec) / length(vec)^(1/3))
}

bin_lengths <- as_data_frame(t(apply(datosEj3[2:6],2, function(x) bins_fd(x))))

promedio_bins <- round(rowMeans(bin_lengths))

datosPlot <- melt(datosEj3, id.vars='pajaro', measure.vars=colnames(datosEj3[2:6]))

ggplot(datosPlot , aes(x=pajaro, fill='red')) +
    geom_histogram(position="identity", colour="blue", alpha=0.2, bins = promedio_bins ) +
    facet_grid(~variable) +
    theme_minimal()

(d) Realizar un boxplot comparativo para cada una de estas variables particionando por el grupo definido por la supervivencia. ¿Le parece que alguna de estas variables está relacionada con la supervivencia, es decir que toma valores muy distintos en ambos grupos? Analizar en todos los casos la presencia de outliers.

data_mod <- melt(datosEj3, id.vars=c('pajaro','sobrevida'), 
                  measure.vars=colnames(datosEj3[2:3]))

ggplot(data_mod, aes(x=pajaro, y=value)) + geom_boxplot(aes( group=factor(sobrevida),fill=factor(sobrevida), alpha=0.2)) +
    geom_jitter(color="darkblue")+
facet_grid(~ variable) +
  theme_minimal()

data_mod <- melt(datosEj3, id.vars=c('pajaro','sobrevida'), 
                  measure.vars=colnames(datosEj3[4:6]))

p <- ggplot(data_mod, aes(x=pajaro, y=value)) + 
  geom_boxplot(aes(group=factor(sobrevida),fill=factor(sobrevida),alpha=0.2)) +
  geom_jitter(color="darkblue")+
facet_grid(~ variable) +
  theme_minimal()

Ninguna variable parece estar afectada x la sobrevida salvo en lo relativo a la simetria de las distribuciones

(e) Construir gráficos bivariados para las todas las variables, particionando por el grupo de supervivencia (un color para cada grupo). ¿Observa alguna regularidad que pueda explicar la supervivencia?

Esto seria los contornos de la densidad a dos variables separada por sobrevida

ggplot(datosEj3,aes(x=largototal, y=cabeza) ) +
geom_density2d_filled(aes(color = factor(sobrevida))) + 
geom_textdensity2d(aes(color = factor(sobrevida))) +
geom_point(aes(color = factor(sobrevida)), alpha=0.5, size=1) + 
  theme_minimal()

Version plotly para leerlo interactivo

p <- ggplot(datosEj3,aes(x=largototal, y=cabeza) ) +
geom_density2d(aes(color = factor(sobrevida))) + 
geom_point(aes(color = factor(sobrevida)), alpha=0.5, size=1) + 
  theme_minimal()

ggplotly(p)

Y esta la densidad conjunta en dos variables para sobrevida = 1

datosEj3bis <- datosEj3 %>% filter(sobrevida ==1)
f1 <- kde2d(datosEj3bis$largototal, datosEj3bis$cabeza)  
x <- f1$x
y <- f1$y
z <- f1$z
plot_ly(type = "surface") %>% add_surface(
         contours = list(
    x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color ='white',project=list(x=TRUE)),
    y=list(project=list(y=TRUE)),
    z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05,usecolormap=TRUE,
      highlightcolor="#ff0000",project=list(z=TRUE))),
  x = ~x,
  y = ~y,
  z = ~z) %>% 
  layout(scene = list(zaxis = list(title = "densidad"), xaxis = list(title = "largototal"), yaxis = list(title = "cabeza")))

Y esta la densidad conjunta en dos variables para sobrevida = -1

datosEj3bism1 <- datosEj3 %>% filter(sobrevida == -1)
f1m1 <- kde2d(datosEj3bism1$largototal, datosEj3bism1$cabeza)  
x <- f1m1$x
y <- f1m1$y
z <- f1m1$z
plot_ly(type = "surface") %>% add_surface(
         contours = list(
   x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color ='white',project=list(x=TRUE)),
    y=list(project=list(y=TRUE)),
    z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05,usecolormap=TRUE,
      highlightcolor="#ff0000",project=list(z=TRUE))),
  x = ~x,
  y = ~y,
  z = ~z,colorscale = list(c(0, 1), c("tan", "blue")))  %>% 
  layout(scene = list(zaxis = list(title = "densidad"), xaxis = list(title = "largototal"), yaxis = list(title = "cabeza")))
x <- f1$x
y <- f1$y
z <- f1$z
xm1 <- f1m1$x
ym1 <- f1m1$y
zm1 <- f1m1$z
plot_ly(type = "surface") %>% add_surface(
         contours = list(
      x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color ='white',project=list(x=TRUE)),
    y=list(project=list(y=TRUE)),
    z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05,usecolormap=TRUE,
      highlightcolor="#ff0000",project=list(z=TRUE))),
  x = ~x,
  y = ~y,
  z = ~z)  %>% add_surface(
         contours = list(
     x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color ='white',project=list(x=TRUE)),
    y=list(project=list(y=TRUE)),
    z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05,usecolormap=TRUE,
      highlightcolor="#ff0000",project=list(z=TRUE))),
  x = ~xm1,
  y = ~ym1,
  z = ~zm1, colorscale = list(c(0, 1), c("tan", "blue"))) %>% 
  layout(scene = list(zaxis = list(title = "densidad"), xaxis = list(title = "largototal"), yaxis = list(title = "cabeza")))

Se corresponden bastante bien a las curvas de nivel….

Será esto lo que pide?

Si es esto genero la matriz de los contornos

ggpairs(datosEj3,                 # Data frame
        columns = 2:6,        # Columns
        aes(alpha = 0.5, color=factor(sobrevida)),
        lower = (list(continuous = "density")))     # Transparency

(f) Construir la matriz de diagramas de dispersión. ¿Considera que algún par de estas medidas están relacionadas? Estudiar si la asociación de algunas de estas medidas es diferente en alguno de los grupos.

La construyo solo de la mitad inferior porque la otra mitad es lo mismo pero al revés. ENtonces en la mitad superior estan los datos de correlación

ggpairs(datosEj3,                 # Data frame
        columns = 2:6,        # Columns
        aes(alpha = 0.5, color="cadetblue4"))     # Transparency

Ejercicio 4.

(Base de datos razaperros.xls) Se han registrado respecto de 27 razas de perros las siguientes características: Nombre de la raza

  • Tamaño: con niveles 1- pequeño, 2- mediano y 3- grande
  • Peso: con niveles 1- liviano, 2- medio y 3- pesado
  • Velocidad: con niveles 1- lento, 2- mediano y 3- rápido
  • Inteligencia: con niveles 1 a 3
  • Afectividad: con niveles 1 a 3
  • Agresividad: con niveles 1 a 3

Función: con tres categorías caza, utilitario y compañía.

SETUP

datosEj4 <- readxl::read_excel("razaperros.xls")

(a) Realizar un gráfico de estrellas por raza (utilizando las variables tamaño, peso, velocidad, inteligencia y afectividad.

radar <- datosEj4[2:6]

radar <- as_tibble(lapply(radar,as.numeric))
radar <- cbind(datosEj4[1],radar)
radar <- radar %>% group_by(raza) %>% summarize_all(mean)

radar<- rbind(c("Max",rep(3,5)),
                 c("Min",rep(1,5)),
                  radar)

rownamesRadar <- radar[1]
radar <- radar[-c(1)]
radar <- as_tibble(lapply(radar,as.numeric))
rownames(radar) <- as.vector(t(rownamesRadar))
opar <- par()
# Define settings for plotting in a 3x4 grid, with appropriate margins:
par(mar = rep(0.8,4))
par(mfrow = c(6,5))
# Produce a radar-chart for each student
for (i in 3:nrow(radar)) {
  create_beautiful_radarchart(radar[c(1:2,i),],
                              caxislabels = c(1,2, 3, 4,5),
                              title= row.names(radar)[i])
}
# Restore the standard par() settings
par <- par(opar)

(b) Idem por función.

radar <- datosEj4[2:6]

radar <- as_tibble(lapply(radar,as.numeric))
radar <- cbind(datosEj4[8],radar)
radar <- radar %>% group_by(funcion) %>% summarize_all(mean)

radar<- rbind(c("Max",rep(3,5)),
                 c("Min",rep(1,5)),
                  radar)

rownamesRadar <- radar[1]
radar <- radar[-c(1)]
radar <- as_tibble(lapply(radar,as.numeric))
rownames(radar) <- as.vector(t(rownamesRadar))
opar <- par()
# Define settings for plotting in a 3x4 grid, with appropriate margins:
par(mar = rep(0.8,4))
par(mfrow = c(3,1))
# Produce a radar-chart for each student
for (i in 3:nrow(radar)) {
  create_beautiful_radarchart(radar[c(1:2,i),],
                              caxislabels = c(1,2, 3, 4,5),
                              title= row.names(radar)[i])
}

# Restore the standard par() settings
par <- par(opar)

(c) Idem por agresividad.

radar <- datosEj4[2:6]

radar <- as_tibble(lapply(radar,as.numeric))
radar <- cbind(datosEj4[7],radar)
#radar <- radar %>% mutate(agresividad=recode(agresividad, 
#                         `1`="Male",
#                         `2`="Female"))
radar <- radar %>% group_by(agresividad) %>% summarize_all(mean)

radar<- rbind(c("Max",rep(3,5)),
                 c("Min",rep(1,5)),
                  radar)

rownamesRadar <- radar[1]
radar <- radar[-c(1)]
radar <- as_tibble(lapply(radar,as.numeric))
rownames(radar) <- as.vector(t(rownamesRadar))
opar <- par()
# Define settings for plotting in a 3x4 grid, with appropriate margins:
par(mar = rep(0.8,4))
par(mfrow = c(3,1))
# Produce a radar-chart for each student
for (i in 3:nrow(radar)) {
  create_beautiful_radarchart(radar[c(1:2,i),],
                              caxislabels = c(1,2, 3),
                              title= row.names(radar)[i], seg=2)
}
# Restore the standard par() settings
par <- par(opar)

(d) En el primer gráfico se observan estrellas similares. ¿Le parece que las razas son parecidas?

El tema es que signifaca “parecidas” si lo consideramos en relacion a las caracteristicas analizadas si, pero eso no quiere decir que podamos decir que son parecidas en el resto de los aspectos o que esten relacionadas de alguna manera.

Ejercicio 5. Matriz de covarianzas

(Datos Gorriones.xls)

SETUP

datosEj5 <- readxl::read_excel("Gorriones.xlsx")

Para esta base de datos, interesa:

(a) Dimensión de la base de datos (n= número de observaciones, p= cantidad de variables observadas sobre cada individuo).

hay algo que no debo estar entendiendo…. n=49, p=6 ¿es así de sencillo?

(b) Hallar el vector de medias, la matriz de varianzas y covarianzas y la matriz de correlaciones. ¿Qué características tienen estas matrices?

mediasEj5 <- as_tibble(t(colMeans(datosEj5[2:6])))  
mediasEj5 %>%   kbl(caption = "Vector de medias") %>% kable_classic(full_width =F)
Vector de medias
largototal extension cabeza humero esternon
157.9796 241.3265 31.45918 18.44898 20.82653 
covb <- cov(datosEj5[2:7])
 covb %>%   kbl(caption = "Matriz de covarianzas") %>% kable_classic(full_width =F)
Matriz de covarianzas
largototal extension cabeza humero esternon sobrevida
largototal 13.3537415 13.6109694 1.9220663 1.3510204 2.1922194 -0.5238095
extension 13.6109694 25.6828231 2.7136054 2.1211735 2.6578231 -0.2857143
cabeza 1.9220663 2.7136054 0.6316327 0.3268325 0.4146471 -0.0226190
humero 1.3510204 2.1211735 0.3268325 0.2958844 0.3274235 0.0446429
esternon 2.1922194 2.6578231 0.4146471 0.3274235 0.9828231 -0.0148810
sobrevida -0.5238095 -0.2857143 -0.0226190 0.0446429 -0.0148810 1.0000000 
corb <-cor(datosEj5[2:7], method="pearson")
corb %>%   kbl(caption = "Matriz de correlaciones") %>% kable_classic(full_width =F)
Matriz de correlaciones
largototal extension cabeza humero esternon sobrevida
largototal 1.0000000 0.7349642 0.6618119 0.6796721 0.6051247 -0.1433415
extension 0.7349642 1.0000000 0.6737411 0.7694737 0.5290138 -0.0563781
cabeza 0.6618119 0.6737411 1.0000000 0.7560176 0.5262701 -0.0284605
humero 0.6796721 0.7694737 0.7560176 1.0000000 0.6071711 0.0820712
esternon 0.6051247 0.5290138 0.5262701 0.6071711 1.0000000 -0.0150104
sobrevida -0.1433415 -0.0563781 -0.0284605 0.0820712 -0.0150104 1.0000000

(c) Explicar que representa el elemento m11 de la matriz de varianzas y covarianzas, ídem para el elemento m31.

El elemento m11 representa la varianza de las observaciones del Largo Total, el elemento m31 representa la covarianza entre la cabeza y el largo total.

(d) Explicar que representa el elemento m22 de la matriz de correlaciones,ídem para el elemento m13.

El elemento m22 es la correlacion entre la extensión con si misma, lo cual obviamente da 1. M1.3 es la correlación entre largo total y cabeza

(e) Relacionar los elementos m21, m11ym22 de la matriz de varianzas y covarianzas con el elemento m12 de la matriz de correlaciones.

m11 y m22 de la matriz de covarianzas son las varianzas de largo total(mcv11) y extension (mcv22), y m21 (mcv21) es la covarianza entre esas dos variables. m12 (mcr12) de la matriz de correlación es la correlación entre esas dos variables. Ahora, la correlación de pearson es la covarianza entre dos variables divida las desviaciones estandard de esas dos variables. Entonces tenemos:

\(mcr_{1,2} = \frac{mcv_{2,1}}{\sqrt{mcv_{1,1}*mcv_{2,2}}}\)

(f) Hallar una nueva variable e incorporarla en la base de Gorriones: Diferencia entre el largo total y el largo del húmero. Llamémosla: Diferencia de Largos.

datosEj5["Diferencia de Largos"] <- datosEj5$largototal - datosEj5$humero

(g) Calcular nuevamente el vector de medias y las matrices de varianzas y covarianzas y la matriz de correlaciones de la nueva base de datos. Relacionar el nuevo vector de medias con el anterior.

mediasEj5bis <- as_tibble(t(colMeans(datosEj5[c(2:6,8)])))  
colnames(mediasEj5bis) <- colnames(datosEj5[c(2:6,8)])
mediasEj5bis %>%   kbl(caption = "Vector de medias") %>% kable_classic(full_width =F)
Vector de medias
largototal extension cabeza humero esternon Diferencia de Largos
157.9796 241.3265 31.45918 18.44898 20.82653 139.5306 
covg <- cov(datosEj5[2:7])
covg %>%   kbl(caption = "Matriz de covarianzas") %>% kable_classic(full_width =F)
Matriz de covarianzas
largototal extension cabeza humero esternon sobrevida
largototal 13.3537415 13.6109694 1.9220663 1.3510204 2.1922194 -0.5238095
extension 13.6109694 25.6828231 2.7136054 2.1211735 2.6578231 -0.2857143
cabeza 1.9220663 2.7136054 0.6316327 0.3268325 0.4146471 -0.0226190
humero 1.3510204 2.1211735 0.3268325 0.2958844 0.3274235 0.0446429
esternon 2.1922194 2.6578231 0.4146471 0.3274235 0.9828231 -0.0148810
sobrevida -0.5238095 -0.2857143 -0.0226190 0.0446429 -0.0148810 1.0000000 
corg <- cor(datosEj5[2:7], method="pearson") 
corg %>%   kbl(caption = "Matriz de correlaciones") %>% kable_classic(full_width =F)
Matriz de correlaciones
largototal extension cabeza humero esternon sobrevida
largototal 1.0000000 0.7349642 0.6618119 0.6796721 0.6051247 -0.1433415
extension 0.7349642 1.0000000 0.6737411 0.7694737 0.5290138 -0.0563781
cabeza 0.6618119 0.6737411 1.0000000 0.7560176 0.5262701 -0.0284605
humero 0.6796721 0.7694737 0.7560176 1.0000000 0.6071711 0.0820712
esternon 0.6051247 0.5290138 0.5262701 0.6071711 1.0000000 -0.0150104
sobrevida -0.1433415 -0.0563781 -0.0284605 0.0820712 -0.0150104 1.0000000

mmm…. se me escapa…. es solo una columna mas que es la diferencia de las medias de las otras dos columnas. Es decir que puede calcularse a partir de las columnas del primer vector ¿Éso pregunta?

(h) Hallar la traza de las cuatro matrices. Explicar el significado de cada uno de los resultados. ¿Qué traza/s no aumentan al aumentar una variable? Explique.

trazas5 <- cbind(sum(diag(covb)),sum(diag(corb)),sum(diag(covg)),sum(diag(corg)))
colnames(trazas5) <- c("Covarianza","Correlación","Covarianza nueva","Correlación nueva")
trazas5 %>%   kbl(caption = "Trazas de las matrices") %>% kable_classic(full_width =F)
Trazas de las matrices
Covarianza Correlación Covarianza nueva Correlación nueva
41.9469 6 41.9469 6

… todas varian…la traza de las correlaciones va a sumar uno, ya que es una variable más… y la de varianza también ya que la misma siempre va a ser positiva… me pierdo en que es lo que no varia. Ahora esta claro que la ultima columna es perfectamente calculable con las columnas originales de la primer matriz. Es LD con las otras columnas, pero si yo agrego la variable es una columna mas y la traza cambia.

Ejercicio 6 (Propiedades de la matriz de Covarianzas)

(Datos: recepcionistas.xls).

SETUP

datosEj6 <- readxl::read_excel("recepcionistas.xls")

Para el archivo de se pide:

(a) Calcular el vector de medias e interpretar los valores.

mediasEj6 <- as_tibble(t(colMeans(datosEj6[2:7])))  
colnames(mediasEj6) <- colnames(datosEj6[2:7])
mediasEj6 %>%   kbl(caption = "Vector de medias") %>% kable_classic(full_width =F)
Vector de medias
cord.juez 1 pres.juez1 idiom.juez1 cord.juez 2 pres.juez2 idiom.juez2
81.66667 72.5 56.66667 66.66667 74.33333 56.66667

Claramente en promedio la cordialidad es mejor valorada por el juez 1, en cuanto a la presencia el juez 2 valora ligeramente mejor. No hay diferencias en relación a el idioma.

(b) Hallar las matrices de varianzas y covarianzas y de correlaciones para la submatriz de puntuaciones del primer juez, ídem para el segundo juez. Ídem para el conjunto total.

covb16 <- cov(datosEj6[2:4])

covb16 %>%   kbl(caption = "Matriz de covarianzas Juez 1") %>% kable_classic(full_width =F)
Matriz de covarianzas Juez 1
cord.juez 1 pres.juez1 idiom.juez1
cord.juez 1 56.666667 25.0 6.666667
pres.juez1 25.000000 317.5 130.000000
idiom.juez1 6.666667 130.0 66.666667 
covb26 <- cov(datosEj6[5:7])

covb26 %>%   kbl(caption = "Matriz de covarianzas Juez 2") %>% kable_classic(full_width =F)
Matriz de covarianzas Juez 2
cord.juez 2 pres.juez2 idiom.juez2
cord.juez 2 76.66667 21.33333 -113.33333
pres.juez2 21.33333 199.06667 57.33333
idiom.juez2 -113.33333 57.33333 256.66667 
cov6Mean <- as_tibble(cbind(datosEj6[1],datosEj6[2]+datosEj6[5]/2,datosEj6[3]+datosEj6[6]/2,datosEj6[4]+datosEj6[7]/2))
colnames(cov6Mean) <- c("Candidatas","Cord","Pres","Idiom")
covb36 <- cov(cov6Mean[2:4])
covb36 %>%   kbl(caption = "Matriz de covarianzas total") %>% kable_classic(full_width =F)
Matriz de covarianzas total
Cord Pres Idiom
Cord 132.5 41.0000 -55.0
Pres 41.0 594.2667 253.0
Idiom -55.0 253.0000 207.5

¿querrá decir esto con “el conjunto total”? Entiendo que no, porque quiere trabajar con las propiedades de las matrices, pero “total” ¿sería la suma de los puntajes de ambos jueces?¿el promedio? ..¿Cuál sería la operación de agregación para agrupar? 

corb16 <-cor(datosEj6[2:4], method="pearson")
corb16 %>%   kbl(caption = "Matriz de correlaciones Juez 1") %>% kable_classic(full_width =F)
Matriz de correlaciones Juez 1
cord.juez 1 pres.juez1 idiom.juez1
cord.juez 1 1.0000000 0.1863821 0.1084652
pres.juez1 0.1863821 1.0000000 0.8935464
idiom.juez1 0.1084652 0.8935464 1.0000000 
corb26 <-cor(datosEj6[5:7], method="pearson")
corb26 %>%   kbl(caption = "Matriz de correlaciones Juez 2") %>% kable_classic(full_width =F)
Matriz de correlaciones Juez 2
cord.juez 2 pres.juez2 idiom.juez2
cord.juez 2 1.0000000 0.1726856 -0.8079224
pres.juez2 0.1726856 1.0000000 0.2536432
idiom.juez2 -0.8079224 0.2536432 1.0000000 
corb36 <-cor(cov6Mean[2:4], method="pearson")
corb36 %>%   kbl(caption = "Matriz de correlaciones total") %>% kable_classic(full_width =F)
Matriz de correlaciones total
Cord Pres Idiom
Cord 1.0000000 0.1461118 -0.3317002
Pres 0.1461118 1.0000000 0.7204781
Idiom -0.3317002 0.7204781 1.0000000

(c) ¿Se puede decir que la suma de las dos primeras submatrices darán como resultado la matriz del grupo total? Si no es así por favor explique por qué no.

Comparemos la suma de las dos matrices de covarianza y la covarianza del total

sumaMatriz <- covb16 + covb26 

(sumaMatriz == covb36)  %>%   kbl(caption = "Comparación de suma de matrices covarianza y covarianza del conjunto ") %>% kable_classic(full_width =F)
Comparación de suma de matrices covarianza y covarianza del conjunto
cord.juez 1 pres.juez1 idiom.juez1
cord.juez 1 FALSE FALSE FALSE
pres.juez1 FALSE FALSE FALSE
idiom.juez1 FALSE FALSE FALSE

y ahora con las matrices de correlación

sumaMatrizCor <- corb16 + corb26 

(sumaMatrizCor == corb36)  %>%   kbl(caption = "Comparación de suma de matrices covarianza y covarianza del conjunto ") %>% kable_classic(full_width =F)
Comparación de suma de matrices covarianza y covarianza del conjunto
cord.juez 1 pres.juez1 idiom.juez1
cord.juez 1 FALSE FALSE FALSE
pres.juez1 FALSE FALSE FALSE
idiom.juez1 FALSE FALSE FALSE

La propiedad que entiendo quieren aplicar….

\(cov(x_1+x_2,y) = cov(x_1,y)+cov(x_2,y)\)

NO entiendo que relacionar por que no me queda claro como armar la matriz total

(d) ¿Se cumple esta relación para las trazas? y para el vector de medias? y para los vectores de medianas?

Idem c

Ejercicio 7 (Medidas de Posición y Escala robustas).

(Datos: Internet.2013 )

SETUP

datosEj7 <- readxl::read_excel("internet2013.xls")

(a) Seleccione las variables numéricas del archivo y agregue 5 observaciones que no sean atípicas en forma univariada pero sí lo sean en forma multivariada. Utilice las medidas robustas para detectar estos valores.

(b) Ahora agregue cuatro observaciones que sean outliers pero aparezcan enmascaradas. Utilice estrategias robustas para detectar su presencia.