Practica
Fernando Mendoza
2026-03-13
##Problema 1
Mujer<-c(75,77,78,79,77,73,78,79,78,80)
Hombre<-c(74,72,77,76,76,73,75,73,74,75)
Sexo<-c(rep("Mujer",10),rep("Hombre",10))
Temp<-c(Mujer,Hombre)
datos<-data.frame(Sexo=Sexo,T=Temp)
resultado <- t.test(Mujer, Hombre,
alternative = "two.sided",
var.equal = FALSE)
print(resultado)##
## Welch Two Sample t-test
##
## data: Mujer and Hombre
## t = 3.5254, df = 16.851, p-value = 0.002626
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.163304 4.636696
## sample estimates:
## mean of x mean of y
## 77.4 74.5datos## Sexo T
## 1 Mujer 75
## 2 Mujer 77
## 3 Mujer 78
## 4 Mujer 79
## 5 Mujer 77
## 6 Mujer 73
## 7 Mujer 78
## 8 Mujer 79
## 9 Mujer 78
## 10 Mujer 80
## 11 Hombre 74
## 12 Hombre 72
## 13 Hombre 77
## 14 Hombre 76
## 15 Hombre 76
## 16 Hombre 73
## 17 Hombre 75
## 18 Hombre 73
## 19 Hombre 74
## 20 Hombre 75datos$Sexo<-factor(datos$Sexo)
boxplot(T~Sexo,data=datos,col=c("gray",("blue")))
library(car)## Cargando paquete requerido: carDataleveneTest(T~Sexo,data=datos,center=mean)## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 1 0.2085 0.6534
## 18print(resultado)##
## Welch Two Sample t-test
##
## data: Mujer and Hombre
## t = 3.5254, df = 16.851, p-value = 0.002626
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.163304 4.636696
## sample estimates:
## mean of x mean of y
## 77.4 74.5summary(datos)## Sexo T
## Hombre:10 Min. :72.00
## Mujer :10 1st Qu.:74.00
## Median :76.00
## Mean :75.95
## 3rd Qu.:78.00
## Max. :80.00par(mfrow = c(1, 2)) # dos gráficos lado a lado
hist(Mujer,
main = "Mujeres",
xlab = "Temperatura (°F)",
col = "#E87B9E",
border = "white",
xlim = c(70, 83))
hist(Hombre,
main = "Hombres",
xlab = "Temperatura (°F)",
col = "#6BAED6",
border = "white",
xlim = c(70, 83))
library(ggplot2)
ggplot(datos, aes(x = T, fill = Sexo)) +
geom_histogram(binwidth = 1, color = "white", alpha = 0.8) +
facet_wrap(~ Sexo) +
scale_fill_manual(values = c("Mujer" = "#E87B9E", "Hombre" = "#6BAED6")) +
labs(title = "Temperatura de confort por sexo",
x = "Temperatura (°F)",
y = "Frecuencia") +
theme_minimal()
##Problema 2
# ============================================================
# PRUEBA t PAREADA: Método Actual vs Método Nuevo IA
# ============================================================
actual <- c(1.88, 1.84, 1.83, 1.90, 2.19, 1.89, 2.27, 2.03, 1.96,
1.98, 2.00, 1.92, 1.83, 1.94, 1.94, 1.95, 1.93, 2.01)
nuevo <- c(1.87, 1.90, 1.85, 1.88, 2.18, 1.87, 2.23, 1.97, 2.00,
1.98, 1.99, 1.89, 1.78, 1.92, 2.02, 2.00, 1.95, 2.05)
# Diferencias por disco
d <- actual - nuevo
print(round(d, 4))## [1] 0.01 -0.06 -0.02 0.02 0.01 0.02 0.04 0.06 -0.04 0.00 0.01 0.03
## [13] 0.05 0.02 -0.08 -0.05 -0.02 -0.04# Prueba t pareada
resultado <- t.test(actual, nuevo,
paired = TRUE,
alternative = "two.sided")
print(resultado)##
## Paired t-test
##
## data: actual and nuevo
## t = -0.23874, df = 17, p-value = 0.8142
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.02186024 0.01741580
## sample estimates:
## mean difference
## -0.002222222actual<-c(1.88, 1.84, 1.83, 1.90, 2.19, 1.89, 2.27, 2.03, 1.96,
1.98, 2.00, 1.92, 1.83, 1.94, 1.94, 1.95, 1.93, 2.01)
nuevo<-c(1.87, 1.90, 1.85, 1.88, 2.18, 1.87, 2.23, 1.97, 2.00,
1.98, 1.99, 1.89, 1.78, 1.92, 2.02, 2.00, 1.95, 2.05)
resultado <- t.test(actual, nuevo,
alternative = "two.sided",paired = TRUE,
var.equal = FALSE)
print(resultado)##
## Paired t-test
##
## data: actual and nuevo
## t = -0.23874, df = 17, p-value = 0.8142
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.02186024 0.01741580
## sample estimates:
## mean difference
## -0.002222222##Problema 2
desgaste<-c(264, 260, 258, 241, 262, 255,208, 220, 216, 200, 213, 206,220,263,219,225,230,228,217,226,215,227,220,222)
tipoCuero<-c(rep("A",6),rep("B",6),rep("C",6),rep("D",6))
datos<-data.frame(tipoCuero=tipoCuero,desgaste=desgaste)
datos## tipoCuero desgaste
## 1 A 264
## 2 A 260
## 3 A 258
## 4 A 241
## 5 A 262
## 6 A 255
## 7 B 208
## 8 B 220
## 9 B 216
## 10 B 200
## 11 B 213
## 12 B 206
## 13 C 220
## 14 C 263
## 15 C 219
## 16 C 225
## 17 C 230
## 18 C 228
## 19 D 217
## 20 D 226
## 21 D 215
## 22 D 227
## 23 D 220
## 24 D 222# ============================================================
# ANOVA DE UN FACTOR: Tipo de Cuero (4 tratamientos) (IA)
# ============================================================
desgaste <- c(264, 260, 258, 241, 262, 255,
208, 220, 216, 200, 213, 206,
220, 263, 219, 225, 230, 228,
217, 226, 215, 227, 220, 222)
tipoCuero <- c(rep("A",6), rep("B",6), rep("C",6), rep("D",6))
datos <- data.frame(tipoCuero = tipoCuero, desgaste = desgaste)
# ------ ESTADÍSTICAS DESCRIPTIVAS ------
tapply(desgaste, tipoCuero, summary)## $A
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 241.0 255.8 259.0 256.7 261.5 264.0
##
## $B
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 200.0 206.5 210.5 210.5 215.2 220.0
##
## $C
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 219.0 221.2 226.5 230.8 229.5 263.0
##
## $D
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 215.0 217.8 221.0 221.2 225.0 227.0tapply(desgaste, tipoCuero, sd)## A B C D
## 8.286535 7.259477 16.339115 4.792355# ------ ANOVA ------
modelo <- aov(desgaste ~ tipoCuero, data = datos)
summary(modelo)## Df Sum Sq Mean Sq F value Pr(>F)
## tipoCuero 3 7019 2339.8 22.75 1.18e-06 ***
## Residuals 20 2056 102.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ------ VERIFICACIÓN DE SUPUESTOS ------
# 1. Normalidad de residuos (Shapiro-Wilk)
shapiro.test(residuals(modelo))##
## Shapiro-Wilk normality test
##
## data: residuals(modelo)
## W = 0.88326, p-value = 0.00967# 2. Homogeneidad de varianzas (Levene)
library(car)
leveneTest(desgaste ~ tipoCuero, data = datos, center = mean)## Warning in leveneTest.default(y = y, group = group, ...): group coerced to
## factor.## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 3 1.1851 0.3405
## 20# ------ COMPARACIONES MÚLTIPLES (Tukey) ------
TukeyHSD(modelo)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = desgaste ~ tipoCuero, data = datos)
##
## $tipoCuero
## diff lwr upr p adj
## B-A -46.166667 -62.552998 -29.780336 0.0000008
## C-A -25.833333 -42.219664 -9.447002 0.0014117
## D-A -35.500000 -51.886331 -19.113669 0.0000349
## C-B 20.333333 3.947002 36.719664 0.0118160
## D-B 10.666667 -5.719664 27.052998 0.2926431
## D-C -9.666667 -26.052998 6.719664 0.3742863plot(TukeyHSD(modelo), las = 1)
datos$tipoCuero<-factor(datos$tipoCuero)
modelo<-aov(desgaste~tipoCuero,data = datos)
summary(modelo)## Df Sum Sq Mean Sq F value Pr(>F)
## tipoCuero 3 7019 2339.8 22.75 1.18e-06 ***
## Residuals 20 2056 102.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ------ BOXPLOT ------
boxplot(desgaste ~ tipoCuero, data = datos,
col = c("#FF6B6B", "#4ECDC4", "#45B7D1", "#96CEB4"),
border = c("#C0392B", "#16A085", "#2980B9", "#27AE60"),
main = "Desgaste por Tipo de Cuero",
xlab = "Tipo de Cuero",
ylab = "Desgaste",
las = 1)
# Medias como puntos
medias <- tapply(datos$desgaste, datos$tipoCuero, mean)
points(1:4, medias, pch = 18, cex = 1.8, col = "black")
# Etiquetas de media
text(1:4, medias + 4,
labels = round(medias, 1),
cex = 0.85, font = 2)
# Leyenda
legend("topright",
legend = paste("Media:", round(medias, 1)),
pch = 18,
col = "black",
bty = "n", cex = 0.8)
boxplot(desgaste~tipoCuero,data=datos,col=c("blue","red","purple","pink"))
library(ggplot2)
ggplot(datos, aes(x = tipoCuero, y = desgaste, fill = tipoCuero)) +
geom_boxplot(alpha = 0.8, outlier.shape = 19) +
stat_summary(fun = mean, geom = "point",
shape = 18, size = 3, color = "black") +
scale_fill_manual(values = c("#FF6B6B","#4ECDC4","#45B7D1","#96CEB4")) +
labs(title = "Desgaste por Tipo de Cuero",
x = "Tipo de Cuero",
y = "Desgaste") +
theme_minimal() +
theme(legend.position = "none")
plot(modelo)
shapiro.test(modelo$residuals)##
## Shapiro-Wilk normality test
##
## data: modelo$residuals
## W = 0.88326, p-value = 0.00967hist(modelo$residuals,breaks = 5)
##Regresión Lineal
x1<-seq(0,10,0.5)
y<-0.8+2.3*x1
plot(x1,y)
modelo<-lm(y~x1)
summary(modelo)## Warning in summary.lm(modelo): essentially perfect fit: summary may be
## unreliable##
## Call:
## lm(formula = y ~ x1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.098e-15 -1.512e-15 -7.365e-16 4.544e-16 1.699e-14
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.000e-01 1.909e-15 4.192e+14 <2e-16 ***
## x1 2.300e+00 3.265e-16 7.044e+15 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.53e-15 on 19 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 4.962e+31 on 1 and 19 DF, p-value: < 2.2e-16yajustado<-modelo$fitted.values
plot(x1,y)
lines(x1,yajustado,col="red",lwd=2)
citation()## To cite R in publications use:
##
## R Core Team (2025). _R: A Language and Environment for Statistical
## Computing_. R Foundation for Statistical Computing, Vienna, Austria.
## <https://www.R-project.org/>.
##
## A BibTeX entry for LaTeX users is
##
## @Manual{,
## title = {R: A Language and Environment for Statistical Computing},
## author = {{R Core Team}},
## organization = {R Foundation for Statistical Computing},
## address = {Vienna, Austria},
## year = {2025},
## url = {https://www.R-project.org/},
## }
##
## We have invested a lot of time and effort in creating R, please cite it
## when using it for data analysis. See also 'citation("pkgname")' for
## citing R packages.