Parcial 1
Nicolás Mercado Romero
14 de Marzo de 2023
Introducción
El siguiente documento tiene como objetivo realizar un análisis estadístico mediante R Markdown. Se utilizarán los conceptos de Tabla de Frecuencias y gráficos para los diferentes tipos de variables. Además de eso se busca obtener la información sobre la tendencia, patrones y medidas descriptivas necesarias para dicho estudio estadístico.
Para la realización de esta práctica se tomó una muestra de mil datos de la librería “datos” que incluye información sobre precios y características de 53940 diamantes. Las variables utilizadas son: Precio, Quilate, Corte, Color, Claridad, Profundidad, Tabla (ancho superior diamante), X(Longitud), Y(Ancho), Z(Profundidad).
#Variables Cuantitativas Iniciaremos este análisis evaluando las variables cuantitativas. ## Análisis Frecuencias
#LLAMA LIBRERIA
library(datos)
library(fdth)
library(modeest)
library(plotrix)
set.seed(7822)
datos.d <- data.frame(diamantes)
muestra1 <- datos.d[sample(nrow(datos.d),size=1000),0:10]
attach(muestra1)
Tabla_precio<- as.data.frame(table(precio=factor(cut(precio, breaks=11))))
attach(Tabla_precio)
Tabla_quilate<- as.data.frame(table(quilate=factor(cut(quilate, breaks=11))))
attach(Tabla_quilate)
Tabla_profundidad<- as.data.frame(table(profundidad=factor(cut(profundidad, breaks=11))))
attach(Tabla_profundidad)
Tabla_tabla<- as.data.frame(table(tabla=factor(cut(tabla, breaks=11))))
attach(Tabla_tabla)
Tabla_x<- as.data.frame(table(x=factor(cut(x, breaks=11))))
attach(Tabla_x)
Tabla_y<- as.data.frame(table(y=factor(cut(y, breaks=11))))
attach(Tabla_y)
Tabla_z<- as.data.frame(table(z=factor(cut(z, breaks=11))))
attach(Tabla_z)
k=1+3.322*log(nrow(muestra1),10)PRECIO
Tabla_precio[["Frc. Rel"]] <- with (Tabla_precio, Freq/1000)
Tabla_precio[["Frc. Rel(%)"]] <- with (Tabla_precio, (Freq/1000)*100)
Tabla_precio[["Frc. Abso. Acu"]] <- with (Tabla_precio, cumsum(Freq))
Tabla_precio[["Frc. Rela. Acu"]] <- with (Tabla_precio, cumsum((Freq/1000)*100))
a<- fdt(muestra1$precio)
Tabla_precioplot(a,type = "fh",main = "Histograma de Precio",xlab="Precio",ylab = "Frecuencia", col = "#79edc7")
plot(a,type = "fp",main = "Poligono de Precio",xlab="Precio",ylab = "Frecuencia", col = "black")
### PRUEB
QUILATE
Tabla_quilate[["Frc. Rel"]] <- with (Tabla_quilate, Freq/1000)
Tabla_quilate[["Frc. Rel(%)"]] <- with (Tabla_quilate, (Freq/1000)*100)
Tabla_quilate[["Frc. Abso. Acu"]] <- with (Tabla_quilate, cumsum(Freq))
Tabla_quilate[["Frc. Rela. Acu"]] <- with (Tabla_quilate, cumsum((Freq/1000)*100))
h<- fdt(muestra1$quilate)
Tabla_quilateplot(h,type = "fh",main = "Histograma de Quilate",xlab="Quilate",ylab = "Frecuencia", col = "#79edc7")
plot(h,type = "fp",main = "Poligono de Quilate",xlab="Quilate",ylab = "Frecuencia", col = "black")
PROFUNDIDAD
Tabla_profundidad[["Frc. Rel"]] <- with (Tabla_profundidad, Freq/1000)
Tabla_profundidad[["Frc. Rel(%)"]] <- with (Tabla_profundidad, (Freq/1000)*100)
Tabla_profundidad[["Frc. Abso. Acu"]] <- with (Tabla_profundidad, cumsum(Freq))
Tabla_profundidad[["Frc. Rela. Acu"]] <- with (Tabla_profundidad, cumsum((Freq/1000)*100))
b<- fdt(muestra1$profundidad)
Tabla_profundidadplot(b,type = "fh",main = "Histograma de Profundidad",xlab="Profundidad",ylab = "Frecuencia", col = "#79edc7")
plot(b,type = "fp",main = "Poligono de Profundidad",xlab="Profundidad",ylab = "Frecuencia", col = "black")
TABLA (ANCHO SUPERIOR)
Tabla_tabla[["Frc. Rel"]] <- with (Tabla_tabla, Freq/1000)
Tabla_tabla[["Frc. Rel(%)"]] <- with (Tabla_tabla, (Freq/1000)*100)
Tabla_tabla[["Frc. Abso. Acu"]] <- with (Tabla_tabla, cumsum(Freq))
Tabla_tabla[["Frc. Rela. Acu"]] <- with (Tabla_tabla, cumsum((Freq/1000)*100))
c<- fdt(muestra1$tabla)
Tabla_tablaplot(c,type = "fh",main = "Histograma de Tabla (Ancho superior)",xlab="Tabla (Ancho superior)",ylab = "Frecuencia", col = "#79edc7")
plot(c,type = "fp",main = "Poligono de Tabla (Ancho superior)",xlab="Tabla (Ancho superior)",ylab = "Frecuencia", col = "black")
X (LONGITUD)
Tabla_x[["Frc. Rel"]] <- with (Tabla_x, Freq/1000)
Tabla_x[["Frc. Rel(%)"]] <- with (Tabla_x, (Freq/1000)*100)
Tabla_x[["Frc. Abso. Acu"]] <- with (Tabla_x, cumsum(Freq))
Tabla_x[["Frc. Rela. Acu"]] <- with (Tabla_x, cumsum((Freq/1000)*100))
d<- fdt(muestra1$x)
Tabla_xplot(d,type = "fh",main = "Histograma de X (Longitud)",xlab="X (Longitud)",ylab = "Frecuencia", col = "#79edc7")
plot(d,type = "fp",main = "Poligono de X (Longitud)",xlab="X (Longitud)",ylab = "Frecuencia", col = "black")
Y(ANCHO)
Tabla_y[["Frc. Rel"]] <- with (Tabla_y, Freq/1000)
Tabla_y[["Frc. Rel(%)"]] <- with (Tabla_y, (Freq/1000)*100)
Tabla_y[["Frc. Abso. Acu"]] <- with (Tabla_y, cumsum(Freq))
Tabla_y[["Frc. Rela. Acu"]] <- with (Tabla_y, cumsum((Freq/1000)*100))
e<- fdt(muestra1$y)
Tabla_yplot(e,type = "fh",main = "Histograma de Y (Ancho)",xlab=" Y (Ancho)",ylab = "Frecuencia", col = "#79edc7")
plot(e,type = "fp",main = "Poligono de Y (Ancho)",xlab=" Y (Ancho)",ylab = "Frecuencia", col = "black")
Z (PROFUNDIDAD)
Tabla_z[["Frc. Rel"]] <- with (Tabla_z, Freq/1000)
Tabla_z[["Frc. Rel(%)"]] <- with (Tabla_z, (Freq/1000)*100)
Tabla_z[["Frc. Abso. Acu"]] <- with (Tabla_z, cumsum(Freq))
Tabla_z[["Frc. Rela. Acu"]] <- with (Tabla_z, cumsum((Freq/1000)*100))
d<- fdt(muestra1$y)
Tabla_zplot(d,type = "fh",main = "Histograma de Z (Profundidad)",xlab=" Z (Profundidad)",ylab = "Frecuencia", col = "#79edc7")
plot(d,type = "fp",main = "Poligono de Z (Profundidad)",xlab=" Z (Profundidad)",ylab = "Frecuencia", col = "black")
Medidas de Tendencia Central
Aspecto = c("Precio","Quilates","Profundidad","Tabla (Ancho superior)","X (Longitud)","Y (Ancho)","Z (Profundidad)")
Media = c(mean(muestra1$precio),mean(muestra1$quilate),mean(muestra1$profundidad),mean(muestra1$tabla),mean(muestra1$x),mean(muestra1$y),mean(muestra1$z))
Mediana = c(median(muestra1$precio),median(muestra1$quilate),median(muestra1$profundidad),median(muestra1$tabla),median(muestra1$x),median(muestra1$y),median(muestra1$z))
Moda = c(mfv(muestra1$precio)[1],mfv(muestra1$quilate)[1],mfv(muestra1$profundidad)[1],mfv(muestra1$tabla)[1],mfv(muestra1$x)[1],mfv(muestra1$y)[1],mfv(muestra1$z)[1])
dataf = data.frame(Aspecto,Media,Mediana,Moda)
datafMedidas de Posición
Cuartiles
Q0 = c(quantile(muestra1$precio)[1],quantile(muestra1$quilate)[1],quantile(muestra1$profundidad)[1],quantile(muestra1$tabla)[1],quantile(muestra1$x)[1],quantile(muestra1$y)[1],quantile(muestra1$z)[1])
Q1 = c(quantile(muestra1$precio)[2],quantile(muestra1$quilate)[2],quantile(muestra1$profundidad)[2],quantile(muestra1$tabla)[2],quantile(muestra1$x)[2],quantile(muestra1$y)[2],quantile(muestra1$z)[2])
Q2 = c(quantile(muestra1$precio)[3],quantile(muestra1$quilate)[3],quantile(muestra1$profundidad)[3],quantile(muestra1$tabla)[3],quantile(muestra1$x)[3],quantile(muestra1$y)[3],quantile(muestra1$z)[3])
Q3 = c(quantile(muestra1$precio)[4],quantile(muestra1$quilate)[4],quantile(muestra1$profundidad)[4],quantile(muestra1$tabla)[4],quantile(muestra1$x)[4],quantile(muestra1$y)[4],quantile(muestra1$z)[4])
Q4 = c(quantile(muestra1$precio)[5],quantile(muestra1$quilate)[5],quantile(muestra1$profundidad)[5],quantile(muestra1$tabla)[5],quantile(muestra1$x)[5],quantile(muestra1$y)[5],quantile(muestra1$z)[5])
Med_posición = data.frame(Aspecto,Q0,Q1,Q2,Q3,Q4)
Med_posiciónDiagramas de Caja
Este tipo de gráficas nos permite identificar si hay datos sospechosos.
boxplot(muestra1$precio,main = "Diagrama de caja del precio de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$quilate,main = "Diagrama de caja de los quilates de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$profundidad,main = "Diagrama de caja de profundidad de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$tabla,main = "Diagrama de caja de Tabla (Ancho superior) de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$x,main = "Diagrama de caja del X (Longitud) de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$y,main = "Diagrama de caja del Y (Ancho) de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
boxplot(muestra1$z,main = "Diagrama de caja del z (Profundidad) de los diamantes",xlab="Precio",ylab = "Frecuencia", col = "red")
Medidas de Dispersión
Varianza
En este caso, ya que la varianza del precio es sumamente grande en comparación a los demás datos, se tomó la decisión de realizar un segundo gráfico din la variable del precio para lograr evidenciar la varianza de las demás variables.
Varianza<-c(var(muestra1$precio),var(muestra1$quilate),var(muestra1$profundidad),var(muestra1$tabla),var(muestra1$x),var(muestra1$y),var(muestra1$z))
Varianza2<-c(var(muestra1$quilate),var(muestra1$profundidad),var(muestra1$tabla),var(muestra1$x),var(muestra1$y),var(muestra1$z))
barplot(Varianza, names.arg = c("Precio","Quilates","Prof.","Tabla","X","Y","Z"), col="#9B59B6", main = "Varianza de los Aspectos",xlab= "Aspecto", ylab= "Varianza" )
barplot(Varianza2, names.arg = c("Quilates","Prof.","Tabla","X","Y","Z"), col="#9B59B6", main = "Varianza de los Aspectos 2",xlab= "Aspecto", ylab= "Varianza" )
Desviación
Como en el anterior análisis, el precio nuevamente tiene una desviación muy alta en comparación a las demás variables. Se realizan dos gráficos para evidenciar la desviación de las demás variables.
Desviacion<-c(sd(muestra1$precio),sd(muestra1$quilate),sd(muestra1$profundidad),sd(muestra1$tabla),sd(muestra1$x),sd(muestra1$y),sd(muestra1$z))
Desviacion2<-c(sd(muestra1$quilate),sd(muestra1$profundidad),sd(muestra1$tabla),sd(muestra1$x),sd(muestra1$y),sd(muestra1$z))
barplot(Desviacion, names.arg = c("Precio","Quilates","Prof.","Tabla","X","Y","Z"), col="#9B59B6", main = "Desviación de los Aspectos",xlab= "Aspecto", ylab= "Desviación" )
barplot(Desviacion2, names.arg = c("Quilates","Prof.","Tabla","X","Y","Z"), col="#9B59B6", main = "Desviación de los Aspectos 2",xlab= "Aspecto", ylab= "Desviación" )
Dispersión
En la realización de los análisis de dispersión se decidió unicamente graficar dos correlaciones de variables. Esto debido a que gracias a la función “abline” y la ubicación de la línea generada podemos identificar si dos datos se encuentran correlacionados. En esta ocasión las gráficas generadas con otras variables eran muy similares o no se correlacionaban de una manera muy notoria con el precio.
plot(muestra1$precio ~ muestra1$quilate, main = "Diagrama de Dispersión entre Precio y Quilate", xlab= "Quilate", ylab = "Precio", col = rainbow(10))
abline(lm(muestra1$precio ~ muestra1$quilate))
plot(muestra1$precio ~ muestra1$x, main = "Diagrama de Dispersión entre Precio y X (Longitud)", xlab= "X (Longitud)", ylab = "Precio", col = rainbow(10))
abline(lm(muestra1$precio ~ muestra1$x))
Variables Cualitativas
Tipos de Corte
Tabla de frecuencias
table(muestra1$corte)##
## Regular Bueno Muy bueno Premium Ideal
## 34 71 240 263 392Gráficos Frecuencias
Tabla_corte<-c(table(muestra1$corte))
barplot((c(table(muestra1$corte))), main = "Tabla de frecuencias de Tipos de Corte", xlab = "Tipos de Corte", ylab = "Frecuencia", col = "palegreen2")
pie3D(Tabla_corte, radius = 1,main = "Diagrama de Torta de Tipos de Corte", height = 0.2, theta = 0.7, col = rainbow(5) , shade = 0.5, labels = c("Regular(34)","Bueno(71)","Muy bueno(240)","Premium(263)", "Ideal(392)" ))
Tipos de Color
Tabla de frecuencias
table(muestra1$color)##
## D E F G H I J
## 115 163 165 208 181 114 54Gráficos Frecuencias
Tabla_color<-c(table(muestra1$color))
barplot((c(table(muestra1$color))), main = "Tabla de frecuencias de Colores", xlab = "Tipos de Corte", ylab = "Frecuencia", col = "palegreen2")
pie3D(Tabla_color, radius = 1,main = "Diagrama de Torta de Tipos de Color", height = 0.2, theta = 0.7, col = rainbow(10) , shade = 0.5, labels = c("D(115)","E(163)","F(165)","G(208)","H(181)","I(114)","J(54)"))
Claridad de los Diamantes
Tabla de frecuencias
table(muestra1$claridad)##
## I1 SI2 SI1 VS2 VS1 VVS2 VVS1 IF
## 14 171 255 212 144 89 82 33Gráficos Frecuencias
Tabla_claridad<-c(table(muestra1$claridad))
barplot((c(table(muestra1$claridad))), main = "Tabla de frecuencias de Claridad", xlab = "Claridad", ylab = "Frecuencia", col = "palegreen2")
pie3D(Tabla_claridad, radius = 1,main = "Diagrama de Claridad", height = 0.2, theta = 0.7, col = rainbow(10) , shade = 0.5, labels = c("l1(14)","Sl2(171)","Sl1(255)","VS2(212)", "VS1(144)","VVS2(89)","VVS1(82)","IF(33)" ))
Conclusión
Teniendo en cuenta que se tomó una muestra de 1000 sujetos y sus diferentes variables podemos llegar a las siguientes conclusiones.
El rango del precio es bastante extenso.
La mayoría de los diamantes tienen un precio debajo de los $3680.
Gracias a los diagramas de caja podemos evidenciar que las variables que no tienen datos atipicos son X y Y.
La variable con mayor desviación y varianza es el precio.
Durante los análisis de dispersión podemos notar que no todas las variables se encuentran directamente correlacionadas con el precio de cada diamante.
El precio está correlacionado con las variables quilate, x, y, z.
Gracias a la interfaz de rstudio y los conocimientos obtenidos durante este tiempo del semestre he podido realizar un análisis estadístico de una muestra de sujetos utilizando los diferentes conceptos y herramientas aprendidas.