library(datos)
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(nortest)
## Warning: package 'nortest' was built under R version 4.5.2
library(stests)
## 
## Adjuntando el paquete: 'stests'
## The following object is masked from 'package:stats':
## 
##     var.test
library(ggplot2)

PUNTO1

library(dplyr)

set.seed(2)
datos_d <- sample_n(diamantes, 120)

datos_G <- filter(datos_d, color == "G")

quilates <- datos_G$quilate

shapiro.test(quilates)
## 
##  Shapiro-Wilk normality test
## 
## data:  quilates
## W = 0.90944, p-value = 0.02962
n <- length(quilates)
var_muestral <- var(quilates)

chi_cuad <- (n - 1) * var_muestral / 0.22
chi_cuad
## [1] 19.60153
valor_p <- pchisq(q = chi_cuad, df = n - 1, lower.tail = FALSE)
valor_p
## [1] 0.7191959
cat("Varianza muestral =", var_muestral)
## Varianza muestral = 0.1796807
cat("Estadístico chi-cuadrado =", chi_cuad )
## Estadístico chi-cuadrado = 19.60153
cat("p-value =", valor_p)
## p-value = 0.7191959
if(valor_p < 0.05){
  cat("Como el p-value < 0.05, se rechaza H0.")
} else {
  cat("Como el p-value > 0.05, NO se rechaza H0.")
}
## Como el p-value > 0.05, NO se rechaza H0.

PUNTO2

set.seed(2)

datos_d <- sample_n(diamantes, 120)

D     <- c(4, 6, 5)
E     <- c(7, 5, 6)
F     <- c(6, 4, 5)
G     <- c(8, 7, 6)
H     <- c(5, 6, 4)
Otros <- c(3, 2, 3)

tabla <- as.table(rbind(D, E, F, G, H, Otros))

rownames(tabla) <- c("D","E","F","G","H","Otros")
colnames(tabla) <- c("Bajo","Medio","Alto")

tabla
##       Bajo Medio Alto
## D        4     6    5
## E        7     5    6
## F        6     4    5
## G        8     7    6
## H        5     6    4
## Otros    3     2    3
resultado <- chisq.test(tabla)
## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect
valor_p <- resultado$p.value
valor_p
## [1] 0.997748
cat("Valor-p =", valor_p)
## Valor-p = 0.997748
cat("Como el valor_p es mayor que 0.05, no se rechaza H0 y",
    "no hay evidencia de asociación entre el color del diamante",
    "y el nivel de precio.")
## Como el valor_p es mayor que 0.05, no se rechaza H0 y no hay evidencia de asociación entre el color del diamante y el nivel de precio.

PUNTO3

set.seed(2)
datos_d <- sample_n(diamantes, 120)

fm_cut <- aov(lm(precio ~ corte, data = datos_d))

summary(fm_cut)
##              Df   Sum Sq  Mean Sq F value Pr(>F)
## corte         4 4.75e+07 11874950   0.803  0.525
## Residuals   115 1.70e+09 14780565
p_valor <- summary(fm_cut)[[1]][["Pr(>F)"]][1]
p_valor
## [1] 0.5254218
cat("Valor-p =", p_valor)
## Valor-p = 0.5254218
cat("Como el valor-p es mayor que 0.05, no se rechaza H0 y",
    "no hay evidencia suficiente para afirmar diferencias",
    "en el precio medio según el corte del diamante.")
## Como el valor-p es mayor que 0.05, no se rechaza H0 y no hay evidencia suficiente para afirmar diferencias en el precio medio según el corte del diamante.

PUNTO4

set.seed(2)

modelo_rl <- lm(precio ~ quilate, data = datos_d)
summary(modelo_rl)
## 
## Call:
## lm(formula = precio ~ quilate, data = datos_d)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4328.3  -904.2  -130.3   576.0  6544.5 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -2245.5      316.1  -7.104 9.87e-11 ***
## quilate       7600.7      321.2  23.665  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1605 on 118 degrees of freedom
## Multiple R-squared:  0.826,  Adjusted R-squared:  0.8245 
## F-statistic:   560 on 1 and 118 DF,  p-value: < 2.2e-16
b0 <- coef(modelo_rl)[1]   
b1 <- coef(modelo_rl)[2]   

cat("La recta ajustada es: precio = ", b0, " + ", b1, "* quilate")
## La recta ajustada es: precio =  -2245.451  +  7600.651 * quilate
predict(modelo_rl, data.frame(quilate = c(0.5, 0.7, 1, 1.2)),
        interval = "confidence")
##        fit      lwr      upr
## 1 1554.874 1180.490 1929.259
## 2 3075.005 2764.897 3385.112
## 3 5355.200 5053.791 5656.609
## 4 6875.330 6517.906 7232.755
ic_beta1 <- confint(modelo_rl, "quilate", level = 0.95)
cat("IC del 95% para la pendiente β1")
## IC del 95% para la pendiente β1