library(descr)
library(dplyr)
library(plotrix)
library(datos)
library(showtextdb)
library(sysfonts)
library(showtext)
library(ggplot2)
library(modeest)
set.seed(6600)
datos.d <- data.frame(diamantes)
muestra1 <- datos.d[sample(nrow(datos.d),size=1000),0:10]

Introduccion

Este trabajo busca realizar un análisis de una base de datos predeterminada de R la cual nos proporciona una cantidad de datos considerable tomando en cuenta el precio y características generales de los diamantes. A continuación se muestra la base de datos que se va a manejar para el desarrollo del análisis estadístico, resaltando que se esta tomando una muestra de 1000 datos aleatorios de la base de datos original la cual tiene aproximadamente 54000 datos:

muestra1

Variables Cualitativas

En este sección se analizaremos las diferentes variables de tipo cualitativas mediante gráficos y analisis que permitan conocer mas acerca de la muestra que tenemos.

Analisis de corte

A continuación se presentaran gráficas con el fin de representar de una manera practica la variable de corte en los diamantes.

#Frecuencia absoluta
fabs_Corte <- table(muestra1$corte)
#Frecuencia absoluta acumulada
fabs_acum_Corte <- cumsum(fabs_Corte)
#Frecuencia relativa
frel_corte <- fabs_Corte/length(muestra1$corte)
#Frecuencia relativa porcentaje 
frel_corte_p <- (fabs_Corte/length(muestra1$corte))*100
#Frecuencia relativa acumulada
frel_acum_corte <- cumsum(frel_corte)
#Frecuencia relativa acumulada en porcentaje
frel_acum_corte_p <- cumsum(frel_corte_p)
#Datos
datos_Freq_Corte <- cbind(fabs_Corte,fabs_acum_Corte,frel_corte,frel_corte_p,frel_acum_corte,frel_acum_corte_p)
#construcción de la tabla
aux1 <- c("Frecuencia absoluta","Frequencia absoluta acumulada","Frecuencia relativa","%","Frecuencia relativa acumulada","%")
tablafreq1 <- knitr::kable(datos_Freq_Corte,caption = "Tabla de frecuencia de la variable corte.", format = "markdown",col.names = aux1,align = 'cccccc',digits = 3)

Tabla de frecuencia de la variable corte.
	Frecuencia absoluta	Frequencia absoluta acumulada	Frecuencia relativa	%	Frecuencia relativa acumulada	%
Regular	23	23	0.023	2.3	0.023	2.3
Bueno	85	108	0.085	8.5	0.108	10.8
Muy bueno	215	323	0.215	21.5	0.323	32.3
Premium	279	602	0.279	27.9	0.602	60.2
Ideal	398	1000	0.398	39.8	1.000	100.0

De esta tabla podemos intuir que hay una notoria mayoría de datos entre los cortes ideales y premium mientras que los cortes regulares son muy poco frecuentes en los diamantes; visto de una manera mas ilustrativa tenemos un diagrama de torta y un diagrama de barras:

pie3D(frel_corte_p,main="Diagrama de torta tipo de corte",
      col = hcl.colors(length(frel_corte_p), "Viridis"),
      labels = paste0(frel_corte_p,"%"),
      labelcol = "red",
      border = "black",
      explode = 0.05,
      shade = 0.5,
      labelcex = 0.8)
legend(x="topright",legend = c("Regular", "Bueno", "Muy bueno", "Premium","Ideal"), fill =hcl.colors(length(frel_corte_p), "Viridis"), title = "Tipo de corte",border = "white",box.col = "white", cex = 0.6)

ggplot(muestra1, aes(x = corte)) + geom_bar(color="#000000", fill="#9B30FF",width=0.5) + labs(x = "Corte", y = "Número de Diamantes") + ggtitle("Proporción de Diamantes por Tipo de Corte") + theme_minimal()

Por ultimo se presenta un diagrama que relaciona el tipo de corte y su precio respectivo:

ggplot(muestra1, aes(x = corte, y = precio, fill = corte))+ geom_boxplot(notch=TRUE) + labs(x = "Corte", y = "Precio ($USD)") +
  ggtitle("Precio de los Diamantes por Tipo de Corte") + stat_summary(fun.y=mean, geom="point", shape=23, size=4)

De este ultimo diagrama se puede notar que los precios no varían tan notoriamente entre los tipos de corte, teniendo en cuenta que la mayoría de datos se encuentran entre los cortes premium e ideales.

Analisis de color

Ahora se continuara el análisis de los diamantes respecto a su color comenzando por una tabla de frecuencias:

#Frecuencia absoluta
fabs_Color <- table(muestra1$color)
#Frecuencia absoluta acumulada
fabs_acum_Color <- cumsum(fabs_Color)
#Frecuencia relativa
frel_color <- fabs_Color/length(muestra1$color)
#Frecuencia relativa porcentaje
frel_color_p <- (fabs_Color/length(muestra1$color))*100
#Frecuencia relativa acumulada
frel_acum_color <- cumsum(frel_color)
#Frecuencia relativa acumulada porcentaje
frel_acum_color_p <- cumsum(frel_color_p)
#Datos
datos_Freq_Color <- cbind(fabs_Color,fabs_acum_Color,frel_color,frel_color_p,frel_acum_color,frel_acum_color_p)
#construcción de la tabla
aux2 <- c("Frecuencia absoluta","Frequencia absoluta acumulada","Frecuencia relativa","%","Frecuencia relativa acumulada","%")
tablafreq2 <- knitr::kable(datos_Freq_Color,caption = "Tabla de frecuencia de la variable color de J(peor) a D(mejor).", format = "markdown",col.names = aux2,align = 'cccccc',digits = 3)

Tabla de frecuencia de la variable color de J(peor) a D(mejor).
	Frecuencia absoluta	Frequencia absoluta acumulada	Frecuencia relativa	%	Frecuencia relativa acumulada	%
D	118	118	0.118	11.8	0.118	11.8
E	184	302	0.184	18.4	0.302	30.2
F	155	457	0.155	15.5	0.457	45.7
G	215	672	0.215	21.5	0.672	67.2
H	174	846	0.174	17.4	0.846	84.6
I	97	943	0.097	9.7	0.943	94.3
J	57	1000	0.057	5.7	1.000	100.0

De esta tabla podemos analizar que hay una pequeña mayoría de diamantes con colores entre E, F y G de los que podríamos decir están en calidad promedio mientras que los de menor calidad son bastante mas poco frecuentes; visto de una manera mas grafica tenemos un diagrama de torta:

pie3D(frel_color_p,main="Diagrama de torta color",
      col = hcl.colors(length(frel_color_p), "Spectral"),
      labels = paste0(frel_color_p,"%"),
      labelcol = "red",
      border = "black",
      explode = 0.05,
      shade = 0.5,
      labelcex = 0.8)
legend(x="topright",legend = c("D", "E", "F","G", "H","I","J"), fill =hcl.colors(length(frel_color_p), "Spectral"), title = "Color",border = "white",box.col = "white", cex = 0.6)

Ahora se comparara por medio de diagramas de caja los precios con el tipo corte y color:

ggplot(muestra1, aes(color, precio, color = corte)) + 
  geom_boxplot(notch=TRUE) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el precio y el color de los diamantes",
       subtitle = "Segun corte",
       x = "color",
       y = "Precio",
       color = "corte") + facet_wrap(~corte,scales='free')

De esta gráfica podemos analizar que para cortes a los que se referirá de baja calidad (Regular y bueno) es muy difícil encontrar datos que superen los 10000 sin importar su color. De los cores a los que se referirá de buena calidad (Muy bueno, Premium e Ideal) se comienza a ver que los precios mas arriba de 10000 y se puede notar que hay un gran alza de precios para los colores I y J para el corte premium.

Analisis de claridad

Se procede a analizar la variable claridad comenzando con una tabla de frecuencia:

#Frecuencia absoluta
fabs_claridad <- table(muestra1$claridad)
#Frecuencia absoluta acumulada
fabs_acum_claridad <- cumsum(fabs_claridad)
#Frecuencia relativa
frel_claridad <- fabs_claridad/length(muestra1$claridad)
#Frecuencia relativa porcentaje
frel_claridad_p <- (fabs_claridad/length(muestra1$claridad))*100
#Frecuencia relativa acumulada
frel_acum_claridad <- cumsum(frel_claridad)
#Frecuencia relativa acumulada porcentaje
frel_acum_claridad_p <- (cumsum(frel_claridad))*100
#Datos
datos_Freq_claridad <- cbind(fabs_claridad,fabs_acum_claridad,frel_claridad,frel_claridad_p,frel_acum_claridad,frel_acum_claridad_p)
#construcción de la tabla
aux3 <- c("Frecuencia absoluta","Frequencia absoluta acumulada","Frecuencia relativa","%","Frecuencia relativa acumulada","%")
tablafreq3 <- knitr::kable(datos_Freq_claridad,caption = "Tabla de frecuencia de la variable claridad de l1(peor) a IF(mejor).", format = "markdown",col.names = aux2,align = 'cccccc',digits = 3)

Tabla de frecuencia de la variable claridad de l1(peor) a IF(mejor).
	Frecuencia absoluta	Frequencia absoluta acumulada	Frecuencia relativa	%	Frecuencia relativa acumulada	%
I1	11	11	0.011	1.1	0.011	1.1
SI2	182	193	0.182	18.2	0.193	19.3
SI1	272	465	0.272	27.2	0.465	46.5
VS2	229	694	0.229	22.9	0.694	69.4
VS1	122	816	0.122	12.2	0.816	81.6
VVS2	83	899	0.083	8.3	0.899	89.9
VVS1	64	963	0.064	6.4	0.963	96.3
IF	37	1000	0.037	3.7	1.000	100.0

De esta tabla se puede observar que hay una gran cantidad de diamantes con claridad SI2 y VS2 siendo calidades bajas que representan casi el 50% de los datos y muy poca frecuencia para los diamantes con la mejor claridad siendo VVS1 e IF representando apenas un 10% aproximadamente, de los datos totales. Visto graficamente en un diagrama de torta:

pie3D(frel_claridad_p,main="Diagrama de torta claridad",
      col = hcl.colors(length(frel_claridad_p), "Mako"),
      labels = paste0(frel_claridad_p,"%"),
      labelcol = "red",
      border = "black",
      explode = 0.05,
      shade = 0.5,
      labelcex = 0.8)
legend(x="topright",legend = c("l1", "lF", "Sl1", "Sl2", "VS1","VS2","VVS1","VVS2"), fill =hcl.colors(length(frel_claridad_p), "Mako"), title = "Claridad",border = "white",box.col = "white", cex = 0.5)

Ahora se comparara el precio de los diamantes segun su claridad y tipo de corte por medio de diagramas de caja:

ggplot(muestra1, aes(claridad, precio, color = corte)) + 
  geom_boxplot(notch=TRUE) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el precio y la claridad de los diamantes",
       subtitle = "Segun corte",
       x = "Claridad",
       y = "Precio",
       color = "Corte") + facet_wrap(~corte,scales='free')

De estos diagramas se puede notar que por una falta de datos para corte regular es difícil analizar el precio para este corte según su claridad, mientras que para los cortes de alta calidad se nota una distribución mas regular pero aun notando que la claridad del diamante no varia de manera drástica el precio de los diamantes, incluso analizando los datos atípicos del corte ideal siendo este el que mas datos tiene con este comportamiento.

Variables Cuantitativas

En este sección se analizaremos las diferentes variables de tipo cuantitativas mediante gráficos y medidas descriptivas que nos permitan conocer mas acerca de la muestra que tenemos. Se profundizara mas la variable de precio con unas gráficas propias de la variable comenzando por la distribución de los precios:

ggplot(muestra1, aes(precio, quilate)) + 
  geom_point(alpha = 0.3, color = "purple") +
  labs(x = "Precio ($USD)", y = "Densidad") +
  ggtitle("Distribución de Precios de Diamantes")

ggplot(muestra1, aes(x = precio)) + geom_density(color="darkblue", fill="lightblue") +
  labs(x = "Precio ($USD)", y = "Densidad") +
  ggtitle("Distribución de Precios de Diamantes")

Graficos y Medidas de Tendencia Central

Las medidas de tendencia central más utilizadas y que usaremos en este analisis, son la media aritmética o promedio, la mediana y la moda. Donde la media aritmetica hace referencia a el valor que resulta de repartir equitativamente el total observado entre los individuos de la muestra. La mediana nos divide la muestra en 2 partes iguales de forma ascendente y finalmente, la moda es el valor que mas se repite en la muestra.

Variable Precio

cat("La media es:",mean(muestra1$precio))

## La media es: 3883.338

cat("La mediana es:",median(muestra1$precio))

## La mediana es: 2300

cat("La moda es:",mfv(muestra1$precio))

## La moda es: 734 827

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                    "Mediana", 
                                    "Moda", "Moda2"),
                      value     = c(mean(muestra1$precio),median(muestra1$precio),mfv(muestra1$precio)))
ggplot(muestra1, aes(x=precio))+geom_histogram(color="black", fill="white", binwidth = 1000)+
  labs(title = "Medidas tendencia central precio",
       x = "Precio",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Con esto tenemos una visión mas amplia de las gráficas mostradas anteriormente de distribución, a partir de esta gráfica se puede ver que la mayoría de datos tienen un precio bajo mientras que es mas difícil encontrar diamantes de precios superiores a los 10000, también observando una asimetría positiva.

Variable quilate

cat("La media es:",mean(muestra1$quilate))

## La media es: 0.79846

cat("La mediana es:",median(muestra1$quilate))

## La mediana es: 0.7

cat("La moda es:",mfv(muestra1$quilate))

## La moda es: 0.31

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda"),
                      value     = c(mean(muestra1$quilate),median(muestra1$quilate),mfv(muestra1$quilate)))
ggplot(muestra1, aes(x=quilate))+geom_histogram(color="black", fill="white", binwidth=0.1)+
  labs(title = "Medidas tendencia central quilates",
       x = "Quilates",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Según la gráfica mostrada se observa una distribución poco regular tendiendo a tener una asimetría positiva, dando a entender que es mas frecuente encontrar diamantes de quilate mas bajo. Se comienza a analizar directamente la relación que tiene el peso de los diamantes en quilates con el precio según el tipo de corte que posea representado por las siguientes gráficas:

ggplot(muestra1, aes(quilate, precio, color = corte)) + 
  geom_point(alpha = 0.3) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el peso y el precio de los diamantes por tipo de corte",
       x = "Peso (quilates)",
       y = "Precio (USD)",
       color = "Corte")+ facet_wrap('corte',scales='free_x')

De esta variable es mas evidente que según aumente el peso del diamante el precio de este aumenta casi sin importar el corte, siendo una variable determinante para el precio del diamante.

Variable Profundidad

cat("La media es:",mean(muestra1$profundidad))

## La media es: 61.7463

cat("La mediana es:",median(muestra1$profundidad))

## La mediana es: 61.8

cat("La moda es:",mfv(muestra1$profundidad))

## La moda es: 61.6

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda"),
                      value     = c(mean(muestra1$profundidad),median(muestra1$profundidad),mfv(muestra1$profundidad)))
ggplot(muestra1, aes(x=profundidad))+geom_histogram(color="black", fill="white", binwidth = 0.4)+
  labs(title = "Medidas tendencia central profundidad",
       x = "Profundidad",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

boxplot(muestra1$profundidad, main="Diagrama de cajas por profundidad",col="#7FFF00",pars = list(boxwex=0.5))

De estos datos se puede resaltar una distribución bastante simétrica, que tiene una forma muy similar a la de una distribución normal (campana de Gauss) donde los valores de la media, mediana y moda son muy cercanos, continuamos analizando con relaciona al tipo de corte y precio.

ggplot(muestra1, aes(profundidad, precio, color = corte)) + 
  geom_point(alpha = 0.3) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el la profundidad y el precio de los diamantes por tipo de corte",
       x = "profundidad",
       y = "Precio (USD)",
       color = "Corte")+ facet_wrap('corte',scales='free_x')

De estas gráficas se puede analizar que la profundidad no influye mucho en el precio de los diamantes pues el precio varia sin importar si aumenta o disminuye la variable.

Variable Tabla

De esta variable únicamente se puede resaltar la distribución de sus datos.

cat("La media es:",mean(muestra1$tabla))

## La media es: 57.4946

cat("La mediana es:",median(muestra1$tabla))

## La mediana es: 57

cat("La moda es:",mfv(muestra1$tabla))

## La moda es: 56

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda"),
                      value     = c(mean(muestra1$tabla),median(muestra1$tabla),mfv(muestra1$tabla)))
ggplot(muestra1, aes(x=tabla))+geom_histogram(color="black", fill="white",binwidth = 1)+
  labs(title = "Medidas tendencia central tabla",
       x = "Tabla",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variables de dimension (x,y,z)

De estas variables se resalta de las distribuciones de datos, que tienen una asimetria positiva notando que la moda para la vartiable X y Y es casi la misma mientras que Z tiene unas medidas mas bajas pero teniendo el mismo comportamiento de datos que las otras dos variables.

Variable X

cat("La media es:",mean(muestra1$x))

## La media es: 5.72259

cat("La mediana es:",median(muestra1$x))

## La mediana es: 5.68

cat("La moda es:",mfv(muestra1$x))

## La moda es: 4.34 4.38

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda","Moda2"),
                      value     = c(mean(muestra1$x),median(muestra1$x),mfv(muestra1$x)))
ggplot(muestra1, aes(x=x))+geom_histogram(color="black", fill="white", binwidth = 0.18)+
  labs(title = "Medidas tendencia central x",
       x = "X",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable Y

cat("La media es:",mean(muestra1$y))

## La media es: 5.72452

cat("La mediana es:",median(muestra1$y))

## La mediana es: 5.695

cat("La moda es:",mfv(muestra1$y))

## La moda es: 4.35 4.37

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda",
                                            "Moda2"),
                      value     = c(mean(muestra1$y),median(muestra1$y),mfv(muestra1$y)))
ggplot(muestra1, aes(x=y))+geom_histogram(color="black", fill="white", binwidth = 0.21)+
  labs(title = "Medidas tendencia central y",
       x = "Y",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable Z

cat("La media es:",mean(muestra1$z))

## La media es: 3.53434

cat("La mediana es:",median(muestra1$z))

## La mediana es: 3.52

cat("La moda es:",mfv(muestra1$z))

## La moda es: 2.7

sumstatz <-data.frame(Tendencia_Central = c("Media",
                                            "Mediana", 
                                            "Moda"),
                      value     = c(mean(muestra1$z),median(muestra1$z),mfv(muestra1$z)))
ggplot(muestra1, aes(x=z))+geom_histogram(color="black", fill="white", binwidth = 0.18)+
  labs(title = "Medidas tendencia central z",
       x = "Z",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Relacion entre las dimensiones y el precio con respecto al corte

Ahora veremos a traves de diagramas de puntos como se relaciona el precio del diamante con sus diferentes dimensiones x(largo), y(ancho) y z(profundidad), todas estas dadas en milimetros. Ademas de filtrarlas por tipo de corte para asi,tener un mejor analisis. Para la variable X

medidax <- muestra1$x
mediday <- muestra1$y
medidaz <- muestra1$z
ggplot(muestra1, aes(medidax, precio)) + 
  geom_point(color="blue", alpha = 0.3) + 
  scale_color_brewer(palette = "Set2") +
  labs(title = "Relación entre el ancho  y el precio de los diamantes",
       x = "Ancho",
       y = "Precio (USD)")

ggplot(muestra1, aes(medidax, precio, color = corte)) + 
  geom_point(alpha = 0.3) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el largo  y el precio de los diamantes por tipo de corte",
       x = "Largo",
       y = "Precio (USD)",
       color = "Corte")+ facet_wrap('corte',scales='free_x')

Para la variable Y

ggplot(muestra1, aes(mediday, precio)) + 
  geom_point(color="blue", alpha = 0.3) + 
  scale_color_brewer(palette = "Set2") +
  labs(title = "Relación entre el alto y el precio de los diamantes",
       x = "Alto",
       y = "Precio (USD)")

ggplot(muestra1, aes(mediday, precio, color = corte)) + 
  geom_point(alpha = 0.3) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre el ancho  y el precio de los diamantes por tipo de corte",
       x = "Alto",
       y = "Precio (USD)",
       color = "Corte")+ facet_wrap('corte',scales='free_x')

Para la variable Z

ggplot(muestra1, aes(medidaz, precio)) + 
  geom_point(color="blue", alpha = 0.3) + 
  scale_color_brewer(palette = "Set2") +
  labs(title = "Relación entre la profundiad  y el precio de los diamantes",
       x = "Profundidad",
       y = "Precio (USD)")

ggplot(muestra1, aes(medidaz, precio, color = corte)) + 
  geom_point(alpha = 0.3) + 
  scale_color_brewer(palette = "Set1") +
  labs(title = "Relación entre la profundidad y el precio de los diamantes por tipo de corte",
       x = "Profundidas",
       y = "Precio (USD)",
       color = "Corte")+ facet_wrap('corte',scales='free_x')

Se puede observar que para estos tres casos los tamaños influyen notoriamente en el precio final de los diamantes viendo como a medida que aumentan sus dimensiones aumenta su precio.

Medidas de Variabilidad

Las medidas de variabilidad más utilizadas y que usaremos en este analisis, son: el rango, la varianza, la desviacion estandar y el coeficiente de variacion. Donde el rango representa la diferencia entre el valor maximo y minimo de una muestra, la varianza representa la variabilidad que hay entre un conjunto de datos con respecto a la media del mismo conjunto, y la desviacion estandar al igual que el cofieciente de variacion nos dicen qué tan dispersos están los datos con respecto a la media, sin embargo este ultimo sirve para comparar la variación de los datos que tienen unidades diferentes o medias muy diferentes, expresandolo en forma de porcentaje.

Variables = c("Rango", "Varianza", "Desviacion Estandar", "Coef. Variacion")
Precio = c(max(muestra1$precio) - min(muestra1$precio),
            var(muestra1$precio),
            sqrt(var(muestra1$precio)),
            round(sqrt(var(muestra1$precio)) / mean(muestra1$precio) * 100, 3))
Quilate = c(max(muestra1$quilate) - min(muestra1$quilate),
             var(muestra1$quilate),
             sqrt(var(muestra1$quilate)),
             round(sqrt(var(muestra1$quilate)) / mean(muestra1$quilate) * 100, 3))
Profundidad = c(max(muestra1$profundidad) - min(muestra1$profundidad),
                 var(muestra1$profundidad),
                 sqrt(var(muestra1$profundidad)),
                 round(sqrt(var(muestra1$profundidad)) / mean(muestra1$profundidad) * 100, 3))
Tabla = c(max(muestra1$tabla) - min(muestra1$tabla),
           var(muestra1$tabla),
           sqrt(var(muestra1$tabla)),
           round(sqrt(var(muestra1$tabla)) / mean(muestra1$tabla) * 100, 3))
x = c(max(muestra1$x) - min(muestra1$x),
       var(muestra1$x),
       sqrt(var(muestra1$x)),
       round(sqrt(var(muestra1$x)) / mean(muestra1$x) * 100, 3))
y = c(max(muestra1$y) - min(muestra1$y),
       var(muestra1$y),
       sqrt(var(muestra1$y)),
       round(sqrt(var(muestra1$y)) / mean(muestra1$y) * 100, 3))
z = c(max(muestra1$z) - min(muestra1$z),
       var(muestra1$z),
       sqrt(var(muestra1$z)),
       round(sqrt(var(muestra1$z)) / mean(muestra1$z) * 100, 3))

a = data.frame(Variables, Precio, Quilate, Profundidad, Tabla, x, y, z)
a

Medidas de Posicion

Para este analisis haremos uso de 2 medidas de posicion, los cuartiles, los percentiles y el rango intercuartilico, donde, los cuartiles hacen referencia a el valor Q1,Q2,Q3 que dividen ascendentemente la muestra en 4 partes iguales, por ejemplo Q1 divide a la muestra en el 25% de datos menores y el 75% de datos mayores y asi sucesivamente (notese que Q2 va a coincidir con la mediana), y los percentiles siguen la misma logica solo que estos van desde P1 hasta P9 dividiendo la muestra en 10 partes iguales, por ejemplo P2 divide la muestra en el 20% de datos menores y el 80% de datos mayores (note que Q2=P5=Mediana), finalmente el rango intercuartilico viene dado por la diferencia de Q3 y Q1 y siguiendo esta logica nos divide la muestra en 3 partes (no iguales) una el 25% de los datos menores, luego el 50% de los datos mayores al 25% y menores al 75% y por ultimo el 25% de los datos mayores. Los cuartiles y el rango intercuartilico nos seran de mucha ayuda a la hora de construir nuestros diagramas de caja o boxplot.

Variable Precio

Veamos los cuartiles:

cuartiles <- quantile(muestra1$precio, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$precio, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=precio))+geom_histogram(color="black", fill="white", binwidth = 1000)+
  labs(title = "Medidas de posicion precio",
       x = "Precio",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable quilate

Veamos los cuartiles:

cuartiles <- quantile(muestra1$quilate, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$quilate, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=quilate))+geom_histogram(color="black", fill="white", binwidth = 0.1)+
  labs(title = "Medidas de posicion profundidad",
       x = "profundidad",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable profundidad

Veamos los cuartiles:

cuartiles <- quantile(muestra1$profundidad, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$profundidad, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=profundidad))+geom_histogram(color="black", fill="white", binwidth = 0.4)+
  labs(title = "Medidas de posicion profundidad",
       x = "profundidad",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable tabla

Veamos los cuartiles:

cuartiles <- quantile(muestra1$tabla, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$tabla, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=tabla))+geom_histogram(color="black", fill="white", binwidth = 1)+
  labs(title = "Medidas de posicion tabla",
       x = "tabla",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable x

Veamos los cuartiles:

cuartiles <- quantile(muestra1$x, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$x, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=x))+geom_histogram(color="black", fill="white", binwidth = 0.18)+
  labs(title = "Medidas de posicion x",
       x = "x",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable y

Veamos los cuartiles:

cuartiles <- quantile(muestra1$y, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles

percentiles <- quantile(muestra1$y, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=y))+geom_histogram(color="black", fill="white", binwidth = 0.21)+
  labs(title = "Medidas de posicion y",
       x = "y",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Variable z

Veamos los cuartiles:

cuartiles <- quantile(muestra1$z, probs = c(0.25, 0.5, 0.75))
cuartiles=data.frame(cuartiles)
cuartiles

Y ahora los percentiles:

percentiles <- quantile(muestra1$z, probs = c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9))
percentiles=data.frame(percentiles)
percentiles

sumstatz <-data.frame(Tendencia_Central = c("Q1",
                                    "Q2", "Q3", "P1", "P3", "P8"),
                      value     = c(cuartiles[1,1],cuartiles[2,1],cuartiles[3,1],percentiles[1,1],percentiles[3,1], percentiles[8,1]))
ggplot(muestra1, aes(x=z))+geom_histogram(color="black", fill="white", binwidth = 0.18)+
  labs(title = "Medidas de posicion z",
       x = "z",
       y = "Frecuencia")+
  geom_vline(data=sumstatz,aes(xintercept = value,linetype = Tendencia_Central,col = Tendencia_Central),linewidth=1)

Conclusiones

Durante el análisis estadístico, encontramos que los diamantes más comunes no son los que tienen las mejores características. Esto no solo se debe a que este tipo de diamante es más difícil de obtener, sino también a que es muy costoso en comparación con otros diamantes. Lo anterior conduce a mayores dificultades en el mercado dando como resultado, que la mayoría de los diamantes no se encuentran en la más alta calidad sino en una más estandarizada.
Se puede evidenciar cómo el precio de venta de los diamantes es proporcional a su peso en quilates, sin que esté sea influenciado en gran medida por el tipo de corte que tienen, esto da a entender que los compradores prefieren pagar más por un diamante con más quilates que por uno con un mejor acabado superficial.
En general, las variables cuantitativas mantienen una variabilidad baja (entre el 2% y 20%), esto lo sabemos gracias a el coeficiente de variacion que calculamos. Sin embargo las variables de precio y de quilate tienen una variabilidad alta (102% y 61% respectivamente), en particular vemos que el precio tiene una variabilidad exagerada mayor al 100% con respecto a su media, lo que nos indica una alta variabilidad en la muestra, alterada por los datos atipicos, que en su mayoria vienen dados por diamantes con precios muy altos. En otras palabras, los datos de la variable precio estan muy dispersos.

Parcial 1 Probabilidad y estadistica

Duvan stiven Tique Osorio , Luis Felipe Cubillos Vargas, Daniel Alejandro Delgado Moreno, Juan Andres Camacho Zarate

2023-12-03

Introduccion

Variables Cualitativas

Analisis de corte

Analisis de color

Analisis de claridad

Variables Cuantitativas

Graficos y Medidas de Tendencia Central

Variable Precio

Variable quilate

Variable Profundidad

Variable Tabla

Variables de dimension (x,y,z)

Variable X

Variable Y

Variable Z

Relacion entre las dimensiones y el precio con respecto al corte

Medidas de Variabilidad

Medidas de Posicion

Variable Precio

Variable quilate

Variable profundidad

Variable tabla

Variable x

Variable y

Variable z

Conclusiones