Exploración de las datos:

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:

# 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")

Carat vs. Price

1. Identificación de variables:

x: price (US)
y: Carat ()
# Accedemos a los datos:
price <- diamonds$price
carat <- diamonds$carat

2. Varianza conjunta:

# 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

3. Inspección gráfica (diagrama de dispersión):

# 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.

5. Estandarización de la varianza conjunta (Cov):

# 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

6. Coeficiente de determinación (r^2):

r_det <- (r*r)*100
print(paste("COEFICIENTE DE DETERMINACIÓN: ", r_det, "%"))
## [1] "COEFICIENTE DE DETERMINACIÓN:  84.9330526435486 %"

7. Estimar B_0 y B_1:

# 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"

8. Tratamiento de residuos:

# 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 :(