summary(diamonds)
## carat cut color clarity depth
## Min. :0.2000 Fair : 1610 D: 6775 SI1 :13065 Min. :43.00
## 1st Qu.:0.4000 Good : 4906 E: 9797 VS2 :12258 1st Qu.:61.00
## Median :0.7000 Very Good:12082 F: 9542 SI2 : 9194 Median :61.80
## Mean :0.7979 Premium :13791 G:11292 VS1 : 8171 Mean :61.75
## 3rd Qu.:1.0400 Ideal :21551 H: 8304 VVS2 : 5066 3rd Qu.:62.50
## Max. :5.0100 I: 5422 VVS1 : 3655 Max. :79.00
## J: 2808 (Other): 2531
## table price x y
## Min. :43.00 Min. : 326 Min. : 0.000 Min. : 0.000
## 1st Qu.:56.00 1st Qu.: 950 1st Qu.: 4.710 1st Qu.: 4.720
## Median :57.00 Median : 2401 Median : 5.700 Median : 5.710
## Mean :57.46 Mean : 3933 Mean : 5.731 Mean : 5.735
## 3rd Qu.:59.00 3rd Qu.: 5324 3rd Qu.: 6.540 3rd Qu.: 6.540
## Max. :95.00 Max. :18823 Max. :10.740 Max. :58.900
##
## z
## Min. : 0.000
## 1st Qu.: 2.910
## Median : 3.530
## Mean : 3.539
## 3rd Qu.: 4.040
## Max. :31.800
##
head(diamonds)
## carat cut color clarity depth table price x y z
## 1 0.23 Ideal E SI2 61.5 55 326 3.95 3.98 2.43
## 2 0.21 Premium E SI1 59.8 61 326 3.89 3.84 2.31
## 3 0.23 Good E VS1 56.9 65 327 4.05 4.07 2.31
## 4 0.29 Premium I VS2 62.4 58 334 4.20 4.23 2.63
## 5 0.31 Good J SI2 63.3 58 335 4.34 4.35 2.75
## 6 0.24 Very Good J VVS2 62.8 57 336 3.94 3.96 2.48
print(dim(diamonds))
## [1] 53940 10
sd(diamonds$carat)
## [1] 0.4740112
sd(diamonds$depth)
## [1] 1.432621
sd(diamonds$price)
## [1] 3989.44
sd(diamonds$table)
## [1] 2.234491
De los datos podemos evidenciar lo siguiente:
El conjunto de datos cuenta con un total de 10 variables las cuáles son: price (dólares estadounidenses), carat (peso del diamante en un rango de 0.2 a 5.01), cut (calidad del corte), color (color del diamante), clarity (medida de que tanj claro es el diamante), x (longitud en milímetros), y (anchura en milímetros), z (profundidad en milímetros), depth (porcentaje total de profundidad) y table (anchura de la parte superior del diamante relativa a su punto más ancho).
Cada una de las 10 variables que hay, representando las 10 columnas del dataset, hay un total de 53,940 observaciones.
Para el caso de la variable carat tenemos que los datos se encuentran entre un rango de 0.2000 a 5.0100, la mediana es 0.7000 y la media es 0.7979, por lo que hay una ligera asimetría positiva en los datos, la media con una desviación estándar de 0.4740 y el 50% de los datos se encuentran entre 0.4000 a 1.0400
Para el caso de la variable depth tenemos que los datos se encuentran entre un rango de 43 a 79, la mediana es 61.80 y la media es 61.75, por lo que tenemos una distribución simétrica en los datos, la media con una desviación estándar de 1.433 y el 50% de los datos se encuentran entre 61 a 62.50.
Para el caso de la variable price tenemos que los datos se encuentran entre un rango de 326 a 18,823, la mediana es 2,401 y la media es 3,933, por lo que tenemos una asimetría positiva en los datos, la media con una desviación estándar de 3,989.44 y el 50% de los datos se encuentran entre 950 a 5,324.
Para el caso de la variable table tenemos que los datos se encuentran entre un rango de 43 a 95, la mediana es 57 y la media es 57.46, por lo que tenemos una distribución casi simétrica en los datos (solo con una leve asimetría positiva), la media con una desviación estándar de 2.234 y el 50% de los datos se encuentran entre 56 a 59.
# Gráficos de correlación:
par(mfrow = c(1, 1), mar = c(4, 4, 2, 1))
plot(diamonds$carat, diamonds$price, main="Precio vs. Carat", pch=19, col="skyblue")
plot(diamonds$x, diamonds$price, main="Precio vs. Carat", pch=19, col="skyblue")
plot(diamonds$y, diamonds$price, main="Precio vs. Carat", pch=19, col="skyblue")
plot(diamonds$z, diamonds$price, main="Precio vs. Carat", pch=19, col="skyblue")
# Accedemos a los datos:
price <- diamonds$price
carat <- diamonds$carat
# Calculamos la varianza conjunta manualmente:
N <- length(carat)
x_mean <- mean(carat)
y_mean <- mean(price)
numerator <- sum((carat - x_mean)*(price - y_mean))
cov <- numerator/(N - 1)
print(cov)
## [1] 1742.765
# Gráficos de dispersión:
plot(carat, price, main="Carat vs. Price", pch=19, col="skyblue")
Existe una correlación positiva entre el Carat y el price.
# CÁLCULO DEL COEFICIENTE DE PEARSON MUESTRAL (r):
# Cálculo manual:
xy <- sum(carat*price)
xi <- mean(carat)
yi <- mean(price)
xn <- sum(carat)
yn <- sum(price)
x1n <- sum((carat)^2)
y1n <- sum((price)^2)
numerator <- xy - ((xn*yn)/N)
denominator <- sqrt((x1n-(xn^2/N))*(y1n-(yn^2/N)))
p <- numerator/denominator
print(paste("p: ", p))
## [1] "p: 0.921591301193477"
# Cálculo computacional:
r <- cor(price, carat)
print(paste("COEFICIENTE DE CORRELACIÓN: ", r))
## [1] "COEFICIENTE DE CORRELACIÓN: 0.921591301193477"
cor.test(price, carat)
##
## Pearson's product-moment correlation
##
## data: price and carat
## t = 551.41, df = 53938, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.9203098 0.9228530
## sample estimates:
## cor
## 0.9215913
r_det <- (r*r)*100
print(paste("COEFICIENTE DE DETERMINACIÓN: ", r_det, "%"))
## [1] "COEFICIENTE DE DETERMINACIÓN: 84.9330526435486 %"
# Cálculo manual:
xy <- sum(carat*price)
x_mean <- mean(carat)
y_mean <- mean(price)
x_sum <- sum(carat)
y_sum <- sum(price)
x_cuad <- sum((carat)^2)
y_cuad <- sum((price)^2)
numerator <- xy - ((x_sum*y_sum)/N)
denominator <- x_cuad - ((x_sum)^2/N)
b_1 <- numerator/denominator
print(paste("PENDIENTE (B_1): ", b_1))
## [1] "PENDIENTE (B_1): 7756.42561796844"
b_0 <- y_mean - (b_1*x_mean)
print(paste("INTERCEPTO EN Y (B_0): ", b_0))
## [1] "INTERCEPTO EN Y (B_0): -2256.36058004541"
# Cálculo computacional:
modelo1 <- lm(price ~ carat) # y ~ x
summary(modelo1)
##
## Call:
## lm(formula = price ~ carat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18585.3 -804.8 -18.9 537.4 12731.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2256.36 13.06 -172.8 <2e-16 ***
## carat 7756.43 14.07 551.4 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1549 on 53938 degrees of freedom
## Multiple R-squared: 0.8493, Adjusted R-squared: 0.8493
## F-statistic: 3.041e+05 on 1 and 53938 DF, p-value: < 2.2e-16
# Ecuación estimada:
print(paste("y = ", b_0, " + (", b_1, ")x + e"))
## [1] "y = -2256.36058004541 + ( 7756.42561796844 )x + e"
# Residuos del modelo:
residuos <- modelo1$residuals
par(mfrow=c(2,2))
plot(modelo1)
# Probamos la normalidad:
#shapiro.test(residuos)
# Probamos homocedasticidad:
bptest(modelo1)
##
## studentized Breusch-Pagan test
##
## data: modelo1
## BP = 9131.2, df = 1, p-value < 2.2e-16
Solo alcance con uno :(