Analyze Child Mortality
Laura Donoso Vanessa Mora
Juan Manuel Nieves Daniela Cardona
2024-05-17
Procedimiento
Iniciamos importando dos librerias
rm(list=ls())
library(nortest)
library(lmtest)## Warning: package 'lmtest' was built under R version 4.3.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 4.3.3##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric library(readxl)Luego importamos la base de datos previamente descargada en formato de excel
base_datos <- read_excel("C:/Users/USUARIO/Downloads/child-mortality.xlsx")Realizamos una segmentacion de la base de datos en donde se tomaron los datos de cada uno de los paises procesandolos en una tabla para poder analizarlos individualmente, seguidamente se hicieron los graficos de dispersion
Segmentacion paises
colombia_data = subset(base_datos, Entity == "Colombia")
japan_data = subset(base_datos, Entity == "Japan")
nigeria_data = subset(base_datos, Entity == "Nigeria")
china_data = subset(base_datos, Entity == "China")Graficos de dispersion
Nigeria
plot(nigeria_data$Year, nigeria_data$`Under-five mortality rate`, col = "purple", pch = 16,
xlab = "Year", ylab = "Under.five.mortality.rate")
Japon
plot(japan_data$Year, japan_data$`Under-five mortality rate`, col = "red", pch = 16,
xlab = "Year", ylab = "Under.five.mortality.rate")
China
plot(china_data$Year, china_data$`Under-five mortality rate`, col = "green", pch = 16,
xlab = "Year", ylab = "Under.five.mortality.rate")
Colombia
plot(colombia_data$Year, colombia_data$`Under-five mortality rate`, col = "blue", pch = 16,
xlab = "Year", ylab = "Under.five.mortality.rate")
Realizamos los ajustes mencionados anteriormente con cada pais
Ajustes
Nigeria
Ajuste lineal
lm_linear = lm(nigeria_data$`Under-five mortality rate` ~ nigeria_data$Year, data = nigeria_data)
summary(lm_linear)##
## Call:
## lm(formula = nigeria_data$`Under-five mortality rate` ~ nigeria_data$Year,
## data = nigeria_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8389 -0.5257 0.1894 0.9354 3.0642
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 687.40913 21.04180 32.67 <2e-16 ***
## nigeria_data$Year -0.33501 0.01057 -31.71 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.417 on 58 degrees of freedom
## Multiple R-squared: 0.9455, Adjusted R-squared: 0.9445
## F-statistic: 1005 on 1 and 58 DF, p-value: < 2.2e-16# Extracción de coeficientes
coeficientes <- coef(lm_linear)
intercepto <- coeficientes[1]
pendiente <- coeficientes[2]
# Impresión de la ecuación
cat("Ecuation: y =", pendiente, "* x +", intercepto)## Ecuation: y = -0.3350069 * x + 687.4091Ajuste cuadrático
lm_quadratic = lm(nigeria_data$`Under-five mortality rate` ~ poly(Year, 2), data = nigeria_data)
summary(lm_quadratic)##
## Call:
## lm(formula = nigeria_data$`Under-five mortality rate` ~ poly(Year,
## 2), data = nigeria_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4654 -0.5534 -0.2078 1.1073 2.0476
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 20.2428 0.1668 121.392 < 2e-16 ***
## poly(Year, 2)1 -44.9397 1.2917 -34.792 < 2e-16 ***
## poly(Year, 2)2 4.6266 1.2917 3.582 0.000707 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.292 on 57 degrees of freedom
## Multiple R-squared: 0.9555, Adjusted R-squared: 0.9539
## F-statistic: 611.6 on 2 and 57 DF, p-value: < 2.2e-16# Extracción de coeficientes
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*X +", round(coeficientes[3], 2), "*X^2")
cat("Ecuation:",ecuacion)## Ecuation: Y = 687.41 + -0.34 *X + NA *X^2Ajuste cúbico
lm_cubic = lm(nigeria_data$`Under-five mortality rate` ~ poly(nigeria_data$Year, 3), data = nigeria_data)
summary(lm_cubic)##
## Call:
## lm(formula = nigeria_data$`Under-five mortality rate` ~ poly(nigeria_data$Year,
## 3), data = nigeria_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.79833 -0.95967 0.04553 0.99071 1.61695
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 20.2428 0.1377 147.042 < 2e-16 ***
## poly(nigeria_data$Year, 3)1 -44.9397 1.0664 -42.143 < 2e-16 ***
## poly(nigeria_data$Year, 3)2 4.6266 1.0664 4.339 6.05e-05 ***
## poly(nigeria_data$Year, 3)3 -5.6056 1.0664 -5.257 2.37e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.066 on 56 degrees of freedom
## Multiple R-squared: 0.9702, Adjusted R-squared: 0.9686
## F-statistic: 607.5 on 3 and 56 DF, p-value: < 2.2e-16coeficientes <- coef(lm_cubic)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+",
round(coeficientes[2], 2), "*X +",
round(coeficientes[3], 2), "*X^2 +",
round(coeficientes[4], 2), "*X^3")
cat("Ecuation:",ecuacion)## Ecuation: Y = 20.24 + -44.94 *X + 4.63 *X^2 + -5.61 *X^3Ajuste exponencial
lm_exponential= lm(log(nigeria_data$`Under-five mortality rate` )~ nigeria_data$Year, data = nigeria_data)
summary(lm_exponential)##
## Call:
## lm(formula = log(nigeria_data$`Under-five mortality rate`) ~
## nigeria_data$Year, data = nigeria_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.10244 -0.03972 -0.01517 0.04261 0.11378
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 36.8458663 0.9076383 40.59 <2e-16 ***
## nigeria_data$Year -0.0170135 0.0004557 -37.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06114 on 58 degrees of freedom
## Multiple R-squared: 0.96, Adjusted R-squared: 0.9594
## F-statistic: 1394 on 1 and 58 DF, p-value: < 2.2e-16coeficientes <- coef(lm_exponential)
ecuacion <- paste("Y =", "exp(", round(coeficientes[1], 2), ")", "*", "exp(", round(coeficientes[2], 2), "*X )")
cat("Ecuation:",ecuacion)## Ecuation: Y = exp( 36.85 ) * exp( -0.02 *X )Ajuste logarítmico
lm_logarithmic = lm(nigeria_data$`Under-five mortality rate` ~ log(nigeria_data$Year), data = nigeria_data)
summary(lm_logarithmic)##
## Call:
## lm(formula = nigeria_data$`Under-five mortality rate` ~ log(nigeria_data$Year),
## data = nigeria_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8261 -0.5220 0.2095 0.9294 3.0220
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5090.2 158.7 32.07 <2e-16 ***
## log(nigeria_data$Year) -667.4 20.9 -31.94 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.408 on 58 degrees of freedom
## Multiple R-squared: 0.9462, Adjusted R-squared: 0.9453
## F-statistic: 1020 on 1 and 58 DF, p-value: < 2.2e-16coeficientes <- coef(lm_logarithmic)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*ln(X)")
cat("Ecuation:",ecuacion)## Ecuation: Y = 5090.18 + -667.39 *ln(X)Agregar líneas de ajuste a la gráfica de dispersión
plot(nigeria_data$Year, nigeria_data$`Under-five mortality rate`, col = "purple", pch = 16, xlab = "Year", ylab = "Under-five mortality rate", type = "p")
lines(nigeria_data$Year, predict(lm_linear), col = "red")
lines(nigeria_data$Year, predict(lm_quadratic), col = "green")
lines(nigeria_data$Year, predict(lm_cubic), col = "purple")
lines(nigeria_data$Year, exp(predict(lm_exponential)), col = "orange")
lines(nigeria_data$Year, predict(lm_logarithmic), col = "brown")
Calcular residuos para cada modelo
residuals_linearni = residuals(lm_linear)^2
residuals_quadraticni = residuals(lm_quadratic)^2
residuals_cubicni = residuals(lm_cubic)^2
residuals_exponentialni = residuals(lm_exponential)^2
residuals_logarithmicni = residuals(lm_logarithmic)^2
summary(residuals_cubicni)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00096 0.30348 0.98370 1.06132 1.48285 3.23399summary(residuals_quadraticni)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00278 0.13358 0.71474 1.58502 2.79091 6.07815summary(residuals_cubicni)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00096 0.30348 0.98370 1.06132 1.48285 3.23399summary(residuals_exponentialni)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.010e-07 6.190e-04 1.661e-03 3.613e-03 6.424e-03 1.295e-02summary(residuals_logarithmicni)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000013 0.212399 0.722083 1.915177 2.317235 9.132545Calcular la suma de cuadrados de residuos para cada modelo
ssr_linearni = sum(residuals_linearni)
ssr_quadraticni = sum(residuals_quadraticni)
ssr_cubicni = sum(residuals_cubicni)
ssr_exponentialni = sum(residuals_exponentialni)
ssr_logarithmicni = sum(residuals_logarithmicni)Imprimir la suma de cuadrados de residuos para cada modelo
print(paste("Suma de cuadrados de residuos (linear):", ssr_linearni))## [1] "Suma de cuadrados de residuos (linear): 116.507001746103"print(paste("Suma de cuadrados de residuos (quadratic):", ssr_quadraticni))## [1] "Suma de cuadrados de residuos (quadratic): 95.1015233674768"print(paste("Suma de cuadrados de residuos (cubic):", ssr_cubicni))## [1] "Suma de cuadrados de residuos (cubic): 63.67914910324"print(paste("Suma de cuadrados de residuos (exponential):", ssr_exponentialni))## [1] "Suma de cuadrados de residuos (exponential): 0.216776427770552"print(paste("Suma de cuadrados de residuos (logarithmic):", ssr_logarithmicni))## [1] "Suma de cuadrados de residuos (logarithmic): 114.910642509656"Colombia
Ajuste lineal
lm_linearco = lm(colombia_data$`Under-five mortality rate` ~ colombia_data$Year, data = colombia_data)
summary(lm_linearco)##
## Call:
## lm(formula = colombia_data$`Under-five mortality rate` ~ colombia_data$Year,
## data = colombia_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.8994 -2.1359 -0.6388 2.1359 6.2438
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 569.44180 20.43052 27.87 <2e-16 ***
## colombia_data$Year -0.28316 0.01035 -27.35 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.869 on 95 degrees of freedom
## Multiple R-squared: 0.8873, Adjusted R-squared: 0.8861
## F-statistic: 747.9 on 1 and 95 DF, p-value: < 2.2e-16coeficientes <- coef(lm_linearco)
intercepto <- coeficientes[1]
pendiente <- coeficientes[2]
# Impresión de la ecuación
cat("Ecuation: y =", pendiente, "* x +", intercepto)## Ecuation: y = -0.2831634 * x + 569.4418Ajuste cuadrático
lm_quadraticco = lm(colombia_data$`Under-five mortality rate` ~ poly(colombia_data$Year, 2), data = colombia_data)
summary(lm_quadraticco)##
## Call:
## lm(formula = colombia_data$`Under-five mortality rate` ~ poly(colombia_data$Year,
## 2), data = colombia_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.3831 -1.4534 -0.2877 1.2630 6.1267
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.7837 0.2731 39.487 < 2e-16 ***
## poly(colombia_data$Year, 2)1 -78.4559 2.6897 -29.169 < 2e-16 ***
## poly(colombia_data$Year, 2)2 10.0933 2.6897 3.753 0.000303 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.69 on 94 degrees of freedom
## Multiple R-squared: 0.902, Adjusted R-squared: 0.8999
## F-statistic: 432.5 on 2 and 94 DF, p-value: < 2.2e-16coeficientes <- coef(lm_quadraticco)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*X +", round(coeficientes[3], 2), "*X^2")
cat("Ecuation:",ecuacion)## Ecuation: Y = 10.78 + -78.46 *X + 10.09 *X^2Ajuste cúbico
lm_cubicco = lm(colombia_data$`Under-five mortality rate` ~ poly(colombia_data$Year, 3), data = colombia_data)
summary(lm_cubicco)##
## Call:
## lm(formula = colombia_data$`Under-five mortality rate` ~ poly(colombia_data$Year,
## 3), data = colombia_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.741 -1.184 -0.154 1.226 4.406
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.784 0.198 54.467 < 2e-16 ***
## poly(colombia_data$Year, 3)1 -78.456 1.950 -40.235 < 2e-16 ***
## poly(colombia_data$Year, 3)2 10.093 1.950 5.176 1.30e-06 ***
## poly(colombia_data$Year, 3)3 18.067 1.950 9.266 7.32e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.95 on 93 degrees of freedom
## Multiple R-squared: 0.949, Adjusted R-squared: 0.9474
## F-statistic: 577.2 on 3 and 93 DF, p-value: < 2.2e-16coeficientes <- coef(lm_cubicco)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+",
round(coeficientes[2], 2), "*X +",
round(coeficientes[3], 2), "*X^2 +",
round(coeficientes[4], 2), "*X^3")
cat("Ecuation:",ecuacion)## Ecuation: Y = 10.78 + -78.46 *X + 10.09 *X^2 + 18.07 *X^3Ajuste exponencial
lm_exponentialco= lm(log(colombia_data$`Under-five mortality rate` )~ colombia_data$Year, data = colombia_data)
summary(lm_exponentialco)##
## Call:
## lm(formula = log(colombia_data$`Under-five mortality rate`) ~
## colombia_data$Year, data = colombia_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.66624 -0.10229 -0.03613 0.19415 0.29943
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 69.934051 1.527160 45.79 <2e-16 ***
## colombia_data$Year -0.034453 0.000774 -44.51 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2144 on 95 degrees of freedom
## Multiple R-squared: 0.9542, Adjusted R-squared: 0.9538
## F-statistic: 1981 on 1 and 95 DF, p-value: < 2.2e-16coeficientes <- coef(lm_exponentialco)
ecuacion <- paste("Y =", "exp(", round(coeficientes[1], 2), ")", "*", "exp(", round(coeficientes[2], 2), "*X )")
cat("Ecuation:",ecuacion)## Ecuation: Y = exp( 69.93 ) * exp( -0.03 *X )Ajuste logarítmico
lm_logarithmicco = lm(colombia_data$`Under-five mortality rate` ~ log(colombia_data$Year), data = colombia_data)
summary(lm_logarithmicco)##
## Call:
## lm(formula = colombia_data$`Under-five mortality rate` ~ log(colombia_data$Year),
## data = colombia_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.9834 -2.0790 -0.7308 2.1512 6.2310
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4251.8 154.0 27.61 <2e-16 ***
## log(colombia_data$Year) -559.0 20.3 -27.54 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.851 on 95 degrees of freedom
## Multiple R-squared: 0.8887, Adjusted R-squared: 0.8875
## F-statistic: 758.5 on 1 and 95 DF, p-value: < 2.2e-16coeficientes <- coef(lm_logarithmicco)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*ln(X)")
cat("Ecuation:",ecuacion)## Ecuation: Y = 4251.76 + -558.97 *ln(X)Agregar líneas de ajuste a la gráfica de dispersión
plot(colombia_data$Year, colombia_data$`Under-five mortality rate`, col = "blue", pch = 16, xlab = "Year", ylab = "Under-five mortality rate", type = "p")
lines(colombia_data$Year, predict(lm_linearco), col = "red")
lines(colombia_data$Year, predict(lm_quadraticco), col = "green")
lines(colombia_data$Year, predict(lm_cubicco), col = "purple")
lines(colombia_data$Year, exp(predict(lm_exponentialco)), col = "orange")
lines(colombia_data$Year, predict(lm_logarithmicco), col = "brown")
Calcular residuos para cada modelo
residuals_linearco = residuals(lm_linearco)^2
residuals_quadraticco = residuals(lm_quadraticco)^2
residuals_cubicco = residuals(lm_cubicco)^2
residuals_exponentialco = residuals(lm_exponentialco)^2
residuals_logarithmicco = residuals(lm_logarithmicco)^2
summary(residuals_cubicco)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00013 0.64491 1.47577 3.64539 2.93233 45.44614summary(residuals_quadraticco)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00109 0.43909 1.94322 7.01060 4.77084 70.27630summary(residuals_cubicco)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00013 0.64491 1.47577 3.64539 2.93233 45.44614summary(residuals_exponentialco)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0001021 0.0058243 0.0123358 0.0450393 0.0429423 0.4438700summary(residuals_logarithmicco)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00026 1.36062 4.62753 7.95996 9.52801 48.76826Calcular la suma de cuadrados de residuos para cada modelo
ssr_linearco = sum(residuals_linearco)
ssr_quadraticco = sum(residuals_quadraticco)
ssr_cubicco = sum(residuals_cubicco)
ssr_exponentialco = sum(residuals_exponentialco)
ssr_logarithmicco = sum(residuals_logarithmicco)Imprimir la suma de cuadrados de residuos para cada modelo
print(paste("Suma de cuadrados de residuos (linear):", ssr_linearco))## [1] "Suma de cuadrados de residuos (linear): 781.9026993101"print(paste("Suma de cuadrados de residuos (quadratic):", ssr_quadraticco))## [1] "Suma de cuadrados de residuos (quadratic): 680.028112350773"print(paste("Suma de cuadrados de residuos (cubic):", ssr_cubicco))## [1] "Suma de cuadrados de residuos (cubic): 353.603176305255"print(paste("Suma de cuadrados de residuos (exponential):", ssr_exponentialco))## [1] "Suma de cuadrados de residuos (exponential): 4.36881143636565"print(paste("Suma de cuadrados de residuos (logarithmic):", ssr_logarithmicco))## [1] "Suma de cuadrados de residuos (logarithmic): 772.116483298615"Japan
Ajuste lineal
lm_linearja = lm(japan_data$`Under-five mortality rate` ~ japan_data$Year, data = japan_data)
summary(lm_linearja)##
## Call:
## lm(formula = japan_data$`Under-five mortality rate` ~ japan_data$Year,
## data = japan_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.5464 -3.7866 -0.4667 3.1676 9.7108
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 494.41887 27.56568 17.94 <2e-16 ***
## japan_data$Year -0.24754 0.01398 -17.70 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.11 on 97 degrees of freedom
## Multiple R-squared: 0.7637, Adjusted R-squared: 0.7612
## F-statistic: 313.4 on 1 and 97 DF, p-value: < 2.2e-16coeficientes <- coef(lm_linearja)
intercepto <- coeficientes[1]
pendiente <- coeficientes[2]
# Impresión de la ecuación
cat("Ecuation: y =", pendiente, "* x +", intercepto)## Ecuation: y = -0.2475418 * x + 494.4189Ajuste cuadrático
lm_quadraticja = lm(japan_data$`Under-five mortality rate` ~ poly(japan_data$Year, 2), data = japan_data)
summary(lm_quadraticja)##
## Call:
## lm(formula = japan_data$`Under-five mortality rate` ~ poly(japan_data$Year,
## 2), data = japan_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2689 -1.0767 0.0292 1.0348 3.9221
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.4466 0.1193 54.04 <2e-16 ***
## poly(japan_data$Year, 2)1 -72.7679 1.1870 -61.30 <2e-16 ***
## poly(japan_data$Year, 2)2 38.7742 1.1870 32.66 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.187 on 96 degrees of freedom
## Multiple R-squared: 0.9805, Adjusted R-squared: 0.9801
## F-statistic: 2412 on 2 and 96 DF, p-value: < 2.2e-16coeficientes <- coef(lm_quadraticja)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*X +", round(coeficientes[3], 2), "*X^2")
cat("Ecuation:",ecuacion)## Ecuation: Y = 6.45 + -72.77 *X + 38.77 *X^2Ajuste cúbico
lm_cubicja = lm(japan_data$`Under-five mortality rate` ~ poly(japan_data$Year, 3), data = japan_data)
summary(lm_cubicja)##
## Call:
## lm(formula = japan_data$`Under-five mortality rate` ~ poly(japan_data$Year,
## 3), data = japan_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1896 -0.5442 -0.0253 0.3653 4.8425
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.44657 0.09337 69.047 <2e-16 ***
## poly(japan_data$Year, 3)1 -72.76786 0.92897 -78.332 <2e-16 ***
## poly(japan_data$Year, 3)2 38.77416 0.92897 41.739 <2e-16 ***
## poly(japan_data$Year, 3)3 -7.29960 0.92897 -7.858 6e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.929 on 95 degrees of freedom
## Multiple R-squared: 0.9882, Adjusted R-squared: 0.9878
## F-statistic: 2647 on 3 and 95 DF, p-value: < 2.2e-16coeficientes <- coef(lm_cubicja)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+",
round(coeficientes[2], 2), "*X +",
round(coeficientes[3], 2), "*X^2 +",
round(coeficientes[4], 2), "*X^3")
cat("Ecuation:",ecuacion)## Ecuation: Y = 6.45 + -72.77 *X + 38.77 *X^2 + -7.3 *X^3Ajuste exponencial
lm_exponentialja= lm(log(japan_data$`Under-five mortality rate` )~ japan_data$Year, data = japan_data)
summary(lm_exponentialja)##
## Call:
## lm(formula = log(japan_data$`Under-five mortality rate`) ~ japan_data$Year,
## data = japan_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.32631 -0.21468 -0.00028 0.16982 0.63186
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.058e+02 1.521e+00 69.57 <2e-16 ***
## japan_data$Year -5.330e-02 7.715e-04 -69.08 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2268 on 97 degrees of freedom
## Multiple R-squared: 0.9801, Adjusted R-squared: 0.9799
## F-statistic: 4771 on 1 and 97 DF, p-value: < 2.2e-16coeficientes <- coef(lm_exponentialja)
ecuacion <- paste("Y =", "exp(", round(coeficientes[1], 2), ")", "*", "exp(", round(coeficientes[2], 2), "*X )")
cat("Ecuation:",ecuacion)## Ecuation: Y = exp( 105.83 ) * exp( -0.05 *X )Ajuste logarítmico
lm_logarithmicja = lm(japan_data$`Under-five mortality rate` ~ log(japan_data$Year), data = japan_data)
summary(lm_logarithmicja)##
## Call:
## lm(formula = japan_data$`Under-five mortality rate` ~ log(japan_data$Year),
## data = japan_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.5001 -3.7494 -0.4252 3.1314 9.5669
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3719.38 206.54 18.01 <2e-16 ***
## log(japan_data$Year) -489.43 27.22 -17.98 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.062 on 97 degrees of freedom
## Multiple R-squared: 0.7691, Adjusted R-squared: 0.7668
## F-statistic: 323.2 on 1 and 97 DF, p-value: < 2.2e-16coeficientes <- coef(lm_logarithmicja)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*ln(X)")
cat("Ecuation:",ecuacion) ## Ecuation: Y = 3719.38 + -489.43 *ln(X)Agregar líneas de ajuste a la gráfica de dispersión
plot(japan_data$Year, japan_data$`Under-five mortality rate`, col = "violet", pch = 16, xlab = "Year", ylab = "Under-five mortality rate", type = "p")
lines(japan_data$Year, predict(lm_linearja), col = "red")
lines(japan_data$Year, predict(lm_quadraticja), col = "green")
lines(japan_data$Year, predict(lm_cubicja), col = "purple")
lines(japan_data$Year, exp(predict(lm_exponentialja)), col = "orange")
lines(japan_data$Year, predict(lm_logarithmicja), col = "brown")
Calcular residuos para cada modelo
residuals_linearja = residuals(lm_linearja)^2
residuals_quadraticja = residuals(lm_quadraticja)^2
residuals_cubicja = residuals(lm_cubicja)^2
residuals_exponentialja = residuals(lm_exponentialja)^2
residuals_logarithmicja = residuals(lm_logarithmicja)^2
summary(residuals_cubicja)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000039 0.041318 0.174291 0.828120 0.600449 23.450069summary(residuals_quadraticja)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000294 0.298953 1.145042 1.366344 1.768256 15.383049summary(residuals_cubicja)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000039 0.041318 0.174291 0.828120 0.600449 23.450069summary(residuals_exponentialja)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000001 0.0078309 0.0369172 0.0504011 0.0821593 0.3992446summary(residuals_logarithmicja)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00104 3.88070 13.05546 16.16893 24.40152 91.52511Calcular la suma de cuadrados de residuos para cada modelo
ssr_linearja = sum(residuals_linearja)
ssr_quadraticja = sum(residuals_quadraticja)
ssr_cubicja = sum(residuals_cubicja)
ssr_exponentialja = sum(residuals_exponentialja)
ssr_logarithmicja = sum(residuals_logarithmicja)Imprimir la suma de cuadrados de residuos para cada modelo
print(paste("Suma de cuadrados de residuos (linear):", ssr_linearja))## [1] "Suma de cuadrados de residuos (linear): 1638.70362093443"print(paste("Suma de cuadrados de residuos (quadratic):", ssr_quadraticja))## [1] "Suma de cuadrados de residuos (quadratic): 135.268008273873"print(paste("Suma de cuadrados de residuos (cubic):", ssr_cubicja))## [1] "Suma de cuadrados de residuos (cubic): 81.9838462511783"print(paste("Suma de cuadrados de residuos (exponential):", ssr_exponentialja))## [1] "Suma de cuadrados de residuos (exponential): 4.98970579157272"print(paste("Suma de cuadrados de residuos (logarithmic):", ssr_logarithmicja))## [1] "Suma de cuadrados de residuos (logarithmic): 1600.72441353877"China
Ajuste lineal
lm_linearch = lm(china_data$`Under-five mortality rate` ~ china_data$Year, data = china_data)
summary(lm_linearch)##
## Call:
## lm(formula = china_data$`Under-five mortality rate` ~ china_data$Year,
## data = china_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4436 -3.2166 -0.4229 1.6295 13.2907
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 694.12961 54.05052 12.84 <2e-16 ***
## china_data$Year -0.34516 0.02716 -12.71 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.044 on 60 degrees of freedom
## Multiple R-squared: 0.7291, Adjusted R-squared: 0.7246
## F-statistic: 161.5 on 1 and 60 DF, p-value: < 2.2e-16coeficientes <- coef(lm_linear)
intercepto <- coeficientes[1]
pendiente <- coeficientes[2]
# Impresión de la ecuación
cat("Ecuation: y =", pendiente, "* x +", intercepto)## Ecuation: y = -0.3350069 * x + 687.4091Ajuste cuadrático
lm_quadraticch = lm(china_data$`Under-five mortality rate` ~ poly(china_data$Year, 2), data = china_data)
summary(lm_quadraticch)##
## Call:
## lm(formula = china_data$`Under-five mortality rate` ~ poly(china_data$Year,
## 2), data = china_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.0235 -1.9090 -0.0485 1.5738 9.2482
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.2923 0.3036 24.02 < 2e-16 ***
## poly(china_data$Year, 2)1 -51.3938 2.3903 -21.50 < 2e-16 ***
## poly(china_data$Year, 2)2 25.3822 2.3903 10.62 2.58e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.39 on 59 degrees of freedom
## Multiple R-squared: 0.9069, Adjusted R-squared: 0.9038
## F-statistic: 287.5 on 2 and 59 DF, p-value: < 2.2e-16coeficientes <- coef(lm_quadraticch)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*X +", round(coeficientes[3], 2), "*X^2")
cat("Ecuation:",ecuacion)## Ecuation: Y = 7.29 + -51.39 *X + 25.38 *X^2Ajuste cúbico
lm_cubicch = lm(china_data$`Under-five mortality rate` ~ poly(china_data$Year, 3), data = china_data)
summary(lm_cubicch)##
## Call:
## lm(formula = china_data$`Under-five mortality rate` ~ poly(china_data$Year,
## 3), data = china_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.9270 -0.7305 -0.3156 0.6255 9.1465
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.2923 0.2428 30.038 < 2e-16 ***
## poly(china_data$Year, 3)1 -51.3938 1.9116 -26.886 < 2e-16 ***
## poly(china_data$Year, 3)2 25.3822 1.9116 13.278 < 2e-16 ***
## poly(china_data$Year, 3)3 -11.1874 1.9116 -5.852 2.38e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.912 on 58 degrees of freedom
## Multiple R-squared: 0.9415, Adjusted R-squared: 0.9385
## F-statistic: 311.1 on 3 and 58 DF, p-value: < 2.2e-16coeficientes <- coef(lm_cubicch)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+",
round(coeficientes[2], 2), "*X +",
round(coeficientes[3], 2), "*X^2 +",
round(coeficientes[4], 2), "*X^3")
cat("Ecuation:",ecuacion)## Ecuation: Y = 7.29 + -51.39 *X + 25.38 *X^2 + -11.19 *X^3Ajuste exponencial
lm_exponentialch= lm(log(china_data$`Under-five mortality rate` )~ china_data$Year, data = china_data)
summary(lm_exponentialch)##
## Call:
## lm(formula = log(china_data$`Under-five mortality rate`) ~ china_data$Year,
## data = china_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.35191 -0.15048 -0.06178 0.18097 0.37625
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 103.596139 2.627873 39.42 <2e-16 ***
## china_data$Year -0.051297 0.001321 -38.84 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1966 on 60 degrees of freedom
## Multiple R-squared: 0.9618, Adjusted R-squared: 0.9611
## F-statistic: 1509 on 1 and 60 DF, p-value: < 2.2e-16coeficientes <- coef(lm_exponentialch)
ecuacion <- paste("Y =", "exp(", round(coeficientes[1], 2), ")", "*", "exp(", round(coeficientes[2], 2), "*X )")
cat("Ecuation:",ecuacion)## Ecuation: Y = exp( 103.6 ) * exp( -0.05 *X )Ajuste logarítmico
lm_logarithmicch = lm(china_data$`Under-five mortality rate` ~ log(china_data$Year), data = china_data)
summary(lm_logarithmicch)##
## Call:
## lm(formula = china_data$`Under-five mortality rate` ~ log(china_data$Year),
## data = china_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.428 -3.198 -0.393 1.630 13.228
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5232.00 407.62 12.84 <2e-16 ***
## log(china_data$Year) -687.84 53.66 -12.82 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.019 on 60 degrees of freedom
## Multiple R-squared: 0.7325, Adjusted R-squared: 0.728
## F-statistic: 164.3 on 1 and 60 DF, p-value: < 2.2e-16coeficientes <- coef(lm_logarithmicch)
ecuacion <- paste("Y =", round(coeficientes[1], 2), "+", round(coeficientes[2], 2), "*ln(X)")
cat("Ecuation:",ecuacion)## Ecuation: Y = 5232 + -687.84 *ln(X)Agregar líneas de ajuste a la gráfica de dispersión
plot(china_data$Year, china_data$`Under-five mortality rate`, col = "blue", pch = 16, xlab = "Year", ylab = "Under-five mortality rate", type = "p")
lines(china_data$Year, predict(lm_linearch), col = "red")
lines(china_data$Year, predict(lm_quadraticch), col = "green")
lines(china_data$Year, predict(lm_cubicch), col = "purple")
lines(china_data$Year, exp(predict(lm_exponentialch)), col = "orange")
lines(china_data$Year, predict(lm_logarithmicch), col = "brown")
Calcular residuos para cada modelo
residuals_linearch = residuals(lm_linearch)^2
residuals_quadraticch = residuals(lm_quadraticch)^2
residuals_cubicch = residuals(lm_cubicch)^2
residuals_exponentialch = residuals(lm_exponentialch)^2
residuals_logarithmicch = residuals(lm_logarithmicch)^2
summary(residuals_cubicch)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00115 0.18995 0.47726 3.41836 0.83065 83.65788summary(residuals_quadraticch)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00028 0.63470 3.09890 5.43703 4.66594 85.52925summary(residuals_cubicch)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00115 0.18995 0.47726 3.41836 0.83065 83.65788summary(residuals_exponentialch)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000524 0.0132096 0.0269015 0.0374147 0.0597710 0.1415662summary(residuals_logarithmicch)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0004 0.8983 7.1262 15.6306 16.1635 174.9888Calcular la suma de cuadrados de residuos para cada modelo
ssr_linearch= sum(residuals_linearch)
ssr_quadraticch = sum(residuals_quadraticch)
ssr_cubicch = sum(residuals_cubicch)
ssr_exponentialch = sum(residuals_exponentialch)
ssr_logarithmicch = sum(residuals_logarithmicch)Imprimir la suma de cuadrados de residuos para cada modelo
print(paste("Suma de cuadrados de residuos (linear):", ssr_linearch))## [1] "Suma de cuadrados de residuos (linear): 981.351860435728"print(paste("Suma de cuadrados de residuos (quadratic):", ssr_quadraticch))## [1] "Suma de cuadrados de residuos (quadratic): 337.09589801095"print(paste("Suma de cuadrados de residuos (cubic):", ssr_cubicch))## [1] "Suma de cuadrados de residuos (cubic): 211.938233844341"print(paste("Suma de cuadrados de residuos (exponential):", ssr_exponentialch))## [1] "Suma de cuadrados de residuos (exponential): 2.31970965280893"print(paste("Suma de cuadrados de residuos (logarithmic):", ssr_logarithmicch))## [1] "Suma de cuadrados de residuos (logarithmic): 969.095939770386"