El artículo “The Incorporation of Uranium and Silver by Hydrothermally Synthesized Galena” (Econ. Geology, 1964: 1003-1024) reporta sobre la determinación de contenido de plata de cristales de galena desarrollados en un sistema hidrotermico cerrado dentro de un rango de temperatura. Con x: temperatura de cristalización en °C y y: Ag2S en mol %, los datos son los siguientes:
x <- c(398, 292, 352, 575, 568, 450, 550, 408, 484, 350, 503, 600, 600)
y <- c(0.15, 0.05, 0.23, 0.43, 0.23, 0.40, 0.44, 0.09, 0.45, 0.09, 0.59, 0.63, 0.63)
Análisis de Regresión Lineal Simple
Primero, realizamos un gráfico de dispersión para visualizar la relación entre la temperatura de cristalización y el contenido de plata.
plot(x, y, main="Temperatura de Cristalización vs Contenido de Plata", xlab="Temperatura de Cristalización (°C)", ylab="Contenido de Plata (mol %)")
A continuación, ajustamos un modelo de regresión lineal simple.
modelo_simple <- lm(y ~ x)
summary(modelo_simple)
##
## Call:
## lm(formula = y ~ x)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.266521 -0.069319 0.003525 0.085689 0.199468
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.4296603 0.1720419 -2.497 0.029642 *
## x 0.0016306 0.0003568 4.570 0.000804 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1294 on 11 degrees of freedom
## Multiple R-squared: 0.655, Adjusted R-squared: 0.6236
## F-statistic: 20.88 on 1 and 11 DF, p-value: 0.0008037
Verificamos los supuestos del modelo con gráficos de diagnóstico.
par(mfrow=c(2,2))
plot(modelo_simple)
Prueba de Hipótesis
Supongamos que previamente se creía que cuando la temperatura de cristalización era de 410°C, el contenido de plata promedio verdadero sería de 0.20. Realizamos una prueba a un nivel de significación de 0.05 para decidir si los datos muestrales contradicen esta creencia previa.
pred_410 <- predict(modelo_simple, newdata=data.frame(x=410))
pred_410_conf <- predict(modelo_simple, newdata=data.frame(x=410), interval="confidence", level=0.95)
pred_410
## 1
## 0.2388861
pred_410_conf
## fit lwr upr
## 1 0.2388861 0.14628 0.3314922
Punto 2: Análisis de Regresión Lineal Múltiple
Queremos predecir el y: tiempo de respuesta de un servidor (en milisegundos) en función de varias variables independientes:
x1: número de usuarios concurrentes
x2: uso de la CPU (%)
x3: cantidad de memoria disponible (MB)
x4: ancho de banda (Mbps)
x5: latencia de red (ms)
Los datos son los siguientes:
tiempo_respuesta <- c(170, 165, 168, 175, 180, 190, 200, 185, 210, 220, 230, 240)
x1 <- c(13, 12, 15, 16, 20, 25, 10, 22, 30, 35, 40, 28)
x2 <- c(40, 35, 37, 40, 55, 70, 60, 55, 75, 85, 90, 75)
x3 <- c(1648, 1900, 1850, 1872, 1760, 1600, 1700, 1600, 1500, 1700, 1600, 1500)
x4 <- c(80, 95, 85, 90, 100, 110, 105, 100, 115, 125, 130, 105)
x5 <- c(18, 25, 20, 18, 15, 14, 16, 19, 12, 10, 8, 11)
datos <- data.frame(tiempo_respuesta, x1, x2, x3, x4, x5)
Realizamos el ajuste del modelo de regresión lineal múltiple.
modelo_multiple <- lm(tiempo_respuesta ~ x1 + x2 + x3 + x4 + x5, data=datos)
summary(modelo_multiple)
##
## Call:
## lm(formula = tiempo_respuesta ~ x1 + x2 + x3 + x4 + x5, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18.5840 -5.8766 0.2899 5.4130 17.2387
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 95.58087 139.30367 0.686 0.518
## x1 -0.18890 0.91381 -0.207 0.843
## x2 3.02021 2.20306 1.371 0.219
## x3 0.03847 0.07045 0.546 0.605
## x4 -1.60336 1.64878 -0.972 0.368
## x5 1.50884 3.52964 0.427 0.684
##
## Residual standard error: 12.46 on 6 degrees of freedom
## Multiple R-squared: 0.8692, Adjusted R-squared: 0.7603
## F-statistic: 7.977 on 5 and 6 DF, p-value: 0.01257
Verificamos los supuestos del modelo con gráficos de diagnóstico.
par(mfrow=c(2,2))
plot(modelo_multiple)
Elección de Variables Significativas Aplicamos el método backward para
la elección de las variables significativas.
modelo_backward <- step(modelo_multiple, direction="backward")
## Start: AIC=64.22
## tiempo_respuesta ~ x1 + x2 + x3 + x4 + x5
##
## Df Sum of Sq RSS AIC
## - x1 1 6.635 938.25 62.309
## - x5 1 28.373 959.99 62.584
## - x3 1 46.310 977.93 62.806
## - x4 1 146.834 1078.45 63.980
## <none> 931.62 64.224
## - x2 1 291.817 1223.43 65.494
##
## Step: AIC=62.31
## tiempo_respuesta ~ x2 + x3 + x4 + x5
##
## Df Sum of Sq RSS AIC
## - x5 1 35.313 973.57 60.753
## - x3 1 48.003 986.26 60.908
## - x4 1 161.287 1099.54 62.213
## <none> 938.25 62.309
## - x2 1 290.450 1228.70 63.546
##
## Step: AIC=60.75
## tiempo_respuesta ~ x2 + x3 + x4
##
## Df Sum of Sq RSS AIC
## - x3 1 17.04 990.61 58.961
## - x4 1 168.45 1142.02 60.668
## <none> 973.57 60.753
## - x2 1 695.35 1668.92 65.220
##
## Step: AIC=58.96
## tiempo_respuesta ~ x2 + x4
##
## Df Sum of Sq RSS AIC
## <none> 990.61 58.961
## - x4 1 200.63 1191.24 59.174
## - x2 1 1599.29 2589.90 68.494
summary(modelo_backward)
##
## Call:
## lm(formula = tiempo_respuesta ~ x2 + x4, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -17.502 -4.600 -1.317 5.672 19.394
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 170.6471 37.2217 4.585 0.00132 **
## x2 1.8063 0.4739 3.812 0.00414 **
## x4 -0.8144 0.6032 -1.350 0.20995
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.49 on 9 degrees of freedom
## Multiple R-squared: 0.861, Adjusted R-squared: 0.8301
## F-statistic: 27.87 on 2 and 9 DF, p-value: 0.0001393