INTRODUCCIÓN

Elegimos estos datos porque es una saga clásica la cual perdurará a lo largo de los anios, y porque en la misma saga, hay lecciones de vida, la cual cito e un foro de internet:

"Star Wars también muestra el poder del conocimiento, la importancia de vivir de acuerdo a un código de conducta, la importancia de mantener la autodisciplina, la regulación de las emociones, y que el bien y el mal son dos caras de la misma moneda."

Nuestros datos los obtivumos en la libreria dplyr, en la cual tiene integrada una base de datos llamada Star Wars.

Para la realización de nuestro proyecto, tuvimos que realizar una serie de cambios en nuestra base de datos, para tener datos más sencillos con los cuales trabajar; ya que existía una cierta ambigüedad en los datos.

Los cambios realizados fueron los siguientes:

Cambaiamos el color de ojos de los personajes en los cuales se tenían colores mixtos, o colores ambigüos que facilmente podían ser cateforizados en un color determinado.

Por ejemplo:

 Azul-gris -> Azul            (Caso Mixto)
 Obscuros -> Café             (Caso ambigüo)
 Verde, amarillo -> Amarillo  (Caso Mixto)

Esto con el propósito de hacer más sencilla la manipulación de los datos, así como una mejor interpretación de nuestros resultados.

La edad de los personajes. Esto porque, para nosotros el hecho de que un personaje tuviese una edad 41.9, nos resultaba un poco complicado al momento de hacer nuestros análisis estadísticos, por lo que lo considerabamos como si dicho personaje tuviese edad 42.
Agregamos una columna la cual representaba el anio de nacimiento de los personajes, ya que nos resultaba interesante el saber en qué anio pudiesen haber nacido nuestros personajes.

Base de datos original

dplyr::starwars

Cambios realizados a la base de datos

sw <- data.frame(dplyr::starwars)
attach(sw)

  # Color de ojos
ojos <- eye_color
ojos <- gsub("blue-gray", "blue", ojos)
ojos <- gsub("dark", "brown", ojos)
ojos <- gsub("green, yellow", "yellow", ojos)
ojos <- gsub("red, blue", "red", ojos)

sw$eye_color <- ojos #Modificamos la columna con nuestros nuevos datos



# Definimos una nueva columna que representará el anio de nacimiento de los personajes
# se definirán los anios de nacimiento de acuerdo al calendario gregoriano, donde 
# el anio 0 es el nacimiento de Cristo.

# Creamos el anio de nacimiento de los personajes
a <- c( 1997 - sw$birth_year)
sw[, 15] <- a

# Cambiamos los nombres de las columnas
colnames(sw)[7] <- "age"
colnames(sw)[15] <- "birth_year"


# Nos deshacemos de los anios y edades fraccionarias
sw$age <- round(sw$age)
sw$birth_year <- round(sw$birth_year)

# Reordenamos la base de datos
sw <- sw[c("name", "height","mass","birth_year","age","eye_color",
           "sex", "gender","species", "hair_color","skin_color",
           "homeworld","films","vehicles",  "starships")]

Veamos nuestra nueva base de datos:

ESCALAS DE MEDICIÓN

NOMINAL

Sexo Podemos categorizar a los personajes por su sexo.
Género Puesto que puede haber aliens, se puede dar el caso en el que no podamos identificar su genero.
Especie Dado que hay aliens, es importante saber la especie de los seres vivos en la saga.

Nuestras variables nominales serán: sexo, gen, especie, respectivamente.

sexo <- sw$sex         
gen <- sw$gender      
especie <- sw$species

ORDINAL

La jerarquia de nuestros resultados está determinada por la rareza del color de los ojos.

black < brown < hazel < blue < orange < yellow < red < pink < white < gold < unknown

Nuestra variable ordinal sera: o_ojos.

ojos <- sw$eye_color

# Vamos a categorizar y ordenar a los tipos de ojos:

# Definimos la jerarquía
lvl <- c("black" , "brown" , "hazel" , "blue" , "orange" , 
         "yellow" , "red" , "pink" , "white" , "gold" , "unknown")


#Creamos las categorías para los ojos
ojosf <- factor(ojos, levels = lvl)


# Implementamos la jerarquía de los datos

o_ojos <- ordered(ojosf,       # Con este vector de factores
                  levels=lvl)  # Ordenando de menor a mayor.

INTERVALO

Tomamos el anio de nacimiento como escala de medicion de intervalo dado que el anio 0, no significa ausencia de los anios; depende de que fecha se tome como el “inicio del tiempo”.

Nuestra variable de intervalo será: anios.

anios <- sw$birth_year

RAZÓN

Elegimos a la altura (height) y peso (mass) como escala de medicion de razon porque en ellas se establece una metrica con un 0 absoluto, en la cual podemos medir de manera precisa los datos relacionados con la altura y peso de los personajes.

Nuestras variables de razón serán: alt y peso .

alt <- sw$height
peso <- sw$mass

TABLAS DE FRECUENCIAS

FRECUENCIAS ABSOLUTAS (fa)

Estas contabilizan las ocurrencias de un evento. En este caso en particular, podemos saber cuántos personajes pertenecen a distintas categorias, ya sea por sexo, color de ojos o anios de nacimiento.

# CUALITATIVA NOMINAL

(fa_sexo <- table(sexo))

## sexo
##         female hermaphroditic           male           none 
##             16              1             60              6

Aquí podemos observar que en la saga se Star Wars, hay una mayor población de personajes masculinos, que de femeninos.

# CUALITATIVA ORDINAL

(fa_ojos <- table(o_ojos))

## o_ojos
##   black   brown   hazel    blue  orange  yellow     red    pink   white    gold 
##      10      22       3      20       8      12       6       1       1       1 
## unknown 
##       3

A su vez, vemos que el color de ojos más común entre los personajes es el color café.

# CUANTITATIVA EN LA ESCALA DE INTERVALO

(fa_anios <- table(anios))

## anios
## 1101 1397 1797 1885 1895 1905 1906 1915 1925 1930 1931 1933 1935 1939 1940 1943 
##    1    1    1    1    1    2    1    2    2    1    1    1    1    1    1    1 
## 1944 1945 1949 1950 1951 1953 1955 1956 1957 1960 1964 1966 1968 1973 1975 1976 
##    1    2    2    1    1    1    2    1    1    1    1    2    1    1    1    1 
## 1978 1982 1989 
##    2    1    1

Un dato curioso es que, si midieramos los años de nacimiento con base en nuestro sistema de años, tendríamos que el primer personaje de la saga, hubiese nacido en el año 1,101 D.C.

FRECUENCIAS RELATIVAS (fr)

Indica la proporcion de ocurrencia de los eventos.

# CUALITATIVA NOMINAL

(fr_sexo <- fa_sexo/sum(fa_sexo))

## sexo
##         female hermaphroditic           male           none 
##     0.19277108     0.01204819     0.72289157     0.07228916

Comparando con nuestras observaciones anteriores, podemos ver la relación tienen los sexos de los personajes con relación a la población total de la saga.

En el cual, si nos interesa tomar una muestra aleatoria de personajes de cualquier tamaño, será más probable que en dicha muestra, tengamos un mayor número de personajes varones que de personajes hermafroditas.

# CUALITATIVA ORDINAL 

(fr_ojos <- fa_ojos/sum(fa_ojos))

## o_ojos
##      black      brown      hazel       blue     orange     yellow        red 
## 0.11494253 0.25287356 0.03448276 0.22988506 0.09195402 0.13793103 0.06896552 
##       pink      white       gold    unknown 
## 0.01149425 0.01149425 0.01149425 0.03448276

De misma forma que el caso anterior, si tomamos una muestra de cualquier tamaño (distinta de cero) de nuestra población, será más probable que prevalezca el número de personajes con color de ojos café

# CUANTITATIVA EN LA ESCALA DE INTERVALO 

(fr_anios <- fa_anios/sum(fa_anios))

## anios
##       1101       1397       1797       1885       1895       1905       1906 
## 0.02325581 0.02325581 0.02325581 0.02325581 0.02325581 0.04651163 0.02325581 
##       1915       1925       1930       1931       1933       1935       1939 
## 0.04651163 0.04651163 0.02325581 0.02325581 0.02325581 0.02325581 0.02325581 
##       1940       1943       1944       1945       1949       1950       1951 
## 0.02325581 0.02325581 0.02325581 0.04651163 0.04651163 0.02325581 0.02325581 
##       1953       1955       1956       1957       1960       1964       1966 
## 0.02325581 0.04651163 0.02325581 0.02325581 0.02325581 0.02325581 0.04651163 
##       1968       1973       1975       1976       1978       1982       1989 
## 0.02325581 0.02325581 0.02325581 0.02325581 0.04651163 0.02325581 0.02325581

Aquí podemos notar que casi todos los años se distribuyen de manera uniforme/equiprobable, exceptuando por 3 años de nacimiento.

TABLAS DE FRECUENCIA ACUMULADA (fac)

Se asemeja a como se podrian distribuir (aleatoriamente) nuestras variables

# CUALITATIVA ORDINAL 
(fac_ojos<-cumsum(fr_ojos))

##     black     brown     hazel      blue    orange    yellow       red      pink 
## 0.1149425 0.3678161 0.4022989 0.6321839 0.7241379 0.8620690 0.9310345 0.9425287 
##     white      gold   unknown 
## 0.9540230 0.9655172 1.0000000

#CUANTITATIVA EN LA ESCALA DE INTERVALO
(fac_anios<-cumsum(fr_anios))

##       1101       1397       1797       1885       1895       1905       1906 
## 0.02325581 0.04651163 0.06976744 0.09302326 0.11627907 0.16279070 0.18604651 
##       1915       1925       1930       1931       1933       1935       1939 
## 0.23255814 0.27906977 0.30232558 0.32558140 0.34883721 0.37209302 0.39534884 
##       1940       1943       1944       1945       1949       1950       1951 
## 0.41860465 0.44186047 0.46511628 0.51162791 0.55813953 0.58139535 0.60465116 
##       1953       1955       1956       1957       1960       1964       1966 
## 0.62790698 0.67441860 0.69767442 0.72093023 0.74418605 0.76744186 0.81395349 
##       1968       1973       1975       1976       1978       1982       1989 
## 0.83720930 0.86046512 0.88372093 0.90697674 0.95348837 0.97674419 1.00000000

TABLAS DE FRECUENCIAS COMPLETAS

CONTIENEN LOS DATOS OBTENIDOS PREVIAMENTE (FR, FA, FAC)

# Tabla 1: Sexo
Tabla_De_FrecuenciasCompleta <- data.frame(cbind (fa_sexo,fr_sexo ))  
colnames(Tabla_De_FrecuenciasCompleta)<- c("Frecuencia Absoluta","Frecuencia Relativa")

Tabla_De_FrecuenciasCompleta

# Tabla 2: Color de ojos
Tabla_De_FrecuenciasCompleta2 <- data.frame(cbind (fa_ojos,fr_ojos, fac_ojos  ))  
colnames(Tabla_De_FrecuenciasCompleta2)<- c("Frecuencia Absoluta","Frecuencia Relativa","Frecuencia Acumulada")

Tabla_De_FrecuenciasCompleta2

# Tabla 3: Años de nacimiento
Tabla_De_FrecuenciasCompleta3 <- data.frame(cbind (fa_anios,fr_anios, fac_anios  ))  
colnames(Tabla_De_FrecuenciasCompleta3)<- c("Frecuencia Absoluta","Frecuencia Relativa","Frecuencia Acumulada")

Tabla_De_FrecuenciasCompleta3

GRÁFICAS DE BARRAS

Las graficas de barras representan las frecuencias (o frecuencias relativas) de las diferentes categorÍas.

Nos pareció interesante el hacer un análisis de las edades de los personajes, por lo que hicimos 2 tipos de gráficas de barras.

La primer gráfica fue sencilla para darnos una idea de cómo podrían verse los personajes, mientras que en la segunda, decidimos segmentar a nuestra población por intervalos de edad más pequeños, para conocer mejor la frecuencia de edades de nuestros personajes.

library("viridis") # Esta es una librería que nos permite tener colores interesantes

## Loading required package: viridisLite

b<-sort(sw$age, decreasing = F) # Ordenamos las edades de menor a mayor

b1<-length(b[b<50])           
b2<-length(b[50<b & b<100])
b3<-length(b[100<b])

edades <- c(b1,b2,b3)
names(edades) <- c("Joven","Adulto","Extraordinario")

barplot(edades,
        main = "Edad de\n los personajes",
        horiz = F,
        col = viridis(n = 3,option = "D"),
        ylab = "Frecuencia",
        xlab = "Rango de Edades" )

Dividimos a nuestra población en 3 secciones: Dado que en la población existen extraterrestres, la comparación de edades la decidimos hacer de la siguiente manera, esto porque hay personajes que pueden llegar a tener más de 200 años de existencia, algo que para nosotros sería inhumano.

Personajes que tuviesen menos de 50 años: los denominamos “Jóvenes”.
Personajes cuya edad rondara entre los 50 y 100 años los denominamos “Adultos”.
Personajes cuya edad fuera mayor a 100 los denominamos “Extraordinarios”.

Dada a nuestra interpretacion de edades, podemos concluir que en el mundo de Star Wars, hay más personajes jóvenes en la población de la saga.

# Barras 2: Con más intervalos
#Elementos necesarios para la grafica de barras __________________________________________

edadess <- c() #edades separadas por intervalos de 20 en 20

for (i in 1:45) {
  edadess[i] <- length(b[(i-1)*20<=b & b<=i*20])
}

d <- c() #d:= nombres de los intervalos
for (i in 1:45) {
  d[i] <- paste( "[",((i-1)*20), "-", ((i)*20), "]" )
}

d <- gsub(pattern = " ",replacement = "",x = d) #Le quitamos los espacios de la función paste
names(edadess) <- c(d)

#Fin de elementos necesarios para la grafica de barras __________________________________________



#Gráfica de barras:
c<- edadess[edadess!=0] #c:= edades divididas en intervalos de 20, sin intervalos vacíos

barplot(c,
        main = "Edad de\n los personajes",
        horiz = F,
        col = viridis(n = 11,option = "D"),
        ylab = "Frecuencia",
        xlab = "Rango de Edades" )

En la tabla podemos observar que hay una mayor frecuencia de personajes que tienen edades que van de los 40 a los 60 años alienigenas.

DIAGRAMA DE TALLO Y HOJAS

Analizaremos el peso de nuestros personajes

p1 <- peso
p1 <- as.numeric(na.omit(p1))

p1<-sort(p1,decreasing = F)
# p1[max(p1)] para que nos diera la posicion del que pesaba más

p1[59] <- NA # Quitamos el valor atipico extremo

#Graficamos el diagrama de tallo y hojas de los pesos de nuestros personajes:
stem(p1, scale = 2)

## 
##   The decimal point is 1 digit(s) to the right of the |
## 
##    1 | 57
##    2 | 0
##    3 | 22
##    4 | 055889
##    5 | 005567
##    6 | 568
##    7 | 455577789999
##    8 | 0000002234445789
##    9 | 0
##   10 | 2
##   11 | 023
##   12 | 0
##   13 | 66
##   14 | 0
##   15 | 9

Concluimos que la mayoria de los pesos de los personajes se encuentran en un intervalo de [80,90) kg.

GRÁFICA DE PIE

Nos inetesó ver la proporción de los colores de los ojos de los personajes en la población

pie(fa_ojos,
    main= "COLOR DE OJOS DE LOS PERSONAJES",
    col = c("black",
            "#472001", #brown
            "#8E7618", #hazel
            "#0197F6", #blue
            "#ff9900", #orange
            "yellow",  #yellow
            "red" ,    #red
            "pink",    #pink
            "white" ,  #white
            "#FFE66E" ,#gold   
            "#68707C"), #gray,
    radius = 1
)

Donde la proporcion de los colores está dada por la frecuencia absoluta del color de ojos

## o_ojos
##   black   brown   hazel    blue  orange  yellow     red    pink   white    gold 
##      10      22       3      20       8      12       6       1       1       1 
## unknown 
##       3

HISTOGRAMAS

Los histogramas fueron hechos para analizar el comportamiento del peso de los personajes.

# Caso 1: Número de intervalos muy pequeños
hist(p1, breaks = 5, main = "Intervalos muy pequeños",
     xlab = "Pesos", ylab = "Frecuencias",
     col = viridis(n = 7,option = "D"))

# Caso 2: Número de intervalos adecuados
hist(p1, breaks = "Sturges", main = "Adecuados (Sturges)",
     xlab = "Pesos", ylab = "Frecuencias",
     col = viridis(n = 9,option = "D"))

# Caso 3: Número de intervalos muy grandes
hist(p1, breaks = 59, main =  "Intervalos muy grandes",
     xlab = "Pesos", ylab = "Frecuencias",
     col = viridis(n = 50,option = "D"))

Podemos notar como la correcta eleccion de los intervalos es importante para la visualización de los datos; puesto que en caso de dar los intervalos erróneos podemos perder información acerca del evento analizado.

MEDIDAS DE TENDENCIA CENTRAL Y DISPERSIÓN

Decidimos analizar dos tipos de comportamientos en los datos.

Donde tuvieramos datos muy dispersos (edades)
Donde tuveieramos datos menos dispersos (alturas)

Análisis para datos muy dispersos

##             Mediana               Media                 IQR Desviación Estándar 
##             52.0000             87.5814             37.0000            154.6857

Análisis para datos menos dispersos

DIAGRAMA DE CAJA Y BRAZOS

boxplot(na.omit(alt), 
        horizontal = T,
        main = "Dispersión de las estaturas",
        xlab = "Estaturas",
        col = "cyan")

Veamos los valores atipicos moderados y extremos que tenemos en nuestra población analizando las alturas.

-Valores atipicos moderados

VALORES ATIPICOS MODERADOS

Intervalo izquierdo:

#Valores atipicos moderados de la izquierda.

height[(q1-(1.5)*(iqr)) <= height & height < q1] %>%
  na.omit() %>% as.numeric()-> vam1

(length(vam1)) # Número de elementos que caen en el intervalo izquierdo

## [1] 11

vam1         # Los valores que cumplen con estar en el intervalo

##  [1] 150 165 150 160 137 163 163 157 166 165 165

Intervalo derecho:

#Valores atipicos moderados de la derecha
height[q3 < height & height < (q3+(1.5)*(iqr))] %>%
  na.omit() %>% as.numeric()-> vam2

length(vam2) # Número de elementos que caen en el intervalo

## [1] 15

vam2         # Los valoresque cumplen con estar en el intervalo

##  [1] 202 200 193 196 224 206 198 196 196 193 198 213 193 216 206

VALORES ATIPICOS EXTREMOS

Intervalo izquierdo:

# Valores atipicos extremos a la izquierda
height[ min(alt) <= height & height < (q1-(1.5)*(iqr))] %>%
  na.omit() %>% as.numeric()-> vax1

length(vax1) # Número de elementos que caen en el intervalo izquierdo

## [1] 9

vax1         # Los valoresque cumplen con estar en el intervalo

## [1]  96  97  66  88 112  94 122  79  96

#Valores atipicos extremos de la derecha
height[(q3+(1.5)*(iqr)) < height & height <= max(alt)] %>%
  na.omit() %>% as.numeric()-> vax2

Intervalo derecho:

length(vax2) # Número de elementos que caen en el intervalo derecho

## [1] 4

vax2         # Los valoresque cumplen con estar en el intervalo

## [1] 228 264 229 234

Podemos ver que nuestros datos tienden a estar cargados un poco hacia la derecha, pero a pesar de ello tiende a ser simétrica la distribución de las alturas. También podemos concluir que los valores que modifican a nuestra distribución están dados por personajes cuya estatura es menor a 1.31 metros que es el brazo izquierdo de nuestro diagrama.

Esto puede ser por los robots que acompañana nuestros personajes en las sagas.

OTRAS MEDIDAS DE RESUMEN

Analizaremos a las estaturas de nuestros personajes. Obtendremos la curtosis, y el sesgo que tienen las estaturas de la población.

Curtosis:

(kurtosis(vector_de_alturas))

## [1] 2.096965

Dado que el valor de la curtosis fué positivo, podemos concluir que es de tipo LEPTOCÚRTICA

Sesgo:

skewness(vector_de_alturas)

## [1] -1.064592

Dado que el sesgo fue negativo, podemos concluir que la distribucion está más concentrada a la derecha.

De esta manera, hemos decidido visualizar los datos obtenidos, para sustentar nuestros resultados, mencionados previamente:

DIAGRAMA DE DISPERSIÓN

En primera instancia se hace el diagrama de dispersión para ver los datos. Se teorizó que habría una correlación entre los pesos y las estaturas, pero muy baja debido a los datos atípicos extremos.

Por lo que, pensamos que en caso de eliminar los datos atipicos extremos, tendremos una mayor correlación entre los pesos y las alturas de los personajes.

Caso 1: Considerando los datos atipicos extremos

(sw_corr <- ggplot(sw) + 
    geom_jitter(aes(x = mass, y = height), na.rm = T) + 
    
    labs(x = "Peso", y = "Altura",
         title = "Relación altura vs peso")+
    
    geom_smooth(aes(x=mass, y= height),method = "lm", na.rm = T))

## `geom_smooth()` using formula 'y ~ x'

Calculemos su coeficiente de correlación por el método de Pearson:

aux<-!(is.na(sw$mass & sw$height) ) #Nos desharemos de aquellos valores que tengan NA

p2<-sw$height[aux]
p3<-sw$mass[aux]

cor(p2,p3,method="pearson") #Calculamos la correlación y, en efecto, es muy baja

## [1] 0.1338842

Como se planteó al inicio vemos que sí existe una corelación entre los datos existe, pero es verdaderamente baja, debido a que el dato atípico extremo del peso nos modifica la relación que tenemos.

Por lo que, procederemos a eliminar ese dato atípico extremo.

Caso 2: Sin considerar los valores atípicos extremos

Restringimos la gráfica quitando el valor extremo (que es de un personaje llamado Jabba Desilijic Tiure, o mejor conocido como Jabba the Hutt, que pesa más de una tonelada y mide el 12.88% de lo que pesa)

(sw_corr <- ggplot(sw%>% filter(mass<1000)) + 
    
    geom_jitter(aes(x = mass, y = height), na.rm = T) + 
      labs(x = "Peso", y = "Altura",
         title = "Relación altura vs peso")+
    
    geom_smooth(aes(x=mass, y= height),method = "lm", na.rm = T))

## `geom_smooth()` using formula 'y ~ x'

Calculemos la nueva correlación de nuestros datos, por el método de Pearson:

p2[15] <- NA
aux2 <-!(is.na(p2 & p3)) # Omitimos el peso gigantesco de Jabba (el dato atípico)

p4 <- p2[aux2]

p5 <- p3[aux2]

cor(p4,p5,method="pearson")

## [1] 0.7612612

Notamos una correlación más alta; es decir, sin el dato atípico, sí hay una correlación entre las alturas y los pesos, es decir, están cercanas a tener una relación lineal.

Estadística Descriptiva

Ruben Núnez

15/11/2020