2.1. Carga (o instala primero y luego carga) el paquete UsingR
library(UsingR)
## Cargando paquete requerido: MASS
## Cargando paquete requerido: HistData
## Cargando paquete requerido: Hmisc
##
## Adjuntando el paquete: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
num_datasets = length(data())
num_datasets
## [1] 4
hist(bumpers, main = "Histograma de bumpers", xlab = "Valor", col = "lightblue")
boxplot(bumpers, main = "Histograma de bumpers", xlab = "Valor", col = "blue")
hist(firstchi, main = "Boxplot de firstchi", ylab = "Valor", col = "lightgreen")
boxplot(firstchi, main = "Boxplot de firstchi", ylab = "Valor", col = "green")
hist(math, main = "Histograma de math", xlab = "Valor", col = "lightpink")
boxplot(math, main = "Histograma de math", xlab = "Valor", col = "lightpink")
summary(bumpers)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 618 1478 2129 2122 2774 3298
summary(firstchi)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 14.00 20.00 23.00 23.98 26.00 42.00
summary(math)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 38.00 49.00 54.00 54.90 61.75 75.00
mean_bumpers = mean(bumpers)
median_bumpers = median(bumpers)
sd_bumpers = sd(bumpers)
mean_firstchi = mean(firstchi)
median_firstchi = median(firstchi)
sd_firstchi = sd(firstchi)
mean_math = mean(math)
median_math = median(math)
sd_math = sd(math)
cat("bumpers: Media =", mean_bumpers, ", Mediana =", median_bumpers, ", Desviación estándar =", sd_bumpers, "\n")
## bumpers: Media = 2122.478 , Mediana = 2129 , Desviación estándar = 798.4574
cat("firstchi: Media =", mean_firstchi, ", Mediana =", median_firstchi, ", Desviación estándar =", sd_firstchi, "\n")
## firstchi: Media = 23.97701 , Mediana = 23 , Desviación estándar = 6.254258
cat("math: Media =", mean_math, ", Mediana =", median_math, ", Desviación estándar =", sd_math, "\n")
## math: Media = 54.9 , Mediana = 54 , Desviación estándar = 9.746264
Basandose en los resultados, para los 3 conjuntos de datos la media y mediana son cercanas, mientras que la desviación estándar para bumpers es alta, por lo que un Histograma puede ser más útil. Y en firstchi y math la desviación estándar es relativamente pequeña, por lo que en este caso un Boxplot sería más útil.
Ya que 2 de 3 conjuntos de datos muestran similitudes en sus medidas de tendencia central y dispersión, la respuesta sería que el Boxplot resulta de mayor ayuda para la aproximación.
2.3. El paquete MASS contiene la base de datos UScereal con información relativa a desayunos con cereales.
library(MASS)
str(UScereal)
## 'data.frame': 65 obs. of 11 variables:
## $ mfr : Factor w/ 6 levels "G","K","N","P",..: 3 2 2 1 2 1 6 4 5 1 ...
## $ calories : num 212 212 100 147 110 ...
## $ protein : num 12.12 12.12 8 2.67 2 ...
## $ fat : num 3.03 3.03 0 2.67 0 ...
## $ sodium : num 394 788 280 240 125 ...
## $ fibre : num 30.3 27.3 28 2 1 ...
## $ carbo : num 15.2 21.2 16 14 11 ...
## $ sugars : num 18.2 15.2 0 13.3 14 ...
## $ shelf : int 3 3 3 1 2 3 1 3 2 1 ...
## $ potassium: num 848.5 969.7 660 93.3 30 ...
## $ vitamins : Factor w/ 3 levels "100%","enriched",..: 2 2 2 2 2 2 2 2 2 2 ...
head(UScereal)
## mfr calories protein fat sodium fibre
## 100% Bran N 212.1212 12.121212 3.030303 393.9394 30.303030
## All-Bran K 212.1212 12.121212 3.030303 787.8788 27.272727
## All-Bran with Extra Fiber K 100.0000 8.000000 0.000000 280.0000 28.000000
## Apple Cinnamon Cheerios G 146.6667 2.666667 2.666667 240.0000 2.000000
## Apple Jacks K 110.0000 2.000000 0.000000 125.0000 1.000000
## Basic 4 G 173.3333 4.000000 2.666667 280.0000 2.666667
## carbo sugars shelf potassium vitamins
## 100% Bran 15.15152 18.18182 3 848.48485 enriched
## All-Bran 21.21212 15.15151 3 969.69697 enriched
## All-Bran with Extra Fiber 16.00000 0.00000 3 660.00000 enriched
## Apple Cinnamon Cheerios 14.00000 13.33333 1 93.33333 enriched
## Apple Jacks 11.00000 14.00000 2 30.00000 enriched
## Basic 4 24.00000 10.66667 3 133.33333 enriched
table(UScereal$mfr, UScereal$shelf)
##
## 1 2 3
## G 6 7 9
## K 4 7 10
## N 2 0 1
## P 2 1 6
## Q 0 3 2
## R 4 0 1
plot(UScereal$fat, UScereal$vitamins, main = "Fat vs Vitamins", xlab = "Fat", ylab = "Vitamins")
boxplot(fat ~ shelf, data = UScereal, main = "Fat by Shelf", xlab = "Shelf", ylab = "Fat")
plot(UScereal$carbo, UScereal$sugars, main = "Carbohydrates vs Sugars", xlab = "Carbohydrates", ylab = "Sugars")
boxplot(fibre ~ mfr, data = UScereal, main = "Fibre by Manufacturer", xlab = "Manufacturer", ylab = "Fibre")
plot(UScereal$sodium, UScereal$sugars, main = "Sodium vs Sugars", xlab = "Sodium", ylab = "Sugars")
2.4. El conjunto de datos mammals contiene datos sobre la relación entre peso corporal y peso del cerebro.
head(mammals)
## body brain
## Arctic fox 3.385 44.5
## Owl monkey 0.480 15.5
## Mountain beaver 1.350 8.1
## Cow 465.000 423.0
## Grey wolf 36.330 119.5
## Goat 27.660 115.0
correlation = cor(mammals$body, mammals$brain)
correlation
## [1] 0.9341638
plot(mammals$body, mammals$brain, main = "Peso corporal vs Peso del cerebro", xlab = "Peso corporal (kg)", ylab = "Peso del cerebro (g)", col = "violet", pch = 16)
mammals$log_body = log(mammals$body)
mammals$log_brain = log(mammals$brain)
log_correlation = cor(mammals$log_body, mammals$log_brain)
log_correlation
## [1] 0.9595748
plot(mammals$log_body, mammals$log_brain, main = "log(Peso corporal) vs log(Peso del cerebro)", xlab = "log(Peso corporal)", ylab = "log(Peso del cerebro)", col = "red", pch = 16)
La correlación lineal aumenta, Lo cual indica que la transformación logarítmica ha aumentado la correlación lineal entre estas dos variables. Y la relación entre las variables parece volverse más lineal y uniforme después de aplicar la transformación logarítmica.
2.5. Enlaza la base de datos emissions del paquete UsingR.
data(emissions, package = "UsingR")
head(emissions)
## GDP perCapita CO2
## UnitedStates 8083000 29647 6750
## Japan 3080000 24409 1320
## Germany 1740000 21197 1740
## France 1320000 22381 550
## UnitedKingdom 1242000 21010 675
## Italy 1240000 21856 540
plot(emissions$GDP, emissions$CO2, main = "GDP vs CO2", xlab = "GDP (Gross Domestic Product)", ylab = "CO2")
plot(emissions$perCapita, emissions$CO2, main = "Per Capita vs CO2", xlab = "Per Capita", ylab = "CO2")
plot(emissions$GDP, emissions$perCapita, main = "GDP vs Per Capita", xlab = "GDP (Gross Domestic Product)", ylab = "Per Capita")
model_GDP_CO2 = lm(CO2 ~ GDP, data = emissions)
summary(model_GDP_CO2)
##
## Call:
## lm(formula = CO2 ~ GDP, data = emissions)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1107.35 -81.47 -32.69 126.33 1438.79
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.043e+01 9.441e+01 0.216 0.83
## GDP 7.815e-04 5.233e-05 14.933 1.2e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 427.4 on 24 degrees of freedom
## Multiple R-squared: 0.9028, Adjusted R-squared: 0.8988
## F-statistic: 223 on 1 and 24 DF, p-value: 1.197e-13
model_perCapita_CO2 <- lm(CO2 ~ perCapita, data = emissions)
summary(model_perCapita_CO2)
##
## Call:
## lm(formula = CO2 ~ perCapita, data = emissions)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1088.4 -681.4 -317.7 80.5 5479.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -223.99167 686.10910 -0.326 0.747
## perCapita 0.05040 0.03586 1.406 0.173
##
## Residual standard error: 1318 on 24 degrees of freedom
## Multiple R-squared: 0.07606, Adjusted R-squared: 0.03757
## F-statistic: 1.976 on 1 and 24 DF, p-value: 0.1726
outliers_GDP_CO2 = which(abs(model_GDP_CO2$residuals) > 2 * sd(model_GDP_CO2$residuals))
emissions[outliers_GDP_CO2,]
## GDP perCapita CO2
## Japan 3080000 24409 1320
## Russia 692000 4727 2000
outliers_perCapita_CO2 = which(abs(model_perCapita_CO2$residuals) > 2 * sd(model_perCapita_CO2$residuals))
emissions[outliers_perCapita_CO2,]
## GDP perCapita CO2
## UnitedStates 8083000 29647 6750
model_GDP_CO2_no_outliers = lm(CO2 ~ GDP, data = emissions[-outliers_GDP_CO2,])
summary(model_GDP_CO2_no_outliers)
##
## Call:
## lm(formula = CO2 ~ GDP, data = emissions[-outliers_GDP_CO2, ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -513.18 -39.74 8.41 95.71 342.52
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.554e+01 4.719e+01 -0.541 0.594
## GDP 8.248e-04 2.676e-05 30.827 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 209.7 on 22 degrees of freedom
## Multiple R-squared: 0.9774, Adjusted R-squared: 0.9763
## F-statistic: 950.3 on 1 and 22 DF, p-value: < 2.2e-16
model_perCapita_CO2_no_outliers = lm(CO2 ~ perCapita, data = emissions[-outliers_perCapita_CO2,])
summary(model_perCapita_CO2_no_outliers)
##
## Call:
## lm(formula = CO2 ~ perCapita, data = emissions[-outliers_perCapita_CO2,
## ])
##
## Residuals:
## Min 1Q Median 3Q Max
## -402.3 -332.9 -244.9 141.9 1497.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 531.03357 287.50408 1.847 0.0776 .
## perCapita -0.00608 0.01546 -0.393 0.6978
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 536.4 on 23 degrees of freedom
## Multiple R-squared: 0.006676, Adjusted R-squared: -0.03651
## F-statistic: 0.1546 on 1 and 23 DF, p-value: 0.6978
2.6. La base de datos MASS posee la siguiente base de datos: “anorexia” que contiene el cambio de peso en pacientes femeninas la cual posee 72 filas y 3 columnas.
data(anorexia, package = "MASS")
head(anorexia)
## Treat Prewt Postwt
## 1 Cont 80.7 80.2
## 2 Cont 89.4 80.1
## 3 Cont 91.8 86.4
## 4 Cont 74.0 86.3
## 5 Cont 78.1 76.1
## 6 Cont 88.3 78.1
mean_weight_change = tapply(anorexia$Postwt - anorexia$Prewt, anorexia$Treat, mean)
mean_weight_change
## CBT Cont FT
## 3.006897 -0.450000 7.264706
El tratamiento más efectivo es el FT (Terapia familiar), ya que tiene el cambio promedio de peso más alto (7.264706).
gain_weight = sum(anorexia$Postwt - anorexia$Prewt > 0)
lose_weight = sum(anorexia$Postwt - anorexia$Prewt < 0)
gain_weight
## [1] 42
lose_weight
## [1] 29
42 Pacientes ganaron peso y 29 pacientes perdieron peso
weight_change <- c(Gain = gain_weight, Lose = lose_weight)
barplot(weight_change, main = "Cambio de peso", xlab = "Tipo de cambio", ylab = "Numero de pacientes", col = c("orange", "purple"))
2.7. La base de datos MASS posee la siguiente base de datos: “Melanoma” que contiene 205 pacientes con melanomas y 7 columnas.
data(Melanoma, package = "MASS")
head(Melanoma)
## time status sex age year thickness ulcer
## 1 10 3 1 76 1972 6.76 1
## 2 30 3 1 56 1968 0.65 0
## 3 35 2 1 41 1977 1.34 0
## 4 99 3 0 71 1968 2.90 0
## 5 185 1 1 52 1965 12.08 1
## 6 204 1 1 28 1971 4.84 1
deaths_melanoma = sum(Melanoma$status == 1)
deaths_other = sum(Melanoma$status == 3)
deaths_melanoma
## [1] 57
deaths_other
## [1] 14
57 pacientes fallecieron a causa del Melanoma y 14 pacientes fallecieron por otras causas
melanoma_present = sum(Melanoma$ulcer == 1)
melanoma_absent = sum(Melanoma$ulcer == 0)
melanoma_present
## [1] 90
melanoma_absent
## [1] 115
En 90 pacientes hay presencia de Melanoma y en 115 pacientes hay ausencia de Melanoma.
tumor_sizes = unique(Melanoma$thickness)
mortality_rates = numeric(length(tumor_sizes))
for (i in 1:length(tumor_sizes)) {
deaths = sum(Melanoma$status == 1 & Melanoma$thickness == tumor_sizes[i])
patients = sum(Melanoma$thickness == tumor_sizes[i])
mortality_rates[i] = deaths / patients
}
tumor_mortality = data.frame(Tumor_Size = tumor_sizes, Mortality_Rate = mortality_rates)
tumor_mortality
## Tumor_Size Mortality_Rate
## 1 6.76 0.0000000
## 2 0.65 0.0000000
## 3 1.34 0.5000000
## 4 2.90 0.0000000
## 5 12.08 1.0000000
## 6 4.84 0.6000000
## 7 5.16 0.6666667
## 8 3.22 0.2000000
## 9 12.88 0.5000000
## 10 7.41 1.0000000
## 11 4.19 1.0000000
## 12 0.16 0.0000000
## 13 3.87 0.5000000
## 14 2.42 1.0000000
## 15 12.56 0.0000000
## 16 5.80 1.0000000
## 17 7.06 0.5000000
## 18 5.48 0.5000000
## 19 7.73 0.5000000
## 20 13.85 1.0000000
## 21 2.34 1.0000000
## 22 4.04 1.0000000
## 23 0.32 0.1666667
## 24 8.54 0.0000000
## 25 2.58 0.3333333
## 26 3.56 1.0000000
## 27 3.54 0.6250000
## 28 0.97 0.1818182
## 29 4.83 0.5000000
## 30 1.62 0.2500000
## 31 6.44 1.0000000
## 32 14.66 1.0000000
## 33 2.24 1.0000000
## 34 17.42 1.0000000
## 35 1.29 0.0000000
## 36 4.51 1.0000000
## 37 8.38 0.0000000
## 38 1.94 0.2000000
## 39 2.10 0.3333333
## 40 0.81 0.2727273
## 41 1.13 0.0000000
## 42 1.37 0.0000000
## 43 0.24 0.0000000
## 44 0.48 0.0000000
## 45 2.26 0.6000000
## 46 0.58 0.0000000
## 47 1.78 0.0000000
## 48 1.53 0.0000000
## 49 3.06 0.5000000
## 50 4.09 0.0000000
## 51 0.64 0.0000000
## 52 1.76 1.0000000
## 53 5.64 0.0000000
## 54 9.66 0.0000000
## 55 0.10 0.0000000
## 56 1.45 0.0000000
## 57 4.82 0.0000000
## 58 7.89 0.0000000
## 59 7.09 0.0000000
## 60 6.12 0.0000000
## 61 2.74 0.0000000
## 62 1.03 0.0000000
## 63 12.24 0.0000000
## 64 8.06 0.0000000
plot(Mortality_Rate ~ Tumor_Size, data = tumor_mortality, main = "Relacion entre tamano de tumor y tasa de mortalidad", xlab = "Tamano de tumor (mm)", ylab = "Tasa de mortalidad", col = "black", pch = 16)
melanoma_data <- c(Melanoma = melanoma_present, No_Melanoma = melanoma_absent)
barplot(melanoma_data, main = "Presencia de Melanoma", xlab = "Estado", ylab = "Numero de pacientes", col = c("darkred", "darkblue"))
2.8. La base de datos UsingR posee la siguiente base de datos: “babyboom” que contiene la estadística de nacimiento de 44 bebes en un periodo de 24 horas con peso y sexo, con 4 columnas.
data(babyboom, package = "UsingR")
head(babyboom)
## clock.time gender wt running.time
## 1 5 girl 3837 5
## 2 104 girl 3334 64
## 3 118 boy 3554 78
## 4 155 boy 3838 115
## 5 257 boy 3625 177
## 6 405 girl 2208 245
boys = sum(babyboom$gender == "boy")
girls = sum(babyboom$gender == "girl")
boys
## [1] 26
girls
## [1] 18
El número de niños es de 26 y el número de niñas es 18.
boys_12h = sum(babyboom$running.time <= 720) # 720 minutos en 12 horas
boys_12h
## [1] 18
18 niños nacieron en las primeras 12 horas.
boys_lt_3000g <- sum(babyboom$wt < 3000)
boys_lt_3000g
## [1] 9
9 niños nacieron por debajo de los 3000 gramos.
table(babyboom$gender, babyboom$wt < 3000)
##
## FALSE TRUE
## girl 13 5
## boy 22 4
mean_wt_total = mean(babyboom$wt)
mean_wt_boys = mean(babyboom$wt[babyboom$gender == "boy"])
mean_wt_girls = mean(babyboom$wt[babyboom$gender == "girl"])
mean_wt = c(Total = mean_wt_total, Boys = mean_wt_boys, Girls = mean_wt_girls)
barplot(mean_wt, main = "Promedio de pesos", ylab = "Peso promedio (gramos)", col = c("yellow", "lightblue", "lightpink"))
2.9. La base de datos UsingR posee la siguiente base de datos: “Aids2” que contiene la estadística de 2843 pacientes con sida con 4 columnas.
data(Aids2, package = "MASS")
head(Aids2)
## state sex diag death status T.categ age
## 1 NSW M 10905 11081 D hs 35
## 2 NSW M 11029 11096 D hs 53
## 3 NSW M 9551 9983 D hs 42
## 4 NSW M 9577 9654 D haem 44
## 5 NSW M 10015 10290 D hs 39
## 6 NSW M 9971 10344 D hs 36
contagions_state = table(Aids2$state)
contagions_state
##
## NSW Other QLD VIC
## 1780 249 226 588
deaths = sum(Aids2$status == "D")
deaths
## [1] 1761
1761 pacientes han fallecido.
sex_transmission = table(Aids2$sex, Aids2$T.categ)
sex_transmission
##
## hs hsid id het haem blood mother other
## F 1 0 20 20 0 37 4 7
## M 2464 72 28 21 46 57 3 63
barplot(table(Aids2$T.categ), main = "Tipos de Transmision", xlab = "Tipo de Transmision", ylab = "Numero de Pacientes", col = rainbow(length(unique(Aids2$T.categ))))
2.10. La base de datos UsingR posee la siguiente base de datos: “crime” que contiene la tasa de crímenes de 50 estados de los E.E.U.U en los años 1983 y 1993, posee 3 columnas: Estado (no marcado), y1983, y1993. Se requiere un informe con los siguientes puntos.
data(crime, package = "UsingR")
head(crime)
## y1983 y1993
## Alabama 416.0 871.7
## Alaska 613.8 660.5
## Arizona 494.2 670.8
## Arkansas 297.7 576.5
## California 772.6 1119.7
## Colorado 476.4 578.8
total_crime_1983 = sum(crime$y1983)
total_crime_1993 = sum(crime$y1993)
if (total_crime_1993 > total_crime_1983) {
print("La tasa total de crímenes en 1993 fue mayor que en 1983.")
} else if (total_crime_1993 < total_crime_1983) {
print("La tasa total de crímenes en 1993 fue menor que en 1983.")
} else {
print("La tasa total de crímenes en 1993 fue igual a la de 1983.")
}
## [1] "La tasa total de crímenes en 1993 fue mayor que en 1983."
state_crime_1983 = rownames(crime)[which.max(crime$y1983)]
state_crime_1983
## [1] "DC"
state_crime_1993 = rownames(crime)[which.max(crime$y1993)]
state_crime_1993
## [1] "DC"
En ambos años, la tasa de crimenes en DC es mayor.
crime$total = crime$y1983 + crime$y1993
state_total_crime = rownames(crime)[which.max(crime$total)]
state_total_crime
## [1] "DC"
DC presenta la mayor tasa de crimen acumulado en ambos años.
orden_estados = rownames(crime)[order(crime$y1983)]
crime_sorted = crime[orden_estados, ]
numeros = 1:nrow(crime_sorted)
barplot(t(as.matrix(crime_sorted[, c("y1983", "y1993")])), beside = TRUE, main = "Tasa de Crimenes por Estado en 1983 y 1993", xlab = " Estados", ylab = "Tasa de Crimen", col = c("darkgrey", "darkgreen"), legend.text = c("1983", "1993"), args.legend = list(x = "topleft", bty = "n"))
tabla_correspondencia = data.frame(Número = numeros, Estado = rownames(crime_sorted))
print(tabla_correspondencia, row.names = FALSE)
## Número Estado
## 1 North Dakota
## 2 South Dakota
## 3 New Hampshire
## 4 Vermont
## 5 Maine
## 6 West Virginia
## 7 Iowa
## 8 Minnesota
## 9 Wisconsin
## 10 Montana
## 11 Nebraska
## 12 Wyoming
## 13 Idaho
## 14 Hawaii
## 15 Utah
## 16 Mississippi
## 17 Indiana
## 18 Virginia
## 19 Arkansas
## 20 Kentucky
## 21 Kansas
## 22 Pennsylvania
## 23 Rhode Island
## 24 Washington
## 25 Connecticut
## 26 Ohio
## 27 Tennessee
## 28 North Carolina
## 29 Alabama
## 30 Oklahoma
## 31 Delaware
## 32 Georgia
## 33 Colorado
## 34 Missour
## 35 Oregon
## 36 Arizona
## 37 Texas
## 38 Illinois
## 39 New Jersey
## 40 Massachusetts
## 41 Alaska
## 42 South Carolina
## 43 Louisiana
## 44 Nevada
## 45 New Mexico
## 46 Michigan
## 47 California
## 48 Maryland
## 49 Florida
## 50 New York
## 51 DC