Ejercicios A1
Javier Paredes
2026-09-29
Ejercicios iniciales
Ejercicio 1
Escribimos el modelo
heartbpm<- c(47.53, 48.27, 49.51, 51.09, 52.57, 54.30,
54.25, 54.45, 57.95, 60.92, 61.91, 77.92,
82.07, 82.95, 83.94, 86.96, 90.42, 92.93, 100.05)
metabol<- c(6.15, 6.31, 6.43, 6.78, 6.86, 6.90, 7.37, 7.41,
8.24, 9.22, 8.16, 12.61, 15.26, 13.09, 14.59,
17.35, 18.57, 19.00, 20.70)
vulture<- data.frame(heartbpm, metabol)
rm(heartbpm, metabol)
attach(vulture)Dibujamos nuestra nube de puntos, creamos el modelo y la lÃnea de tendencia
plot(x=heartbpm, y=metabol)
regresion <- lm(metabol ~ heartbpm)
abline(regresion, col = "red", lwd = 2)
Escribimos el gráfico de residuos
plot(x=(fitted(regresion)),y=(residuals(regresion)),xlab = "Valores ajustados (Fitted values)",
ylab = "Residuos")
Creamos un modelo cuadrático y añadimos la curva a nuestro gráfico
heartbpm_cuad<-vulture$heartbpm^2
regresion_cuad <- lm(metabol ~ heartbpm + heartbpm_cuad, data = vulture)
b <- coef(regresion_cuad)
plot(x=heartbpm, y=metabol)
curve(b[1] + b[2]*x + b[3]*x^2,
add = TRUE,
col = "darkgreen",
lwd = 2)
Ejercicio 2
Escribimos la tabla extraÃda de la web:
pacientes<-structure(list(Nº = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28,
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64, 65, 66, 67, 68, 69), `Tensión Sistólica` = c(114,
134, 124, 128, 116, 120, 138, 130, 139, 125, 132, 130, 140, 144,
110, 148, 124, 136, 150, 120, 144, 153, 134, 152, 158, 124, 128,
138, 142, 160, 135, 138, 142, 145, 149, 156, 159, 130, 157, 142,
144, 160, 174, 156, 158, 174, 150, 154, 165, 164, 168, 140, 170,
185, 154, 169, 172, 144, 162, 158, 162, 176, 176, 158, 170, 172,
184, 175, 180), Edad = c(17, 18, 19, 19, 20, 21, 21, 22, 23,
25, 26, 29, 33, 33, 34, 35, 36, 36, 38, 39, 39, 40, 41, 41, 41,
42, 42, 42, 44, 44, 45, 45, 46, 47, 47, 47, 47, 48, 48, 50, 50,
51, 51, 52, 53, 55, 56, 56, 56, 57, 57, 59, 59, 60, 61, 61, 62,
63, 64, 65, 65, 65, 66, 67, 67, 68, 68, 69, 70)), row.names = c(NA,
-69L), class = c("tbl_df", "tbl", "data.frame"))Calculamos la regrasión por mÃnimos cuadrados
regresion<-lm(`Tensión Sistólica`~ Edad, data = pacientes)Calculamos los coeficientes de la recta
coef(regresion)## (Intercept) Edad
## 103.3526585 0.9835585Ejercicios del libro de Faraway
Ejercicio 1
Cargamos los datos y modificamos la variable sexo de manera que sea fácilmente comprensible
library(faraway)
data(teengamb)
teengamb$sex <- factor(teengamb$sex, levels = c(0, 1), labels = c("Hombre", "Mujer"))Pedimos el resumen numérico de nuestros datos
summary(teengamb[,1:3])## sex status income
## Hombre:28 Min. :18.00 Min. : 0.600
## Mujer :19 1st Qu.:28.00 1st Qu.: 2.000
## Median :43.00 Median : 3.250
## Mean :45.23 Mean : 4.642
## 3rd Qu.:61.50 3rd Qu.: 6.210
## Max. :75.00 Max. :15.000summary(teengamb[,4:5])## verbal gamble
## Min. : 1.00 Min. : 0.0
## 1st Qu.: 6.00 1st Qu.: 1.1
## Median : 7.00 Median : 6.0
## Mean : 6.66 Mean : 19.3
## 3rd Qu.: 8.00 3rd Qu.: 19.4
## Max. :10.00 Max. :156.0A continuación presentamos el resumen gráfico:
boxplot(gamble ~ sex, data = teengamb,
col = c("lightblue", "pink"),
main = "Gasto por sexo")
plot(gamble~income, data= teengamb,main= "Apuesta vs Ingresos")
Observaciones
Existen diferencias importantes entre hombres y mujeres, siendo los hombres quienes gastan mayores cantidades de dinero en apuestas.
En cuanto a los ingresos existe una mayor tendencia a apostar mayores cantidades de dinero en personas con mayores ingresos.
Ejercicio 2
Cargamos los datos y convertimos las variables categóricas más importantes
library(faraway)
data(uswages)
uswages$race <- factor(uswages$race, levels = c(0, 1), labels = c("Blanco", "Negro"))
uswages$pt <- factor(uswages$pt, levels = c(0,1), labels = c("Completa","Parcial"))Elegimos las variables más relevantes y extraemos el resumen numérico
resumen <- uswages[,c("wage","educ","exper","race","pt")]
summary(resumen[,1:3])## wage educ exper
## Min. : 50.39 Min. : 0.00 Min. :-2.00
## 1st Qu.: 308.64 1st Qu.:12.00 1st Qu.: 8.00
## Median : 522.32 Median :12.00 Median :15.00
## Mean : 608.12 Mean :13.11 Mean :18.41
## 3rd Qu.: 783.48 3rd Qu.:16.00 3rd Qu.:27.00
## Max. :7716.05 Max. :18.00 Max. :59.00summary(resumen[,4:5])## race pt
## Blanco:1844 Completa:1815
## Negro : 156 Parcial : 185A continuación, presentamos el resumen gráfico:
boxplot(wage~race,data = uswages,
col= c("white","darkgray"),
main="Salarios en función de la raza")
boxplot(wage~pt,data = uswages,
main= "Salarios en función de la jornada laboral")
plot(wage~educ, data = uswages,
main= "Salarios vs educación")
Observaciones
Los trabajadores blancos tienen un salario ligeramente más alto, y los negros rara vez obtienen salarios muy elevados (valores atÃpicos)
En cuanto a la jornada laboral, los salarios de los trabajadores a jornada completa son generalmente más altos que aquellos a media jornada, habiendo valores atÃpicos en ambos grupos
Por último, respecto a la educación se observa que la posibilidad de obtener sueldos más elevados aumenta con la educación per existen de igual manera trabajadores de mucha educación y salarios bajos.
Ejercicios del libro de Carmona
Ejercicio 3
dens <- c(12.7,17.0,66.0,50.0,87.8,81.4,75.6,66.2,81.1,62.8,77.0,89.6,
18.3,19.1,16.5,22.2,18.6,66.0,60.3,56.0,66.3,61.7,66.6,67.8)
vel <- c(62.4,50.7,17.1,25.9,12.4,13.4,13.7,17.9,13.8,17.9,15.8,12.6,
51.2,50.8,54.7,46.5,46.3,16.9,19.8,21.2,18.3,18.0,16.6,18.3)
rvel <- sqrt(vel)- Comenzamos generando el gráfico y la recta que pasa por los puntos (12.7,√62.4) y (87.8,√12.4)
#Añadimos los dos puntos y calculamos la pendiente y el punto de corte
x<-c(12.7,87.8)
y<-c(sqrt(62.4),sqrt(12.4))
pendiente<-(y[2]-y[1])/(x[2]-x[1])
punto_corte<-y[2]-pendiente*x[2]
c(pendiente,punto_corte)## [1] -0.05829566 8.63972188#Dibujamos el gráfico con la recta que hemos calculado
plot(dens,rvel)
abline(a= punto_corte,b= pendiente)
Calculamos los residuos y las predicciones
pred<-punto_corte+dens*pendiente
res<-rvel-predDibujamos el gráfico con los residuos y el de las predicciones
plot(dens,res)
plot(dens,pred)
Calculamos la suma de los cuadrados
R<-sum(res^2)
R## [1] 6.689836- Calculamos la recta, los residuos y las predicciones por mÃnimos cuadrados
recta<-lm(rvel~dens)
res2<-recta$residuals
pred2<-recta$fitted.valuesDibujamos los gráficos con los residuos y las predicciones obtenidas por mÃnimos cuadrados, y calculamos la suma de los cuadrados
plot(dens,res2)
plot(dens,pred2)
R2<-sum(res2^2)
R2## [1] 1.591218- Calculamos el modelo, los residuos y las predicciones considerando una regresión cuadrática.
dens2<-dens^2
curva<-lm(rvel~dens+dens2)
res3<-curva$residuals
pred3<-curva$fitted.valuesDibujamos gráficos de residuos y predicciones
plot(res3~dens)
plot(pred3~dens)
Calculamos la suma de los cuadrados
R3<-sum(res3^2)
R3## [1] 0.3534143- Utilizamos nuestro modelo para calcular capacidad de máximo flujo
b<-coefficients(curva)
flujo_teor<-function(densidad){
flujo<-((b[1]+b[2]*densidad+b[3]*densidad^2)^2)*densidad
return(flujo)
}
máximo<-optimize(flujo_teor,interval = c(0,200),maximum = TRUE)
máximo$maximum## [1] 199.9999Ejercicio 4
datos_atletismo<-read.table(text = "
distancia tiempo_hombres tiempo_mujeres
100 9.84 10.94
200 19.32 22.12
400 43.19 48.25
800 102.58 117.73
1500 215.78 240.83
5000 787.96 899.88
10000 1627.34 1861.63
42192 7956.00 8765.00", header=TRUE)- Calculamos la regresión simple y dibujamos todos los gráficos
reg_simp_m<-lm(tiempo_hombres~distancia,data = datos_atletismo)
res1m<-reg_simp_m$residuals
pred1m<-reg_simp_m$fitted.values
plot(tiempo_hombres~distancia,data = datos_atletismo)
abline(reg_simp_m,
col = "red")
plot(datos_atletismo$distancia,res1m)
plot(datos_atletismo$distancia,pred1m)
Calculamos la suma de los cuadrados y el R2
R<-sum(res1m^2)
R2_<-summary(reg_simp_m)
R2<-R2_$r.squared
c(R,R2)## [1] 5.518900e+04 9.989417e-01- Calculamos la regresión y dibujamos todos los gráficos
ltiempo_hombres<-log10(datos_atletismo$tiempo_hombres)
ldistancia<-log10(datos_atletismo$distancia)
reg_m<-lm(ltiempo_hombres~ldistancia)
res2m<-reg_m$residuals
pred2m<-reg_m$fitted.values
plot(ltiempo_hombres~ldistancia)
abline(reg_m,
col = "red")
plot(ldistancia,res2m)
plot(ldistancia,pred2m)
Calculamos la suma de los cuadrados y el R2
R<-sum(res2m^2)
R2_<-summary(reg_m)
R2<-R2_$r.squared
c(R,R2)## [1] 0.003853265 0.999450277- Calculamos la regresión simple y dibujamos todos los gráficos
reg_simp_f<-lm(tiempo_mujeres~distancia,data = datos_atletismo)
res1f<-reg_simp_f$residuals
pred1f<-reg_simp_f$fitted.values
plot(tiempo_mujeres~distancia,data = datos_atletismo)
abline(reg_simp_f,
col = "red")
plot(datos_atletismo$distancia,res1f)
plot(datos_atletismo$distancia,pred1f)
Calculamos la suma de los cuadrados y el R2
R<-sum(res1f^2)
R2_<-summary(reg_simp_f)
R2<-R2_$r.squared
c(R,R2)## [1] 3.797326e+04 9.993999e-01Calculamos la regresión utilizando logaritmos y dibujamos todos los gráficos
ltiempo_mujeres<-log10(datos_atletismo$tiempo_mujeres)
reg_f<-lm(ltiempo_mujeres~ldistancia)
res2f<-reg_f$residuals
pred2f<-reg_f$fitted.values
plot(ltiempo_mujeres~ldistancia)
abline(reg_f,
col = "red")
plot(ldistancia,res2f)
plot(ldistancia,pred2f)
Calculamos la suma de los cuadrados y el R2
R<-sum(res2f^2)
R2_<-summary(reg_f)
R2<-R2_$r.squared
c(R,R2)## [1] 0.004169579 0.999404241