Daniel Santiago Ballesteros Rocha ()
Alan Joel Lizarazo Canon ()
Nataly Pascuales Gomez ()

En el presente trabajo, se podra evidenciar el analisis estadistico realizado a una muestra de 10.000 datos de la base de datos “Diamantes”. Se presentan diferentes tipos de graficos tales como, barras, histogramas, dispersion, de cajas, entre otros, que facilitan el analisis y estudio de los datos; ademas, se ponen en practica los conceptos aprendidos acerca de la estadistica descriptiva, empleando los conceptos de: medidas de tendencia central, medidas de posicion, variabilidad, asimetria y curtosis. De igual manera, se ponen en practica los conceptos y aprendizajes obtenidos en el programa R, pues el trabajo es realizado mediante comandos en dicho programa, lo que facilita el manejo y comprension de la base de datos.

Datos

A partir de la base de datos “Diamantes” con un total de 53940 datos, se tomaron 1000 datos con 10 variables las cuales son:

  • Precio
  • Quilate
  • Corte
  • Color
  • Claridad
  • Profundidad
  • Tabla
  • x
  • y
  • z

Y se encuentran organizadas en la siguiente tabla de datos:

muestra1
View(muestra1)

Se realizara el analisis estadistico mediante estadistica descriptiva de cada una de las variales mencionadas anteriormente

Precio

Esta variable corresponde al precio en dolares americanos de cada diamante.

Medidas de tendencia central

Media:

mean(precio) 
## [1] 3874.608

Moda:

mfv(precio) 
## [1] 911

Mediana:

median(precio) 
## [1] 2506

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(precio), Mediana = median(precio), Moda = mfv(precio)),
                             main = 'Media, Mediana y Moda (Variable Precio)', ylab = 'Precio (USD)', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,4000))

Como se puede observar, para la variable precio la media es igual a $3874.61, la mediana $2560 y la moda $911

Medidas de dispersion

Rango

range(precio)
## [1]   369 18760

Varianza

var(precio)
## [1] 14406457

Desviacion estandar:

sd(precio)
## [1] 3795.584

Coeficiente de variacion

sd(precio)/mean(precio)
## [1] 0.9796046

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = precio)) +
  geom_point(col = "green") +
    theme_bw() +
      labs(title = "grafico de dispersion", subtitle = "Precio de diamantes", y = "Precio (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = precio))+
    theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "Precio de diamantes", x = "Precio (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = precio)) +
    geom_qq(color="green") +
    theme_bw()+
  labs(title = "QQ plot", subtitle = "Precio de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

kurtosis(precio)
## [1] 5.237209

Quilate

Esta variable corresponde al peso del diamante

Medidas de tendencia central

Media:

mean(quilate) 
## [1] 0.79611

Moda:

mfv(quilate) 
## [1] 0.3

Mediana:

median(quilate) 
## [1] 0.71
summary(quilate)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.2300  0.4000  0.7100  0.7961  1.0400  3.5000

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(quilate), Mediana = median(quilate), Moda = mfv(quilate) ),
                             main = 'Media, Mediana y Moda (Variable Quilate)', ylab = 'Quilate', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,0.8))

Para la variable Quilate, la media es igual a 0.80, la mediana es igual a 0.71 y la moda es igual a 0.30.

Medidas de dispersion

Rango

range(quilate)
## [1] 0.23 3.50

Varianza

var(quilate)
## [1] 0.2114943

Desviacion estandar:

sd(quilate)
## [1] 0.4598851

Coeficiente de variacion

sd(quilate)/mean(quilate)
## [1] 0.5776652

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = quilate)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "quilate de diamantes", y = "quilate (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = quilate))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "quilate de diamantes", x = "quilate (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = quilate)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "quilate de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

Calidad del corte

Esta variable corresponde a la calidad del corte: Regular, Bueno, Muy bueno, Premium, Ideal.

Medidas de tendencia central

En el caso de la variable corte, al ser una variable cualitativa, vamos a comparar la media, mediana y moda, con respecto a la variable precio, es decir, agruparemos los datos de la variable corte y frente a ellos se evidencira el promedio, la mediana y la moda de la variable precio que le corresponde.

Corte_Media <- muestra1 %>%
  group_by(Corte = corte) %>%
  summarise(Media = mean(precio))
Corte_Media
Corte_Mediana <- muestra1 %>%
  group_by(Corte = corte) %>%
  summarise(Mediana = median(precio))
Corte_Mediana
Corte_Moda <- muestra1 %>%
  group_by(Corte = corte) %>%
  reframe(Moda = mfv(precio))
Corte_Moda

Como se puede observar, la variable Corte, presenta varios datos en la moda para el precio, estos datos se pueden evidenciar en la tabla “Corte_Moda”.

Color

Esta variable corresponde al color del diamante: D (mejor), E, F, G, H, I a J (peor)

Medidas de tendencia central

Ahora para la variable color, vamos a realizar el mismo ejercicio que con la variable corte, solo que en este caso, se calcularán la media, mediana y moda con respecto a la variable profundidad.

Color_Media <- muestra1 %>%
  group_by(Color = color) %>%
  summarise(Media = mean(profundidad))

Color_Media
Color_Mediana <- muestra1 %>%
  group_by(Color = color) %>%
  summarise(Mediana = median(profundidad))

Color_Mediana
Color_Moda <- muestra1 %>%
  group_by(Color = color) %>%
  reframe(Moda = mfv(profundidad))

Color_Moda

En este caso, se evidencia que no hay tantos datos para la moda cuando comparamos con la variable profundidad, además, la media y mediana sólo se diferencian por decimales.

Claridad

Medidas de tendencia central

Esta variable corresponde a la medida de que tan claro es el diamante: I1 (peor), SI1, SI2, VS1, VS2, VVS1, VVS2, IF (mejor)

Para nuestra última variable cualitativa, claridad, se repetirá el mismo ejercicio realizado con las dos anteriores (Corte y Color), en este caso, la compararemos con la variable X (Largo en mm del diamante)

Claridad_Media <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Media = mean(x))

Claridad_Media
Claridad_Mediana <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Mediana = median(x))

Claridad_Mediana
Claridad_Moda <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  reframe(Moda = mfv(x))

Claridad_Moda

Para esta última variable cuantitativa, se puede decir que, al compararla con la variable X, presenta una cantidad de datos intermedia en la moda, es decir, hay varios datos que tienen diferentes datos que se repiten ingual cantidad de veces, pero no tanto como en la variable corte al compararla con la variable precio; pero si más que en la variable color al compararla con la variable profundidad.

Profundidad

Esta variable corresponde al porcentaje de la profundidad total del diamante

Medidas de tendencia central

Media:

mean(profundidad) 
## [1] 61.7114

Moda:

mfv(profundidad) 
## [1] 62.2

Mediana:

median(profundidad) 
## [1] 61.8
summary(profundidad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   56.80   61.00   61.80   61.71   62.50   68.90

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(profundidad), Mediana = median(profundidad), Moda = mfv(profundidad) ),
                             main = 'Media, Mediana y Moda (Variable Profundidad)', ylab = 'Profundidad', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,70))

En el caso de la variable profundidad,los valores para la media, la mediana y la moda no son tan dispersos, pues sus valores son 61.71, 61.80 y 62.20 respectivamente.

Medidas de dispersion

Rango

range(profundidad)
## [1] 56.8 68.9

Varianza

var(profundidad)
## [1] 1.954565

Desviacion estandar:

sd(profundidad)
## [1] 1.398057

Coeficiente de variacion

sd(profundidad)/mean(profundidad)
## [1] 0.02265477

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = profundidad)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "profundidad de diamantes", y = "profundidad (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = profundidad))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "profundidad de diamantes", x = "profundidad (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = profundidad)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "profundidad de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

Tabla

Esta variable corresponde al ancho de la parte superior del diamante con relación a su punto mas ancho

Medidas de tendencia central

Media:

mean(tabla) 
## [1] 57.3678

Moda:

mfv(tabla) 
## [1] 56

Mediana:

median(tabla) 
## [1] 57
summary(tabla)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   49.00   56.00   57.00   57.37   59.00   67.00

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(tabla) , Mediana = median(tabla), Moda = mfv(tabla) ),
                             main = 'Media, Mediana y Moda (Variable Tabla)', ylab = 'Tabla', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,60))

Al igual que para la variable profundidad, se puede analizar que los resultados de la media (57.37), la mediana (57) y la moda (56),no presentan un alto grado de dispersión.

Medidas de dispersion

Rango

range(tabla)
## [1] 49 67

Varianza

var(tabla)
## [1] 4.875298

Desviacion estandar:

sd(tabla)
## [1] 2.208008

Coeficiente de variacion

sd(tabla)/mean(tabla)
## [1] 0.03848863

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = tabla)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "tabla de diamantes", y = "tabla (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = tabla))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "tabla de diamantes", x = "tabla (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = tabla)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "tabla de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

x

Esta variable corresponde al largo en milimetros del diamante

Medidas de tendencia central

Media:

mean(x) 
## [1] 5.74011

Moda:

mfv(x) 
## [1] 4.42

Mediana:

median(x) 
## [1] 5.74
summary(x)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   3.870   4.750   5.740   5.740   6.532   9.650

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(x), Mediana = median(x), Moda = mfv(x)),
                             main = 'Media, Mediana y Moda (Variable X)', ylab = 'X (Largo en mm del diamante)', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,6))

En este caso, el dato que presenta dispersión es la moda, pues como se puede apreciar en el Grafico de barras es un poco menor que los valores de la media y la mediana, estos son: media = 5.74, mediana = 5.74 y moda = 4.42

Medidas de dispersion

Rango

range(x)
## [1] 3.87 9.65

Varianza

var(x)
## [1] 1.192077

Desviacion estandar:

sd(x)
## [1] 1.091823

Coeficiente de variacion

sd(x)/mean(x)
## [1] 0.1902094

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = x)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "x de diamantes", y = "x (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = x))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "x de diamantes", x = "x (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = x)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "x de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

y

Esta variable corresponde al ancho en milimetros del diamante

Medidas de tendencia central

Media:

mean(y) 
## [1] 5.74662

Moda:

mfv(y) 
## [1] 4.29 4.33 5.20

Mediana:

median(y) 
## [1] 5.745
summary(y)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   3.900   4.760   5.745   5.747   6.522   9.590
barplot(c(Media = mean(y), Mediana = median(y), Moda = mfv(y)),
                             main = 'Media, Mediana y Moda (Variable Y)', ylab = 'Y (Ancho en mm del diamante)', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF", "#FFBBFF", "#FFBBFF"), ylim = c(0,6))

Este es un caso bastante particular, ya que además de que los datos no tienen un alto grado de dispersión, se presentan 3 datos para la moda, como se evidencia en el cálculo matemático y en el Grafico. Los datos obtenidos son: media = 5.75, mediana = 5.74 y moda = 4.29, 4.33, 5.20.

Medidas de dispersion

Rango

range(y)
## [1] 3.90 9.59

Varianza

var(y)
## [1] 1.178908

Desviacion estandar:

sd(y)
## [1] 1.085775

Coeficiente de variacion

sd(y)/mean(y)
## [1] 0.1889416

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = y)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "y de diamantes", y = "y (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = y))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "y de diamantes", x = "y (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = y)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "y de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

z

Esta variable corresponde a la profundidad en milimetros del diamante

Medidas de tendencia central

Media:

mean(z) 
## [1] 3.57328

Moda:

mfv(z) 
## [1] 2.7

Mediana:

median(z) 
## [1] 3.53
summary(z)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.390   2.940   3.530   3.573   4.040  31.800

Las tres variables se pueden comparar en el siguiente Grafico de barras:

barplot(c(Media = mean(z), Mediana = median(z), Moda = mfv(z)),
                             main = 'Media, Mediana y Moda (Variable Z)', ylab = 'Z (Profundidad en mm del diamante)', 
                             col = c("#7FFFD4", "#FFAEB9", "#FFBBFF"), ylim = c(0,4))

Finalmente, los resultados obtenidos para esta variable fueron, media igual a 3.57, mediana igual a 3.53 y moda igual a 2.70, se puede apreciar que al igual que en casos anteriores, el único valor que está un poco disperso es el de la moda.

Medidas de dispersion

Rango

range(z)
## [1]  2.39 31.80

Varianza

var(z)
## [1] 1.24825

Desviacion estandar:

sd(z)
## [1] 1.117251

Coeficiente de variacion

sd(z)/mean(z)
## [1] 0.3126683

Grafico de dispersion

ggplot(muestra1, aes(x = as.numeric(rownames(muestra1)), y = z)) +
  geom_point(col = "green") +
  theme_bw() +
  labs(title = "grafico de dispersion", subtitle = "z de diamantes", y = "z (USD)", x= "Diamantes")

Histograma

ggplot(muestra1, aes(x = z))+
  theme_bw() +
  geom_histogram(fill ="blue") + 
  labs(title = "Histograma", subtitle = "z de diamantes", x = "z (USD)", y= "Frecuencia")

QQ Plot

ggplot(muestra1, aes(sample = z)) +
  geom_qq(color="green") +
  theme_bw()+
  labs(title = "QQ plot", subtitle = "z de diamantes", x = "Cuantiles teoricos", y= "Cuantiles de la muestra")

Analisis de relaciones y comparaciones

Medidas de posicion

En cuanto a las medidas de posición, calcularemos los cuantiles, los cuales dividen la función de distribución de una variabele aleatoria en intervalos regulares. Para ser exactos, calcularemos los cuartiles (Q1, Q2, Q3), de las variables cuantitativas de la base de datos.

Cuartiles de la variable precio:
Q1P = quantile(precio,0.25,type = 6)
Q1Pz = paste("El primer cuartil de la variable precio es",Q1P)
Q1Pz 
## [1] "El primer cuartil de la variable precio es 1007"
Q2P = quantile(precio,0.50,type = 6)
Q2Pz = paste("El segundo cuartil de la variable precio es",Q2P)
Q2Pz
## [1] "El segundo cuartil de la variable precio es 2506"
Q3P = quantile(precio,0.75,type = 6)
Q3Pz = paste("El tercer cuartil de la variable precio es",Q3P)
Q3Pz
## [1] "El tercer cuartil de la variable precio es 5284.5"
Cuartiles de la variable quilate:
Q1Q = quantile(quilate,0.25,type = 6)
Q1Qz = paste("El primer cuartil de la variable quilate es",Q1Q)
Q1Qz
## [1] "El primer cuartil de la variable quilate es 0.4"
Q2Q = quantile(quilate,0.50,type = 6)
Q2Qz = paste("El segundo cuartil de la variable quilate es",Q2Q)
Q2Qz 
## [1] "El segundo cuartil de la variable quilate es 0.71"
Q3Q = quantile(quilate,0.75,type = 6)
Q3Qz = paste("El tercer cuartil de la variable quilate es",Q3Q)
Q3Qz 
## [1] "El tercer cuartil de la variable quilate es 1.04"
Cuartiles de la variable profundidad:
Q1PR = quantile(profundidad,0.25,type = 6)
paste("El primer cuartil de la variable profundidad es",Q1PR)
## [1] "El primer cuartil de la variable profundidad es 61"
Q2PR = quantile(profundidad,0.50,type = 6)
paste("El segundo cuartil de la variable profundidad es",Q2PR)
## [1] "El segundo cuartil de la variable profundidad es 61.8"
Q3PR = quantile(profundidad,0.75,type = 6)
paste("El tercer cuartil de la variable profundidad es",Q3PR)
## [1] "El tercer cuartil de la variable profundidad es 62.5"
Cuartiles de la variable tabla:
Q1T = quantile(tabla,0.25,type = 6)
paste("El primer cuartil de la variable tabla es",Q1T)
## [1] "El primer cuartil de la variable tabla es 56"
Q2T = quantile(tabla,0.50,type = 6)
paste("El segundo cuartil de la variable tabla es",Q2T)
## [1] "El segundo cuartil de la variable tabla es 57"
Q3T = quantile(tabla,0.75,type = 6)
paste("El tercer cuartil de la variable tabla es",Q3T)
## [1] "El tercer cuartil de la variable tabla es 59"
Cuartiles de la variable X:
Q1X = quantile(muestra1$x,0.25,type = 6)
paste("El primer cuartil de la variable x es",Q1X)
## [1] "El primer cuartil de la variable x es 4.75"
Q2X = quantile(muestra1$x,0.50,type = 6)
paste("El segundo cuartil de la variable x es",Q2X)
## [1] "El segundo cuartil de la variable x es 5.74"
Q3X = quantile(muestra1$x,0.75,type = 6)
paste("El tercer cuartil de la variable x es",Q3X)
## [1] "El tercer cuartil de la variable x es 6.5375"

#Cuartiles de la variable Y:

Q1Y = quantile(muestra1$y,0.25,type = 6)
paste("El primer cuartil de la variable Y es",Q1Y)
## [1] "El primer cuartil de la variable Y es 4.76"
Q2Y = quantile(muestra1$y,0.50,type = 6)
paste("El segundo cuartil de la variable Y es",Q2Y)
## [1] "El segundo cuartil de la variable Y es 5.745"
Q3Y = quantile(muestra1$y,0.75,type = 6)
paste("El tercer cuartil de la variable Y es",Q3Y)
## [1] "El tercer cuartil de la variable Y es 6.5275"

#Cuartiles de la variable Z:

Q1Z = quantile(muestra1$z,0.25,type = 6)
paste("El primer cuartil de la variable Z es",Q1Z)
## [1] "El primer cuartil de la variable Z es 2.94"
Q2Z = quantile(muestra1$z,0.50,type = 6)
paste("El segundo cuartil de la variable Z es",Q2Z)
## [1] "El segundo cuartil de la variable Z es 3.53"
Q3Z = quantile(muestra1$z,0.75,type = 6)
paste("El tercer cuartil de la variable Z es",Q3Z)
## [1] "El tercer cuartil de la variable Z es 4.04"

A la hora de calcular los cuartiles, es posible evidenciar y confirmar que siempre el segundo cuartil (Q2), será igual que el valor de la mediana de dicha variable.

Finalmente, vamos a comparar los cuartiles y evidenciar que Q2 es igual a la mediana gráficamente:

hist(precio, xlab = "Precio", col = "salmon", main = "Visualización cuartiles y mediana (Variable Precio)")
abline(v=Q1P, lty = 3, lwd = 5)
abline(v=Q2P, lty = 3, lwd = 5)
abline(v=Q3P, lty = 3, lwd = 5)
abline(v=median(precio), lty = 1, lwd = 2)

En el histograma expueto anteriormente, se puede evidenciar, para la variable precio, los cuartiles (Líneas punteadas) Q1, Q2, Q3 y la mediana (Línea continua) de esta variable, comprobando, efectivamente, que la mediana corresponte al cuartil 2. Ahora se realizará la misma comparación para el resto de las variables cuantitativas:

par(mfrow=c(3,3))

hist(quilate, xlab = "Quilate", col = "cyan", main = "Cuartiles y mediana (Variable Quilate)")
abline(v=Q1Q, lty = 3, lwd = 5)
abline(v=Q2Q, lty = 3, lwd = 5)
abline(v=Q3Q, lty = 3, lwd = 5)
abline(v=median(quilate), lty = 1, lwd = 2)

hist(profundidad, xlab = "Profundidad", col = "#D02090", main = "Cuartiles y mediana (Variable Profundidad)")
abline(v=Q1PR, lty = 3, lwd = 5)
abline(v=Q2PR, lty = 3, lwd = 5)
abline(v=Q3PR, lty = 3, lwd = 5)
abline(v=median(profundidad), lty = 1, lwd = 2)

hist(tabla, xlab = "Tabla", col = "lightgreen", main = "Cuartiles y mediana (Variable Tabla)")
abline(v=Q1T, lty = 3, lwd = 5)
abline(v=Q2T, lty = 3, lwd = 5)
abline(v=Q3T, lty = 3, lwd = 5)
abline(v=median(tabla), lty = 1, lwd = 2)

hist(muestra1$x, xlab = "X (Largo en mm)", col = "#FFD700", main = "Cuartiles y mediana (Variable X)")
abline(v=Q1X, lty = 3, lwd = 5)
abline(v=Q2X, lty = 3, lwd = 5)
abline(v=Q3X, lty = 3, lwd = 5)
abline(v=median(x), lty = 1, lwd = 2)

hist(muestra1$y, xlab = "Y (Ancho en mm)", col = "#FFA07A", main = "Cuartiles y mediana (Variable Y)")
abline(v=Q1Y, lty = 3, lwd = 5)
abline(v=Q2Y, lty = 3, lwd = 5)
abline(v=Q3Y, lty = 3, lwd = 5)
abline(v=median(y), lty = 1, lwd = 2)

hist(muestra1$z, xlab = "Z (Profundidad en mm)", col = "#4F94CD", main = "Cuartiles y mediana (Variable Z)", xlim = c(0,10))
abline(v=Q1Z, lty = 3, lwd = 5)
abline(v=Q2Z, lty = 3, lwd = 5)
abline(v=Q3Z, lty = 3, lwd = 5)

abline(v=median(z), lty = 1, lwd = 2)

#### Rango

valor_min_y_max <- range(precio) #Para la variable precio
valor_min_y_max
## [1]   369 18760

Al identificar los valores minimos y maximos, es posible conocer que tanto puede llegar a ser la desviacion de los datos, que se verá posteriormente

Se puede evidenciar que la varianza maxima dentro de la variable “precio” es de 18391. En otras palabras, el dato minimo se aleja en un poco mas de #50 veces del dato maximo. Lo anterior puede visualizarse de mejor manera mediante un grafico de barras

barplot(valor_min_y_max, names.arg = c('Valor Minimo','Valor Maximo'), ylab = 'Precio',
        col = c("#76EEC6","#66CDAA"), xlab = 'Rango')

En cambio, para una variable como “Profundidad”, el rango entre el valor minimo y el valor maximo es mas pequeña

valor_min_y_max1 <- range(profundidad) 
valor_min_y_max1
## [1] 56.8 68.9
Rango1 <- 68.9 - 56.8
Rango1
## [1] 12.1
barplot(valor_min_y_max1, names.arg = c('Valor Minimo','Valor Maximo'), ylab = 'Precio',
        col = c("#76EEC6","#66CDAA"), xlab = 'Rango')

Ahora comparemos el rango de todas las variables cuantitativas restantes en un solo grafico

Variable <- c(rep("Quilate",2),rep("Dimensión X",2),
              rep("Dimensión Y",2), rep("Dimensión Z",2))
Valor <- c(range(quilate),range(x),range(y),range(z))
Tipo_valor <- c(rep(c("Minimo","Maximo"),4)) 

tabla1 <- data.frame(Variable, Valor, Tipo_valor)
tabla1
ggplot() +
  geom_bar(data = tabla1,
           aes(x=Variable, y=Valor, fill=Tipo_valor),
           stat = 'identity',
           position = 'dodge') +
  coord_flip() +
  theme_classic()

NOTA: Es importante destacar que en las variables con mayor distancia entre barras es donde mas variabilidad puede hallarse entre los datos que componen dichas variables

Varianza y desviacion estandar

Ahora bien, lo que se desea determinar es qué tanta es la desviación de los precios de los diamantes de acuerdo a la calidad de corte que tienen. Para ello, nos es de utilidad las medidas de “varianza” y “desviación estandar”, entendiendo que la primera es,básicamente, el cuadrado de la última. En primer lugar, desarrollamos una tabla en la que se muestre la varianza de los precios de cada tipo de calidad de corte

varian <- muestra1 %>%
  group_by(corte) %>%
  summarise(Precio = var(precio))
  
View(varian)

desvia <- muestra1 %>%
  group_by(corte) %>%
  summarise(Precio = sqrt(var(precio)))

View(desvia)

En general, ambas medidas funcionan para determinar la desviación de los datos. Lo importante aquí es destacar las calidades de corte con valores mas altos, que se pueden interpretar como aquellos donde los precios varían mas. Sin embargo, una gráfica de caja permite no sólo visualizar lo anterior de manera mas clara, sino también identificar otros datos relevantes como los datos atípicos.

boxplot(precio~corte, data = muestra1, main = "Desviación de precios según calidad de corte del diamante",
        ylab = "Precio", xlab = "Calidad de corte", col=c("#FFFFE0","#EEEED1","#CDCDB4","#8B8B7A","navajowhite"),
        outpch = 16)

A partir de la anterior gráfica se puede concluir que la calidad de corte “Ideal” es aquella con mayor cantidad de valores atípicos, seguido del corte “Premium” y “Muy Bueno”. Esto, a pesar de que se había evidenciado mediante las tablas anteriores que la calidad de corte con mayor varianza era el “Premium”, seguido del “Muy Bueno”. En conclusión, una mayor varianza no siempre quiere decir una mayor cantidad de datos atípicos. Para información mas detallada:

boxplot(precio~corte, data = muestra1, main = "Desviación de precios según calidad de corte del diamante",
        ylab = "Precio", xlab = "Calidad de corte", col=c("#FFFFE0","#EEEED1","#CDCDB4","#8B8B7A","navajowhite"),
        outpch = 16, plot = FALSE)
## $stats
##      [,1]    [,2]    [,3]  [,4]    [,5]
## [1,]  369   394.0   369.0   444   417.0
## [2,] 1960  1525.0  1068.0  1045   911.0
## [3,] 3248  3836.0  2499.5  2803  1986.0
## [4,] 4714  6553.5  4961.0  6006  4860.5
## [5,] 8681 14026.0 10646.0 12970 10656.0
## 
## $n
## [1]  27  84 230 259 400
## 
## $conf
##          [,1]     [,2]     [,3]     [,4]    [,5]
## [1,] 2410.588 2969.126 2093.919 2315.947 1673.99
## [2,] 4085.412 4702.874 2905.081 3290.053 2298.01
## 
## $out
##  [1] 13278 11600 14565 14445 18128 13043 12697 14819 11460 17760 12907 11325
## [13] 15281 11216 14477 17138 18561 15563 14295 17016 18252 18188 18447 14502
## [25] 16400 17216 13885 13771 14328 16068 14982 14375 13486 11470 13645 12978
## [37] 11379 12111 11596 14388 14915 13377 11942 11360 11205 13761 13632 12190
## [49] 13387 16240 18760 12587 14038 11500 18532 11705 12841 11540 13531 16446
## 
## $group
##  [1] 1 1 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 4 4 4 4 4 4 5 5 5 5 5
## [39] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
## 
## $names
## [1] "Regular"   "Bueno"     "Muy bueno" "Premium"   "Ideal"

Coeficiente de variación

El coeficiente de variación permite identificar el porcentaje en que los datos de la respectiva variable se desvían frente a la media de los datos. Es decir, a mayor porcentaje, mayor variación.

claridad_variación <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación = sd(precio)/mean(precio) *100)

View(claridad_variación)

Para ver el comportamiento del precio de los diferentes tipos de calidad, se presenta la siguiente gráfica

Nota: Se les asignó como nombre a cada uno de los tipos de claridad el número de la fila en la que pertenecen en la tabla anterior.

plot(claridad_variación$Variación, type = "l", ylab = "Variación del Precio",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

De la gráfica podemos concluir algo esperable: en general, a medida que la claridad del corte del diamante va aumentando, la desviación del precio frente al promedio también aumenta. Sin embargo, es de destacar el alto porcentaje de desviación de los precios frente a la media, llegando a una variación de mas del 120% en los tres tipos de claridades mas altas. Podríamos formular también otras hipótesis frente a estos resultados, como que a medida que la claridad del corte del diamante aumenta, la especulación sobre el precio del diamante también.

Ahora llevemos a cabo el mismo ejercicio para otras variables, frente a la variable de “Claridad”

Conf3x2 = matrix(c(1:6), nrow=2, byrow=TRUE)
layout(Conf3x2)

claridad_quilate <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_Quilate= sd(quilate)/mean(quilate) *100)

plot(claridad_quilate$Variación_Quilate, type = "l", ylab = "Variación del Quilate",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

claridad_profundidad <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_Profundidad= sd(profundidad)/mean(profundidad) *100)

plot(claridad_profundidad$Variación_Profundidad, type = "l", ylab = "Variación del porcentaje de Profundidad",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

claridad_tabla <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_tabla= sd(tabla)/mean(tabla) *100)

plot(claridad_tabla$Variación_tabla, type = "l", ylab = "Variación de 'Tabla'",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

claridad_x <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_x= sd(x)/mean(x) *100)

plot(claridad_x$Variación_x, type = "l", ylab = "Variación dellargo(mm)",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

claridad_y <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_y= sd(y)/mean(y) *100)

plot(claridad_y$Variación_y, type = "l", ylab = "Variación del ancho(mm)",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

claridad_z <- muestra1 %>%
  group_by(Claridad = claridad) %>%
  summarise(Variación_z= sd(z)/mean(z) *100)

plot(claridad_z$Variación_z, type = "l", ylab = "Variación de la profundidad(mm)",
     xlab = "Tipo de claridad (1 = Menor claridad; 8 = Mayor claridad)")

En primer lugar,es resaltable el alto porcentaje de desviación al que pueden llegar algunos datos. Por ejemplo, el peso de diamantes de la peor claridad puede variar en mas de un 65%. O también, la profundidad de un diamante de claridad 5 puede llegar a variar en un 70% frente a la media, que al compararlo con los porcentajes Maximos de la desviación de otras variables que determinan medidas de los diamantes, resulta un dato extremo que amerita a algún análisis o revisión mas profunda Nótese que las tendencias de la desviación del largo (x) y el ancho (y) de los diamantes son muy similares a pesar de las diferentes claridades del corte. Relacionando el peso del diamante (quilate) con la claridad del corte, se presenta una caída en picada al pasar de la claridad mas baja a la subsiguiente, para luego mostrar una tendencia positiva en donde el peso del diamante va aumentando a medida que la claridad del corte va mejorando.

Respecto a otras variables relacionadas a las medidas de los diamantes (Profundidad y Tabla) existe, en general, una tendencia a la baja a medida que la claridad del corte va aumentando. Sin embargo, frente a la variable de la profundidad en milímetros del diamante (z), se evidencia un pico de variabilidad abrupto en las claridades de corte intermedias, para luego mantenerse estables alrededor del 20% de desviación.

Curtosis y asimetria

Finalmente, para las medidas de “curtosis” y “asimetría” se usará inicialmente los valores correspondientes a la variable “tabla”, para determinar:

  1. Qué tanto se concentran los valores entorno a la media/promedio de “tabla”
  2. Qué tipo de asimetría presentan los datos, si es que esta existe para la variable tabla
Media_de_tabla <- mean(tabla)
hist(muestra1$tabla, prob =TRUE, ylim = c(0.00, 0.20), xlab = "Tabla", main = "Histograma de Tabla")
lines(density(muestra1$tabla), type = "l")
abline(v=Media_de_tabla, lty = 2, lwd=2)

Como se presenta en la anterior gráfica, los valores tienden a concentrarse en la media (línea vertical punteada) por lo que esta ilustración posee una curtosis leptocúrtica (es decir, que su curtosis debe ser superior a 3 si se usa la función /kurtosis en R)

kurtosis(tabla)
## [1] 4.383856

Por otra parte, en cuanto a la asimetría, es mas dificil deducirla a partir de la gráfica pues la cantidad de datos de la variable “tabla” a ambos lados de la línea de la media es relativamente similar. De todas maneras, es perceptible que la cola derecha de la campana se alarga un poco mas frente a la cola izquierda, lo que indicaría una asimetría positiva. Comprobemos lo anterior mediante la función /skewness.

skewness(tabla)
## [1] 0.6480608

En efecto, la variable “tabla” presenta una asimetría positiva pues el resultado de la función usada es un número superior a 0. Si el resultado hubiese sido igual a 0, no habría asimetría; y si el resultado hubiese sido menor a 0, habría una asimetría negativa

Ahora llevemos a cabo el mismo ejercicio con otras variables

layout(Conf3x2)

Media_de_precio <- mean(precio)
curt_precio <- kurtosis(precio)
skew_precio <- skewness(precio)

hist(muestra1$precio, prob =TRUE, xlab = "Precio",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_precio),digits = 2), round((skew_precio),digits = 2)),
     main = "Histograma de Precio")
lines(density(muestra1$precio), type = "l")
abline(v=Media_de_precio, lty = 2, lwd=2)

Media_de_quilate <- mean(quilate)
curt_quilate <- kurtosis(quilate)
skew_quilate <- skewness(quilate)

hist(muestra1$quilate, prob =TRUE, xlab = "Quilate",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_quilate),digits = 2), round((skew_quilate),digits = 2)),
     ylim = c(0.0,1.2), main = "Histograma de Quilate")
lines(density(muestra1$quilate), type = "l")
abline(v=Media_de_quilate, lty = 2, lwd=2)

Media_de_profundidad <- mean(profundidad)
curt_profundidad <- kurtosis(profundidad)
skew_profundidad <- skewness(profundidad)

hist(muestra1$profundidad, prob =TRUE, xlab = "Profundidad",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_profundidad),digits = 2), round((skew_profundidad),digits = 2)),
     ylim = c(0.00,0.40), main = "Histograma de Profundidad")
lines(density(muestra1$profundidad), type = "l")
abline(v=Media_de_profundidad, lty = 2, lwd=2)

Media_de_x <- mean(x)
curt_x <- kurtosis(x)
skew_x <- skewness(x)

hist(muestra1$x, prob =TRUE, xlab = "Largo(x)",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_x),digits = 2), round((skew_x),digits = 2)),
     ylim = c(0.00,0.40), main = "Histograma del largo de los Diamantes (x)")
lines(density(muestra1$x), type = "l")
abline(v=Media_de_x, lty = 2, lwd=2)

Media_de_y <- mean(y)
curt_y <- kurtosis(y)
skew_y <- skewness(y)

hist(muestra1$y, prob =TRUE, xlab = "Ancho(y)",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_y),digits = 2), round((skew_y),digits = 2)),
     ylim = c(0.00,0.40), main = "Histograma del ancho de los Diamantes (y)")
lines(density(muestra1$y), type = "l")
abline(v=Media_de_y, lty = 2, lwd=2)

Media_de_z <- mean(z)
curt_z <- kurtosis(z)
skew_z <- skewness(z)
curt_z
## [1] 408.5308
hist(muestra1$z, prob =TRUE, xlab = "Profundidad(z)",
     sub = sprintf("Curtosis %s, Asimetría %s",
                   round((curt_z),digits = 2), round((skew_z),digits = 2)),
     ylim = c(0.00,0.60), xlim = c(2,8), main = "Histograma de la profundidad de los Diamantes (z)")
lines(density(muestra1$z), type = "l")
abline(v=Media_de_z, lty = 2, lwd=2)

En general, notamos que el histograma de las variables “x” y “y” son las únicas que se pueden clasificar como platicúrticas, a razón de que sus curtosis son inferiores a 3. Es decir, que existe en estas variables una baja concentración de los datos en la media. Las demas variables, en contraste, son todas leptocúrticas, evidenciando una alta concetración de sus datos en las medias de cada variable. En cuanto a la asimetria, todas las variables graficadas poseen asimetría positiva (un sesgo a la derecha) a excepción de la variable “X” en donde no existe asimetría (en otras palabras, es una gráfica completamente simétrica).