2. Se realizó un experimento para determinar el efecto de la velocidad sobre la distancia recorrida de un vehículo. Los resultados se encuentran en el archivo Cars.txt
Autos <- read.csv("D:/Universidades/faku/2023/lab4/base/autos.txt", sep="")
head(Autos)
## mpg cylinders displacement horsepower weight acceleration year origin
## 1 18 8 307 17 3504 12.0 70 1
## 2 15 8 350 35 3693 11.5 70 1
## 3 18 8 318 29 3436 11.0 70 1
## 4 16 8 304 29 3433 12.0 70 1
## 5 17 8 302 24 3449 10.5 70 1
## 6 15 8 429 42 4341 10.0 70 1
#install.packages("ggplot2")
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.2.2
#install.packages("broom")
library(broom)
#install.packages("ggfortify")
library(ggfortify)
# Crea el gráfico de dispersión
ggplot(data = Autos, aes(x = mpg, y = weight)) +
geom_point() +
xlab("Millas por galón (mpg)") +
ylab("Peso (1000 lb)") +
ggtitle("Diagrama de dispersión de velocidad vs. distancia (mtcars)")
Usando un diagrama de dispersión se puede observar que existe una relación inversa entre las variables.
library(car)
## Warning: package 'car' was built under R version 4.2.2
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.2.2
# Crea un modelo lineal de mpg vs. wt
model <- lm(mpg ~ weight, data = Autos)
summary(model)
##
## Call:
## lm(formula = mpg ~ weight, data = Autos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.0123 -2.8076 -0.3541 2.1145 16.4802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 46.3173992 0.7962915 58.17 <2e-16 ***
## weight -0.0076766 0.0002578 -29.78 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.35 on 395 degrees of freedom
## Multiple R-squared: 0.6918, Adjusted R-squared: 0.691
## F-statistic: 886.6 on 1 and 395 DF, p-value: < 2.2e-16
# Realiza la prueba de falta de ajuste
Anova(model, type = "II")
## Anova Table (Type II tests)
##
## Response: mpg
## Sum Sq Df F value Pr(>F)
## weight 16777.5 1 886.59 < 2.2e-16 ***
## Residuals 7474.8 395
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Hipótesis nula (H0): El modelo lineal no proporciona un ajuste adecuado a los datos.
Hipótesis alternativa (Ha): El modelo lineal proporciona un ajuste adecuado a los datos.
Pvalor=0.00<0.05. Rechazo Ho
Conclusión: A un nivel de significación del 5%, existe evidencia estadística para rechaza Ho, El modelo lineal proporciona un ajuste adecuado a los datos.
El valor del estadístico para la prueba de falta de ajuste para el modelo lineal es: ___886.590<y su p-valor es ___0.000___ por lo que se considera que el modelo lineal ___no tiene problemas de falta de ajuste. Escriba sus respuestas con tres decimales.
PREGUNTA 3
En estudios sobre especies marinas uno de los modelos más utilizado para estudiar la longitud (Length) de un pez a una determinada edad (Age) es la función de von Bertalanfly dada por:
E(Length/Age=t)= L(1-exp(-K(t-t0)))
Pez <- read.csv("D:/Universidades/faku/2023/lab4/base/Lakemary.txt", sep="")
head(Pez)
## Age Length
## 1 1 67
## 2 1 62
## 3 2 109
## 4 2 83
## 5 2 91
## 6 2 88
Pez <- read.csv("D:/Universidades/faku/2023/lab4/base/Lakemary.txt", sep="")
head(Pez)
## Age Length
## 1 1 67
## 2 1 62
## 3 2 109
## 4 2 83
## 5 2 91
## 6 2 88
Construya un diagrama de dispersión para los datos en el archive. Lakemary.txt. se observa que existe una relación __________ entre las variables.
# Crea el gráfico de dispersión
ggplot(data = Pez, aes(x =Age, y = Length)) +
geom_point() +
xlab("Edad)") +
ylab("Longitud de un pez (Length ") +
ggtitle("Diagrama de dispersión de Age vs. Length")
# Crea el gráfico de dispersión
ggplot(data = Pez, aes(x = Length, y = Age)) +
geom_point() +
xlab("Longitud de un pez (Length)") +
ylab("Edad ") +
ggtitle("Diagrama de dispersión de Length vs. Age")
#################################################################
Podemos linealizar la función de von Bertalanfly de la siguiente manera:
Tomar el logaritmo natural de ambos lados: log(E(Length/Age=t)) = log(L(1-exp(-K(t-t0))))
Utilizar la propiedad logarítmica: log(E(Length/Age=t)) = log(L) - K(t-t0)
Transformar el lado derecho de la igualdad en una función lineal de la variable predictor Age: log(E(Length/Age=t)) = log(L) - Kt + Kt0
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.2.2
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.1 ✔ stringr 1.4.1
## ✔ readr 2.1.3 ✔ forcats 0.5.2
## ✔ purrr 1.0.1
## Warning: package 'purrr' was built under R version 4.2.2
## Warning: package 'dplyr' was built under R version 4.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
L<-200
# Función no lineal
von_bertalanffy_model <- function(Age, K, t0) {
200 * (1 - exp(-K * (Age - t0)))
}
# Ajuste no lineal
fit <- nls(Length ~ von_bertalanffy_model(Age, K, t0),
data = Pez,
start = list(K = 0.1, t0 = 0.1))
# Coeficientes estimados
coef(fit)
## K t0
## 0.36379959 -0.01914327
# K t0
# 0.36379959 -0.01914327
K<- 0.36379959
t0<-0.01914327
# Linealización
Pez$log_length <- log(Pez$Length)
Pez$age_t <- Pez$Age - t0
Pez$log_length_pred <- log(L) - K * Pez$age_t
# Modelo de regresión lineal
fit <- lm(log_length ~ age_t, data = Pez)
summary(fit)
##
## Call:
## lm(formula = log_length ~ age_t, data = Pez)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.33987 -0.05671 -0.00047 0.06987 0.17648
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.28694 0.04953 86.56 <2e-16 ***
## age_t 0.18357 0.01330 13.81 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1082 on 76 degrees of freedom
## Multiple R-squared: 0.7149, Adjusted R-squared: 0.7112
## F-statistic: 190.6 on 1 and 76 DF, p-value: < 2.2e-16
plot(fit)
####################################
En el conjunto de datos Cars.txt la variable respuesta es mpg y considere que el resto son las predictoras a excepción de year y origin.
Al aplicar el proceso de selección automática de las transformaciones para los predictores usando un nivel de significación del 5% se recomienda _____________a ____ de las variables predictoras ya que el valor del estadístico LRT es ____ y su p-valor es ____. Escriba sus respuestas en 3 decimales.
Usando las pruebas individuales a 5% elimine las variables nos significativas del modelo obtenido en a pregunta anterior y luego responda:
• El valor del estadístico de prueba para verificar el supuesto de normalidad de los errores es____ por lo que se puede considerar que _____el supuesto. Escriba sus respuestas en 4 decimales.
library(stats)
AUTO_MODEL<- read.csv("D:/Universidades/faku/2023/lab4/base/autos.txt", sep="")
head(AUTO_MODEL)
## mpg cylinders displacement horsepower weight acceleration year origin
## 1 18 8 307 17 3504 12.0 70 1
## 2 15 8 350 35 3693 11.5 70 1
## 3 18 8 318 29 3436 11.0 70 1
## 4 16 8 304 29 3433 12.0 70 1
## 5 17 8 302 24 3449 10.5 70 1
## 6 15 8 429 42 4341 10.0 70 1
attach(AUTO_MODEL)
## The following object is masked from package:ggplot2:
##
## mpg
Transf<-powerTransform(cbind(cylinders, displacement, horsepower,weight,acceleration)~1)
summary(Transf)
## bcPower Transformations to Multinormality
## Est Power Rounded Pwr Wald Lwr Bnd Wald Upr Bnd
## cylinders -0.4387 -0.50 -0.7399 -0.1375
## displacement 0.1778 0.18 0.0657 0.2900
## horsepower 0.9524 1.00 0.8312 1.0736
## weight 0.0189 0.00 -0.2126 0.2503
## acceleration 0.1361 0.00 -0.2530 0.5253
##
## Likelihood ratio test that transformation parameters are equal to 0
## (all log transformations)
## LRT df pval
## LR test, lambda = (0 0 0 0 0) 345.4188 5 < 2.22e-16
##
## Likelihood ratio test that no transformations are needed
## LRT df pval
## LR test, lambda = (1 1 1 1 1) 265.8512 5 < 2.22e-16
Autos.m1<-lm(mpg~cylinders+displacement+horsepower+weight+acceleration, data = AUTO_MODEL)
summary(Autos.m1)
##
## Call:
## lm(formula = mpg ~ cylinders + displacement + horsepower + weight +
## acceleration, data = AUTO_MODEL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.9150 -2.8257 -0.3714 2.3485 16.2404
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 41.4583258 2.3192757 17.876 < 2e-16 ***
## cylinders -0.2234255 0.4358412 -0.513 0.6085
## displacement -0.0075118 0.0090026 -0.834 0.4046
## horsepower 0.0030927 0.0087868 0.352 0.7250
## weight -0.0061188 0.0007475 -8.186 3.85e-15 ***
## acceleration 0.1765343 0.0982567 1.797 0.0732 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.307 on 391 degrees of freedom
## Multiple R-squared: 0.7009, Adjusted R-squared: 0.6971
## F-statistic: 183.3 on 5 and 391 DF, p-value: < 2.2e-16
estadístico de prueba: 183.3 5 grados de libertad
Hipótesis Nula: El modelo no es válido
Hipótesis alterna: El modelo es válido
Pvalor=0.00<0.05. Se rechaza HO. El modelo es válido
De acuerdo a la salida de este modelo lineal, las variables “weight” y “Intercept” son significativas a un nivel de significancia de 0.05 o menor. Se puede decir que estas dos variables tienen un efecto estadísticamente significativo en la respuesta (mpg). Sin embargo, las variables “cylinders”, “displacement”, “horsepower”, y “acceleration” no son estadísticamente significativas en el modelo a un nivel de significancia de 0.05. ################################################
Usando las pruebas individuales a 5% elimine las variables nos significativas del modelo obtenido en a pregunta anterior y luego responda: • El valor del estadístico de prueba para verificar el supuesto de normalidad de los errores es____ por lo que se puede considerar que _____el supuesto. Escriba sus respuestas en 4 decimales.
MODEL_SIG<-lm(mpg ~ weight, data = AUTO_MODEL)
shapiro.test(residuals(MODEL_SIG))
##
## Shapiro-Wilk normality test
##
## data: residuals(MODEL_SIG)
## W = 0.97053, p-value = 3.458e-07
Hipótesis Nula: Los residuos se disribuyen de forma normal
Hipótesis Alterna: Los residuos no se distribuyen de forma normal
Pvalor=0.000<0.05. Se rechaza Ho. Los residuos se distribuyen de forma normal
• El valor del estadístico de prueba para verificar el supuesto de independencia de los errores es____ por lo que se puede considerar que _____el supuesto. Escriba sus respuestas en 4 decimales.
residuals<-resid(MODEL_SIG)
predict<-predict(MODEL_SIG)
plot(predict,residuals)
abline(h = 0)
acf(residuals)
Box.test(residuals, lag = 20, type = "Ljung-Box")
##
## Box-Ljung test
##
## data: residuals
## X-squared = 1250.4, df = 20, p-value < 2.2e-16
Ho: Los residuos son independientes
H1: Los residuos no son independientes
Pvalor=0.00<0.05. Se rechaza H0.Los residuos son independientes
Estadístico de prueba es : 1250.4
###################################
cor_matrix <- cor(Autos[,c("mpg", "cylinders", "displacement", "horsepower", "weight", "acceleration", "origin")])
cor_matrix[1,]
## mpg cylinders displacement horsepower weight acceleration
## 1.0000000 -0.7762599 -0.8044430 0.4228227 -0.8317389 0.4222974
## origin
## 0.5636979
MODEL_COR<-lm(mpg ~ weight, data = AUTO_MODEL)
summary(MODEL_COR)
##
## Call:
## lm(formula = mpg ~ weight, data = AUTO_MODEL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.0123 -2.8076 -0.3541 2.1145 16.4802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 46.3173992 0.7962915 58.17 <2e-16 ***
## weight -0.0076766 0.0002578 -29.78 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.35 on 395 degrees of freedom
## Multiple R-squared: 0.6918, Adjusted R-squared: 0.691
## F-statistic: 886.6 on 1 and 395 DF, p-value: < 2.2e-16
El coeficiente de determinación es 0.6918.