librerías

A continuación los paquetes pertinentes para la realización del trabajo que permitieron el desarrollo de las gráficas.

library(ggplot2)
library(viridisLite)
library(viridis)
library(RColorBrewer)
library(plotrix)
library(dplyr)
library(rmarkdown)
library(descriptr)
library(tidyverse)
library(plotly)
library(gganimate)
library(graphics)
library(fdth)
library(modeest)
library(gridExtra)
library(gifski)
library(png)

Introducción y base de datos

Primeramente cabe decir que en el presente informe se realizará un análisis descriptivo a partir de la base de datos diamantes, de la cual se tomará una muestra de 1000 diamantes que contiene datos con variables tanto cualitativas como cuantitativas, donde es posible obtener gráficas y medidas de variabilidad y tendencia central para la respectiva evaluacion.

set.seed(1382)
datos.d <- diamonds
muestra1 <- datos.d[sample(nrow(datos.d),size=1000),0:10]
muestra1

Con base en ello se hace la comparación respectiva evaluando las variables y su comportamiento pasando tanto por datos cualitativos como cuantitativos.

Variables cualitativas

Primeramente comenzamos con un analisis sencillo de las variables cualitativas ordinales siendo estas el color(se explicará porque), la claridad y el corte, donde solo podremos tener una representación gráfica de la más básica, siendo diagramas de barras y de torta lo que obtendremos

Color

Con respecto al color podemos decir que es una variable continua ordinal(exclusivamente para este caso, ya que el color es nominal) que realmente solo sirve para ayudar a dilucidar que tantos diamantes encontraremos de una u otra forma donde “D” representa el mejor color y “J” el peor.

Tabla de frecuencias

Color <- data.frame(table(Color = muestra1$color ))
Color

Con ello realizamos nuestras respectivas gráficas

Diagrama de barras

Colorbar_color <- ggplot(muestra1, aes(x=color, fill = color)) + geom_bar() + scale_fill_viridis(discrete = TRUE )
Colorbar_color + theme_gray()

Diagrama de torta

Porc_color <- paste0(round(Color$Freq/sum(Color$Freq) * 100, 2), "%")
Leyenda <-c(as.character(Color$Color))


pie3D(Color$Freq,main = "Colores de los diamantes", col = hcl.colors(length(Color$Freq), "Spectral"),   border = "white", labels = Porc_color, explode = 0.06)
legend("topright", Leyenda, cex = 0.6, fill = hcl.colors(length(Color$Freq), "Spectral"))

Podemos observar que una gran parte de los diamantes tienen un color promedio que no representa ni lo mejor ni lo peor, sino que se queda a medias, por otro lado, no se encuentran casi diamantes de baja calidad al menos en cuanto a color

Corte

Con el corte se procede a realizar lo mismo, de esta sección puede decirse que el corte representa, valga la redundancia, la calidad del corte del diamante, yendo desde el ideal(ideal tambien en ingles) hasta el regular(fair) que sería el peor de todos.

Tabla de frecuencias

Corte <-data.frame(table(Corte = muestra1$cut))
Corte

Diagrama de barras

Colorbar_corte <- ggplot(muestra1, aes(x=cut, fill = cut)) + geom_bar() + scale_fill_viridis(discrete = TRUE , option = "A")
Colorbar_corte + theme_gray()

Diagrama de torta

Porc_corte <- paste0(round(Corte$Freq/sum(Corte$Freq) * 100, 2), "%")
Leyenda_corte <-c(as.character(Corte$Corte))
pie3D(Corte$Freq,main = "Corte de los diamantes", col = hcl.colors(length(Corte$Freq), "Reds"),   border = "darkred", labels = Porc_corte)
legend("topright", Leyenda_corte,cex = 0.7, fill = hcl.colors(length(Corte$Freq), "Reds"))

Nuevamente se observa que por lo general los cortes suelen tener una calidad ideal, sin embargo tambien hay que observar que hay unos cuantos diamantes de más(4 diamantes) en la categoría de muy bueno, por sobre la categoría premium siendo que hay una linea delgada entre ambos, las personas suelen terminar dejando cortes mas imperfectos.

Claridad

Ahora continuamos con este aspecto donde evaluamos que tan claro está el diamante, estando ordenado de la forma I1 (peor), SI2, SI1, VS2, VS1, VVS2, VVS1, IF (mejor)

Tabla de frecuencias

Claridad <-data.frame(table(Claridad = muestra1$clarity))
Claridad

Diagrama de barras

Colorbar_clari <- ggplot(muestra1, aes(x=clarity, fill = clarity)) + geom_bar() + scale_fill_viridis(discrete = TRUE , option = "B")
Colorbar_clari + theme_gray()

Diagrama de torta

Porc_clari <- paste0(round(Claridad$Freq/sum(Claridad$Freq) * 100, 2), "%")
Leyenda_clari <-c(as.character(Claridad$Claridad))
pie3D(Claridad$Freq,main = "Claridad de los diamantes", col = hcl.colors(length(Claridad$Freq), "PuBuGn"),   border = "lightblue", labels = Porc_clari, explode = 0.08, labelcex = 0.8, theta = 0.8)
legend("topright", Leyenda_clari,cex = 0.45, fill = hcl.colors(length(Claridad$Freq), "PuBuGn"))

Sorprendentemente estás gráficas nos indican lo dificil que es encontrar un diamante con una claridad optima pues la mayoria tienden a estar en un termino medio siendo la tendencia en esta categoría.

Variables cuantitativas

Ahora bien empezamos con la parte más importante donde podremos analizar más profundamente como se comportan las variables cuantitativas. Con el siguiente código es posible generar una tabla con las medidas de tendencia central, variabilidad,posicion, sesgo y apuntamiento, en este caso: el dato más pequeño (min), el dato más grande (max), la media(mean), media truncada(t_mean), mediana (median), mode (moda), rango (range), varianza (variance), desviacion estándar (stdev), sesgo (skew), curtosis(kurtosis), coeficiente de variacion (coeff_var), cuartil 1(q1), cuartil 3 (q3) y rango intercuartilico (iqrannge) respectivamente, para cada una de estas variables.

Tabla_res <- ds_tidy_stats(muestra1)
Tabla_res

Teniendo esto en cuanta es posible comenzar un análisis pertinente

Análisis de quilate(carat)

En esta sección se muestran los quilates del diamante, que denotan su peso. Un quilate equivale a 0.20 gramos. Sabiendo esto, procedemos con el análisis

Tabla_res[1,]

Tabla de frecuencias del quilate

Qui <- fdt(muestra1$carat)
tabla_car <-do.call(rbind.data.frame,Qui)
f_qui<-tabla_car[-c(12),]
rownames(f_qui)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_qui

Histograma de frecuencias

ggplot(muestra1, aes(x = carat)) + 
  geom_histogram(bins = 11, fill = "lightyellow", alpha = 0.5, colour = 7)

Densidad y tendencia central

Moda:0.3

Mediana:0.7

Media: 0.79004

  moda_ca<-mfv(muestra1$carat)
  media_ca<-mean(muestra1$carat)
  mediana_ca<-median(muestra1$carat)

ggplot(muestra1, aes(x = carat)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "lightyellow", alpha = 0.5, colour = 7, bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_ca, color="moda"),
              lty="dashed",
             lwd = 2)+
       geom_vline(aes(xintercept =media_ca, color="media"),
              lty="dashed",
             lwd = 2) +
       geom_vline(aes(xintercept =mediana_ca, color="mediana"),
              lty="dashed",
             lwd = 2)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
  theme_bw()

En esta parte si regresamos a la tabla observaremos que tiene una curtosis de 1.14, por lo cual corresponde a una tendencia leptocúrtica

Box-plot

boxplot(muestra1$carat,horizontal = TRUE,
        boxwex = 0.5, 
        boxlty = 1,   
        boxlwd = 5,   
        boxcol = 7,   
        boxfill = "orange",
        whisklty = 2,       
        whisklwd = 2,      
        whiskcol = "gold",
        border = "red",
        main = "Box plot del quilate")

Análisis de profundidad (depth)

Para esta sección analizamos el porcentaje total de profundidad del diamante.

Tabla_res[2,]

Tabla de frecuencias de la profundidad

pro <- fdt(muestra1$depth)
tabla_pro <-do.call(rbind.data.frame,pro)
f_prof<-tabla_pro[-c(12),]
rownames(f_prof)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_prof

Histograma de frecuencias

ggplot(muestra1, aes(x = depth)) + 
  geom_histogram(bins = 11, fill = "lightgreen", alpha = 0.5, colour = 3)

Densidad y tendencia central

  moda_pro<-mfv(muestra1$depth)
  media_pro<-mean(muestra1$depth)
  mediana_pro<-median(muestra1$depth)

ggplot(muestra1, aes(x = depth)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "lightgreen", alpha = 0.5, colour = 3, bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_pro, color="moda"),
              lty="dashed",
             lwd = 2)+
       geom_vline(aes(xintercept =media_pro, color="media"),
              lty="dashed",
             lwd = 2) +
       geom_vline(aes(xintercept =mediana_pro, color="mediana"),
              lty="dashed",
             lwd = 2)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
  theme_bw()

tiene una curtosis de 4.39, lo que implica una tendencia lepticúrtica en la cual la mediana, media y moda están muy cerca.

Box-plot

boxplot(muestra1$depth,horizontal = TRUE,
        boxwex = 0.5, 
        boxlty = 1,   
        boxlwd = 5,   
        boxcol = 3,   
        boxfill = "darkgreen",
        whisklty = 2,       
        whisklwd = 2,      
        whiskcol = "lightgreen",
        border = "limegreen",
        main = "Box plot de la profundidad")

Procedemos al siguiente análisis

Análisis del precio

Está sección analiza el precio, que está dado en dolares norteamericanos.

Tabla_res[3,]

Tabla de frecuencias del precio

Pre <- fdt(muestra1$price)
tabla_p <-do.call(rbind.data.frame,Pre)
f_precio<-tabla_p[-c(12),]
rownames(f_precio)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_precio

Histograma de frecuencias

ggplot(muestra1, aes(x = price)) + 
  geom_histogram(bins = 11, fill = "white", alpha = 0.5, colour = 4)

Densidad y tendencia central

Recordemos que las medidas te tendencia para el precio son:

Media: 3906.787

Mediana: 2326

Moda: 828

  moda<-mfv(muestra1$price)
  media<-mean(muestra1$price)
  mediana<-median(muestra1$price)

ggplot(muestra1, aes(x = price)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "white", alpha = 0.5, colour = 4, bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda, color="moda"),
              lty="dashed",
             lwd = 2)+
       geom_vline(aes(xintercept =media, color="media"),
              lty="dashed",
             lwd = 2) +
       geom_vline(aes(xintercept =mediana, color="mediana"),
              lty="dashed",
             lwd = 2)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
        theme_bw()

Es importante revisar el dato de la curtosis, que toma un valor de 2.70, lo que significa que posee una tendencia lepticúrtica, es decir, la distribucion de los datos es muy apuntada

Box-plot

boxplot(muestra1$price,horizontal = TRUE,
        boxwex = 0.5, 
        boxlty = 1,   
        boxlwd = 5,   
        boxcol = 4,   
        boxfill = "lightblue",
        whisklty = 2,       
        whisklwd = 2,      
        whiskcol = "purple",
        border = "darkblue",
        main = "Box plot del precio")

Análisis de la tabla

Para contextualizar, la tabla es el ancho de la parte superior del diamante en relación con el punto más ancho, lo que vamos a análizar justo ahora es eso precisamente.

Tabla_res[4,]

Tabla de frecuencias de la tabla

tab <- fdt(muestra1$table)
tabla <-do.call(rbind.data.frame,tab)
f_tab<-tabla[-c(12),]
rownames(f_tab)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_tab

Histograma de frecuencias

ggplot(muestra1, aes(x = table)) + 
  geom_histogram(bins = 11, fill = "pink", alpha = 0.5, colour = 6)

Densidad y tendencia central de la tabla

  moda_ta<-mfv(muestra1$table)
  media_ta<-mean(muestra1$table)
  mediana_ta<-median(muestra1$table)

ggplot(muestra1, aes(x = table)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "pink", alpha = 0.5, colour = 6, bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_ta, color="moda"),
              lty="dashed",
             lwd = 2)+
       geom_vline(aes(xintercept =media_ta, color="media"),
              lty="dashed",
             lwd = 2) +
       geom_vline(aes(xintercept =mediana_ta, color="mediana"),
              lty="dashed",
             lwd = 2)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
        theme_bw()

posee una curtosis de 0.95, por lo cual es leptocúrtica, nuevamente con una media, mediana y moda muy ajustadas, teniendo a la mayoría de datos en esta sección.

Box-plot

boxplot(muestra1$price,horizontal = TRUE,
        boxwex = 0.5, 
        boxlty = 1,   
        boxlwd = 5,   
        boxcol = "salmon",   
        boxfill = "pink",
        whisklty = 2,       
        whisklwd = 2,      
        whiskcol = "lightcoral",
        border = "deeppink",
        main = "Box plot del precio")

Análisis de x,y,z

En concreto “X” corresponde al largo, “Y” al ancho y “Z” a la profundidad

Tabla_res[5:7,]

Tabla de frecuencias X

X(largo)

tx <- fdt(muestra1$x)
tabla_x <-do.call(rbind.data.frame,tx)
f_x<-tabla_x[-c(12),]
rownames(f_x)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_x

Tabla de frecuencias Y

Y(ancho)

ty <- fdt(muestra1$y)
tabla_y <-do.call(rbind.data.frame,ty)
f_y<-tabla_y[-c(12),]
rownames(f_y)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_y

Tabla de frecuencias Z

Z(profundidad)

tz <- fdt(muestra1$z)
tabla_z <-do.call(rbind.data.frame,tz)
f_z<-tabla_z[-c(12),]
rownames(f_z)<-c(1,2,3,4,5,6,7,8,9,10,11)
f_z

Histograma de frecuencias

xd<-ggplot(muestra1, aes(x = x)) + 
  geom_histogram(bins = 11, fill = "white", alpha = 0.5, colour = "black")
yd<-ggplot(muestra1, aes(x = y)) + 
  geom_histogram(bins = 11, fill = "white", alpha = 0.5, colour = "black")
zd<-ggplot(muestra1, aes(x = z)) + 
  geom_histogram(bins = 11, fill = "white", alpha = 0.5, colour = "black")

Histo_xyz<-grid.arrange(xd,yd,zd, nrow = 2)

Densidad y tendencia central

Para X:

Media:5.70942

Mediana:5.66

Moda:4.32

Para Y:

Media:5.71174

Mediana:5.67

Moda:4.34

Para Z:

Media:3.52655

Mediana:3.52

Moda:2.71

Histogramas(densidad y tendencias)

  moda_x <-mfv(muestra1$x)
  media_x<-mean(muestra1$x)
  mediana_x<-median(muestra1$x)
  moda_x<-moda_x[-2]

den_x<-ggplot(muestra1, aes(x = x)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "white", alpha = 0.5, colour = "black", bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_x, color="moda"),
              lty="dashed",
             lwd = 1)+
       geom_vline(aes(xintercept =media_x, color="media"),
              lty="dashed",
             lwd = 1) +
       geom_vline(aes(xintercept =mediana_x, color="mediana"),
              lty="dashed",
             lwd = 1)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
        theme_bw()
  
  moda_y <-mfv(muestra1$y)
  media_y<-mean(muestra1$y)
  mediana_y<-median(muestra1$y)

den_y<-ggplot(muestra1, aes(x = y)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "white", alpha = 0.5, colour = "black", bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_y, color="moda"),
              lty="dashed",
             lwd = 1)+
       geom_vline(aes(xintercept =media_y, color="media"),
              lty="dashed",
             lwd = 1) +
       geom_vline(aes(xintercept =mediana_y, color="mediana"),
              lty="dashed",
             lwd = 1)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
        theme_bw()

  moda_z <-mfv(muestra1$z)
  media_z<-mean(muestra1$z)
  mediana_z<-median(muestra1$z)

den_z<-ggplot(muestra1, aes(x = z)) + 
  geom_histogram(aes(y = after_stat(density)),
                 fill = "white", alpha = 0.5, colour = "black", bins = 11) +
  geom_density(aes(colour = "densidad"),
               fill = "lightblue", alpha = 0.25,lwd = 0.8) +
       geom_vline(aes(xintercept =moda_z, color="moda"),
              lty="dashed",
             lwd = 1)+
       geom_vline(aes(xintercept =media_z, color="media"),
              lty="dashed",
             lwd = 1) +
       geom_vline(aes(xintercept =mediana_z, color="mediana"),
              lty="dashed",
             lwd = 1)+

      scale_color_manual(name = "Estadisticas", values = c("mediana" = "coral", "media" = "red", "moda" = "darkgoldenrod1", "densidad"="limegreen"))+
        theme_bw()

denh<-grid.arrange(den_x,den_y,den_z, nrow = 2)

Como podemos ver a pesar de ser asimétrica la gráfica esta tiende a la simetría pues los valores de media y mediana se acercan mucho siendo casi identicos. Por otro lado esta gráfica se puso para las tres medidas(x,y,z) debido a que como se ve a simple vista, estas gráficas son muy similares entre sí siendo que casi puede afirmarse que hay una dependencia entre ellas, siendo que el ancho afectará el largo y su profundidad; y continuaría de igual forma cambiando el orden de las variables del enunciado.

Box-plot

X<-muestra1$x
Y<-muestra1$y
Z<-muestra1$z
XYZ<-data.frame(X,Y,Z)
XYZ_INV<-data.frame(stack(XYZ))
colnames(XYZ_INV)[2] <- "Medidas en mm"
ggplot(XYZ_INV, aes(x = `Medidas en mm`, y = values,
               colour = `Medidas en mm`,
               shape = `Medidas en mm`)) + 
  geom_boxplot(outlier.shape = NA) +
  geom_jitter(size = 0.8)

Desviaciones y varianzas

Con esto analizamos la comparativa entre las varianzas de cada dato

Comparación por categorías

Como se observa a continaución es complejo analizar gráficamente tanto la varianza, como la desviación, ya que el precio posee una variación mayor a la de los demás datos, esto se asentúa si vemos el gráfico de tendencia central donde los datos están muy alejados de la media y además la diferencia entre el dato mínimo y máximo del precio termina por elevar la varianza, de forma que se hacen dos gráficas, una incluyendo el precio y otra sin él.

Incluyendo el precio

ggplot(Tabla_res, aes(x=vars,y=variance, fill = vars))+
  geom_bar(stat = "identity", alpha = 0.6)+
  geom_line(aes(y=stdev, color = "desviacion estandar"), group = 1, lty = 2, lwd = 1.5)+
  scale_color_manual(name = "dispersión", values = c("desviacion estandar"="firebrick4"))+
        theme_bw()+
  scale_fill_viridis(discrete = TRUE, option = "A")

Sin incluir el precio

tabla_new <- Tabla_res[-c(3),]
ggplot(tabla_new, aes(x=vars,y=variance, fill = vars))+
  geom_bar(stat = "identity", alpha = 0.6)+
  geom_line(aes(y=stdev,color = "desviacion estandar"), group = 1, lty = 2, lwd = 1.5)+
   scale_color_manual(name = "dispersion", values = c("desviacion estandar"="firebrick4"))+
        theme_bw()+
    scale_fill_viridis(discrete = TRUE, option = "A")

Dispersión

Precio y quilate

plot(x=muestra1$price, y=muestra1$carat, xlab="Precio", ylab="Quilates", col= hcl.colors(2,"Sunset"), main="Dispersión de precio respecto al quilataje")

Precio y profundidad

plot(x=muestra1$price, y=muestra1$depth, xlab="Precio", ylab="profundidad", col= hcl.colors(2,"purp"), main="Dispersión de precio respecto a la profundidad")

Precio y tabla

plot(x=muestra1$price, y=muestra1$table, xlab="Precio", ylab="Tabla", col= hcl.colors(2,"BluGrn"), main="Dispersión de precio respecto a la tabla")

Cuartiles y percentiles

Con esto observamos donde se encuentran los datos, haciendo el análisis de las posiciones de los cuartiles y percentiles

Precio

tabla de Percentiles

datos <- data.frame(muestra1) 
suma.corte <- data.frame(summary(datos$cut) )

minimo.precio <- min(datos$price)
maximo.precio <- max(datos$price) 
mediana.precio <- median(datos$price)

Q1.precio <- quantile(datos$price, c(0.25), type = 6); Q1.precio
## 25% 
## 939
Q2.precio <- quantile(datos$price, c(0.50), type = 6); Q2.precio
##  50% 
## 2326
Q3.precio <- quantile(datos$price, c(0.75), type = 6); Q3.precio
##     75% 
## 5439.75
mediana.precio2 <- median(datos$price)
maximo.precio2 <- max(datos$price)              
minimo.precio2 <- min(datos$price)               

percentiles.precio <- quantile(datos$price, c(0.001, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.precio)

Histograma de cuartiles

datos.precio2 <- data.frame(datos$price)
                               
ggplot(data = datos.precio2, aes(x=datos$price)) +
  geom_histogram(bins = 30, fill = "white", color = "blue") + 
  geom_vline(aes(xintercept = Q1.precio,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.precio,            
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.precio,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes precio",subtitle =  paste("Cuartil 1 al 25% = ",Q1.precio, ", Cuartil 2 al 50% = ",Q2.precio, ", Cuartil 3 al 75% = ",Q3.precio))

Realizamos el mismo proceso con las demás variables

Quilates

Tabla de percentiles

minimo.quilates <- min(datos$quilate)
maximo.quilates <- max(datos$quilate)
mediana.quilates <- median(datos$quilate)

Q1.quilates <- quantile(datos$carat, c(0.25), type = 6); Q1.quilates
## 25% 
## 0.4
Q2.quilates <- quantile(datos$carat, c(0.50), type = 6); Q2.quilates
## 50% 
## 0.7
Q3.quilates <- quantile(datos$carat, c(0.75), type = 6); Q3.quilates
##  75% 
## 1.04
mediana.quilates2 <- median(datos$carat)
maximo.quilates2 <- max(datos$carat)
minimo.quilates2 <- min(datos$carat)

percentiles.quilates <- quantile(datos$carat, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.quilates)

Histograma de cuartiles

datos.quilates2 <- data.frame(datos$carat)

ggplot(data = datos.quilates2, aes(x=datos$carat)) +
  geom_histogram(bins = 30, fill= "gold", color = "yellow", alpha = 0.6) + 
  geom_vline(aes(xintercept = Q1.quilates,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.quilates,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.quilates,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes quilates",subtitle =  paste("Cuartil 1 al 25% = ",Q1.quilates, ", Cuartil 2 al 50% = ",Q2.quilates, ", Cuartil 3 al 75% = ",Q3.quilates))

## Profundidad

Tabla de percentiles

minimo.profundidad <- min(datos$depth)
maximo.profundidad <- max(datos$depth)
mediana.profundidad <- median(datos$depth)

Q1.profundidad <- quantile(datos$depth, c(0.25), type = 6); Q1.profundidad
##  25% 
## 61.1
Q2.profundidad <- quantile(datos$depth, c(0.50), type = 6); Q2.profundidad
##  50% 
## 61.9
Q3.profundidad <- quantile(datos$depth, c(0.75), type = 6); Q3.profundidad
##    75% 
## 62.575
mediana.profundidad2 <- median(datos$depth)
maximo.profundidad2 <- max(datos$depth)
minimo.profundidad2 <- min(datos$depth)


percentiles.profundidad <- quantile(datos$depth, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.profundidad)

Histograma de cuartiles

datos.profundidad2 <- data.frame(datos$depth)

ggplot(data = datos.profundidad2, aes(x=datos$depth)) +
  geom_histogram(bins = 30, fill="darkgreen", color = "green", alpha = 0.1) + 
  geom_vline(aes(xintercept = Q1.profundidad,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.profundidad,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.profundidad,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes profundidad",subtitle =  paste("Cuartil 1 al 25% = ",Q1.profundidad, ", Cuartil 2 al 50% = ",Q2.profundidad, ", Cuartil 3 al 75% = ",Q3.profundidad))

Tabla

Tabla de percentiles

minimo.tabla <- min(datos$table)
maximo.tabla <- max(datos$table)
mediana.tabla <- median(datos$table)


Q1.tabla <- quantile(datos$table, c(0.25), type = 6); Q1.tabla
## 25% 
##  56
Q2.tabla <- quantile(datos$table, c(0.50), type = 6); Q2.tabla
## 50% 
##  57
Q3.tabla <- quantile(datos$table, c(0.75), type = 6); Q3.tabla
## 75% 
##  59
mediana.tabla2 <- median(datos$table)
maximo.tabla2 <- max(datos$table)
minimo.tabla2 <- min(datos$table)


percentiles.tabla <- quantile(datos$table, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.tabla)

Histograma de cuartiles

datos.tabla2 <- data.frame(datos$table)

ggplot(data = datos.tabla2, aes(x=datos$table)) +
  geom_histogram(bins = 30, fill= "pink", color = "magenta") + 
  geom_vline(aes(xintercept = Q1.tabla,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.tabla,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.tabla,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes tabla",subtitle =  paste("Cuartil 1 al 25% = ",Q1.tabla, ", Cuartil 2 al 50% = ",Q2.tabla, ", Cuartil 3 al 75% = ",Q3.tabla))

x(largo), y(ancho), z(profundidad)

Tabla de percentiles

X

minimo.x <- min(datos$x)
maximo.x <- max(datos$x)
mediana.x <- median(datos$x)



Q1.x <- quantile(datos$x, c(0.25), type = 6); Q1.x
## 25% 
## 4.7
Q2.x <- quantile(datos$x, c(0.50), type = 6); Q2.x
##  50% 
## 5.66
Q3.x <- quantile(datos$x, c(0.75), type = 6); Q3.x
##    75% 
## 6.5375
mediana.x2 <- median(datos$x)
maximo.x2 <- max(datos$x)
minimo.x2 <- min(datos$x)



percentiles.x <- quantile(datos$x, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.x)

Y

minimo.y <- min(datos$y)
maximo.y <- max(datos$y)
mediana.y <- median(datos$y)


Q1.y <- quantile(datos$y, c(0.25), type = 6); Q1.y
##  25% 
## 4.71
Q2.y <- quantile(datos$y, c(0.50), type = 6); Q2.y
##  50% 
## 5.67
Q3.y <- quantile(datos$y, c(0.75), type = 6); Q3.y
##  75% 
## 6.53
mediana.y2 <- median(datos$y)
maximo.y2 <- max(datos$y)
minimo.y2 <- min(datos$y)


percentiles.y <- quantile(datos$y, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.y)

Z

minimo.z <- min(datos$z)
maximo.z <- max(datos$z)
mediana.z <- median(datos$z)


Q1.z <- quantile(datos$z, c(0.25), type = 6); Q1.z
##    25% 
## 2.9025
Q2.z <- quantile(datos$z, c(0.50), type = 6); Q2.z
##  50% 
## 3.52
Q3.z <- quantile(datos$z, c(0.75), type = 6); Q3.z
##  75% 
## 4.03
mediana.z2 <- median(datos$z)
maximo.z2 <- max(datos$z)
minimo.z2 <- min(datos$z)


percentiles.z <- quantile(datos$z, c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1), type = 6)
data.frame(percentiles.z)

Histograma de cuartiles x,y,z

datos.x2 <- data.frame(datos$x)


xc<-ggplot(data = datos.x2, aes(x=datos$x)) +
  geom_histogram(bins = 30, fill ="white", color = "black") + 
  geom_vline(aes(xintercept = Q1.x,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.x,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.x,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes x",subtitle =  paste("Cuartil 1 al 25% = ",Q1.x, ", Cuartil 2 al 50% = ",Q2.x, ", Cuartil 3 al 75% = ",Q3.x))

datos.y2 <- data.frame(datos$y)

yc<-ggplot(data = datos.y2, aes(x=datos$y)) +
  geom_histogram(bins = 30, fill ="white", color = "black") + 
  geom_vline(aes(xintercept = Q1.y,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.y,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.y,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes y",subtitle =  paste("Cuartil 1 al 25% = ",Q1.y, ", Cuartil 2 al 50% = ",Q2.y, ", Cuartil 3 al 75% = ",Q3.y))

datos.z2 <- data.frame(datos$z)


zc<-ggplot(data = datos.z2, aes(x=datos$z)) +
  geom_histogram(bins = 30, fill ="white", color = "black") + 
  geom_vline(aes(xintercept = Q1.z,
                 color = "Q1"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q2.z,
                 color = "Q2"),
             linetype = "dashed",
             size = 1) +
  geom_vline(aes(xintercept = Q3.z,
                 color = "Q3"),
             linetype = "dashed",
             size = 1) +  
  labs(title = "Histograma de diamantes z",subtitle =  paste("Cuartil 1 al 25% = ",Q1.z, ", Cuartil 2 al 50% = ",Q2.z, ", Cuartil 3 al 75% = ",Q3.z))

grid.arrange(xc,yc,zc,nrow =3)

Versus

Ahora es el momento en el que se puede analizar la dependencia de unas variables sobre otras, por ello análizaremos dentro del marco de las variables cuantitativas.

Precio por corte

ggplot(muestra1, aes(x = price)) +
  geom_histogram(fill = "darkgreen", colour = "blue", linewidth = 0.5, bins = 11) +
  scale_y_continuous( name = "Numero de diamantes" ) +
  scale_x_continuous( name = "precio" ) +
  facet_wrap(~cut) +theme(axis.title.x = element_text(size = rel(1.2), lineheight = .9,family = "sans", face = "bold", colour = "black" ),
    axis.title.y = element_text(size = rel(1.2), lineheight = .9,family = "sans", face = "bold", colour = "black"),
    plot.background = element_rect("lightblue"))+
transition_states(
    cut,
    transition_length = 2,
    state_length = 1
  ) +
  enter_fade() + 
  exit_shrink() +
  ease_aes('sine-in-out')

Comparación precio, corte y color

ggplot(muestra1, aes(x = carat, y = price, colour = color, shape = clarity)) +
  geom_point() + 
  labs(x = "Quilate", y = "Precio") +
  scale_shape_manual(values = c(15,16,13,20,17,2,12,1)) +
  scale_color_manual(values = c("#1E90FF", "firebrick4", "#27408B", "#FA8072", "#FF4500","#B03060","#A0522D")) +
  facet_wrap(~ cut) +
  guides(color = guide_legend(title = "Color del diamante"), shape = guide_legend(title = "Claridad del diamante"))

Conclusiones

Analizando las diferentes variables, podemos entender que en nuestra muestra, la mayoría de los diamantes son de corte ideal, aunque el precio de la mayoría no supera los 2028 dólares y conforme aumentan los precios el número de diamantes baja, entre más caros son, hay menos, esto coincide con el peso de los diamantes, ya que hay mayor concentración en el peso menor, entre 0 y 1,5 carats, así mismo el precio si que es afectado por el peso ya que podemos observar en la distribución del precio con respecto al peso que siempre a mayor peso el valor aumenta.

analizando el precio contra el corte podemos observar que al tener mejor corte el precio no se ve afectado dramáticamente, para los cortes Muy Bueno, Premium e Ideal, los precios están concentrados en 0 a 2500 dólares.

En cuanto a la tabla y las medidas x, y y z, podemos observar que sus valores están muy estrechamente relacionados ya que la frecuencia de estas medidas se acentúa cerca de la media y la mediana, por medio del análisis pudimos comprobar que esto también ocurre en la profundidad, lo cual nos quiere decir que estas 4 variables están correctamente evaluadas ya que si la profundidad estaría distribuida de manera menos uniforme, los datos de x, y y z estarían errados.

Finalmente podemos reconocer que R es una herramienta maravillosa para hacer estos análisis, ya que nos permite crear gráficas que representan el comportamiento general de los datos, ayudándonos a visualizar tendencias en los datos, lo cual es bastante significativo cuando empezamos a contrastar dos variables o más, como lo es analizar el precio respecto al quilataje o el precio con respecto al corte.