Baseball.csv
Pregunta 1,2,3,4
# Lectura de los datos
Baseball <- read.csv("Baseball.csv", row.names = 1);Baseball
## BattingAvg WinningPerc
## Baltimore 0.266 0.574
## Boston 0.269 0.661
## California 0.256 0.508
## Chicago 0.246 0.410
## Cleveland 0.271 0.500
## Detroit 0.259 0.467
## Kansas_City 0.250 0.508
## Milwaukee 0.271 0.525
## Minnesota 0.274 0.403
## New York 0.268 0.587
## Oakland 0.252 0.422
## Seattle 0.246 0.391
## Texas 0.263 0.548
## Toronto 0.270 0.500
Pregunta 5
attach(Baseball) #archivo en uso
lab = rownames(Baseball) #etiquetas de las unidades en lab
# definición de los datos para el modelo
n = dim(Baseball)[1];n # n es el número de observaciones
## [1] 14
x = Baseball[,1]; x # x es el caracter descriptivo
## [1] 0.266 0.269 0.256 0.246 0.271 0.259 0.250 0.271 0.274 0.268 0.252 0.246 0.263 0.270
y = Baseball[,2]; y # y es el caracter respuesta
## [1] 0.574 0.661 0.508 0.410 0.500 0.467 0.508 0.525 0.403 0.587 0.422 0.391 0.548 0.500
nom = colnames(Baseball) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 0.2615
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 0.5002857
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 0.958621
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 3.582586
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 1.836521
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 0.0012695
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 0.0012695
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] 0.004975
varx = ssxc/n; varx # varx es la varianza de x
## [1] 9.067857e-05
vary = ssyc/n; vary # vary es la varianza de y
## [1] 0.005613204
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] 0.0003553571
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## BattingAvg WinningPerc xy
## Mínimo 2.460000e-01 0.391000000 0.0000000000
## Máximo 2.740000e-01 0.661000000 0.0000000000
## Promedio 2.615000e-01 0.500285714 0.0000000000
## Total 3.661000e+00 7.004000000 0.0000000000
## Suma de cuadrados 9.586210e-01 3.582586000 1.8365210000
## Cuadrados centrados 1.269500e-03 0.078584857 0.0049750000
## Varianza covarianza 9.067857e-05 0.005613204 0.0003553571
## Desvío estándar 9.522530e-03 0.074921319 0.0000000000
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] 3.918866
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] -0.5244977
eta = ah + bh *x; eta # valores estimados
## [1] 0.5179206 0.5296772 0.4787320 0.4395433 0.5375149 0.4904886 0.4552188 0.5375149 0.5492715 0.5257583 0.4630565 0.4395433 0.5061640 0.5335961
res = y - eta; res #residuos
## [1] 0.05607939 0.13132279 0.02926805 -0.02954330 -0.03751494 -0.02348855 0.05278124 -0.01251494 -0.14627154 0.06124166 -0.04105649 -0.04854330 0.04183599 -0.03359607
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## BattingAvg WinningPerc eta residuos %res
## [1,] 0.266 0.574 0.5179206 0.05607939 9.769929
## [2,] 0.269 0.661 0.5296772 0.13132279 19.867291
## [3,] 0.256 0.508 0.4787320 0.02926805 5.761427
## [4,] 0.246 0.410 0.4395433 -0.02954330 -7.205682
## [5,] 0.271 0.500 0.5375149 -0.03751494 -7.502988
## [6,] 0.259 0.467 0.4904886 -0.02348855 -5.029668
## [7,] 0.250 0.508 0.4552188 0.05278124 10.390008
## [8,] 0.271 0.525 0.5375149 -0.01251494 -2.383798
## [9,] 0.274 0.403 0.5492715 -0.14627154 -36.295666
## [10,] 0.268 0.587 0.5257583 0.06124166 10.432991
## [11,] 0.252 0.422 0.4630565 -0.04105649 -9.729026
## [12,] 0.246 0.391 0.4395433 -0.04854330 -12.415165
## [13,] 0.263 0.548 0.5061640 0.04183599 7.634304
## [14,] 0.270 0.500 0.5335961 -0.03359607 -6.719215
# gráfico clásico
plot(x,y,xlab="BattingAvg",ylab="WinningPerc")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topleft", # Ubicación de la leyenda en el gráfico
legend = expression(y(WinningPerc) == -0.5244977 + 3.918866 * x(BattingAvg)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión
# Ecuación de la recta: y = -0.5244977+ 3.918866*x
# Observamos una relación positiva entre el BattingAvg y WinningPerc (dado el valor de la estimación bh = 3.918866). Esto quiere decir que a medida que el BattingAvg aumenta, también lo hace, WinningPerc.
## Gráficos de Residuos vs Estimados:
# En general la mayor parte de los residuos se concentran alrededor de la línea horizontal (que marque residuo cero), lo cual sugiere que las estimaciones están cercanas a los valores reales.
# Analizando el gráfico de residuos vs estimados, se observa que el etado de Boston tiene un residuo positivo grande(respecto al resto, 0.13132279), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, Minnesota tiene un residuo negativo grande (respecto al resto,-0.14627154), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (Minessota)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 1.915795
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 0.5009803
ym # promedio de y
## [1] 0.5002857
etam = mean(b0*x);etam # promedio de eta
## [1] 0.5009803
Se = sum(y-b0*x);Se # Suma de desvío
## [1] -0.009724278
Se/n # desvío promedio
## [1] -0.0006945913
ym - etam # diferencia de promedios
## [1] -0.0006945913
x_range = range(x)
etasi = b0*x_range
# Gráfico principal
plot(x, y, xlab = "BattingAvg", ylab = "WinningPerc")
text(x, y, labels = lab, cex = 0.7)
points(x, eta, col = "red")
abline(ah, bh, col = "red")
lines(x_range, etasi, col = "blue", lwd = 2)
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.8)
#Comentarios:
# El modelo lineal para el origen tiene una tendencia al igual que la recta de modelo lineal (linea color rojo)
# Además de tener una diferencia de promedios muy cercana a cero(-0.0006945913), lo cual podría sugerir que el modelo tiene buen ajuste en el promedio
Pregunta 7
#Apalancamiento
w = (x-xm)^2/ssxc;w # w pesos de los pendientes
## [1] 0.015951162 0.044308783 0.023828279 0.189247735 0.071090981 0.004923198 0.104174872 0.071090981 0.123079953 0.033280819 0.071090981 0.189247735 0.001772351 0.056912170
b = (y-ym)/(x-xm);b # pendientes
## [1] 16.38095238 21.42857143 -1.40259740 5.82488479 -0.03007519 13.31428571 -0.67080745 2.60150376 -7.78285714 13.34065934 8.24060150 7.05069124 31.80952381 -0.03361345
bh2 = t(w)%*%b;bh2 # determinación alternativa de bh
## [,1]
## [1,] 3.918866
c = (x-xm)/ssxc;c # coeficientes de beta según y
## [1] 3.544703 5.907838 -4.332414 -12.209531 7.483261 -1.969279 -9.058685 7.483261 9.846396 5.120126 -7.483261 -12.209531 1.181568 6.695549
bh3 = t(c)%*%y; bh3 # determinación alternativa de bh
## [,1]
## [1,] 3.918866
Hs = matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs) = lab # Inclusión de sus etiquetas
colnames(Hs) = lab
for (i in 1:n){
for (j in 1:n){
Hs[i,j] = 1/n + c[j]*(x[i]-xm)
}
};Hs
## Baltimore Boston California Chicago Cleveland Detroit Kansas_City Milwaukee Minnesota New York Oakland Seattle Texas Toronto
## Baltimore 0.08737973 0.098013841 0.05193271 0.016485681 0.1051032465 0.06256681 0.030664491 0.1051032465 0.11573735 0.094469139 0.0377538964 0.016485681 0.07674563 0.101558544
## Boston 0.09801384 0.115737354 0.03893546 -0.020142913 0.1275530299 0.05665898 0.003488438 0.1275530299 0.14527654 0.109829517 0.0153041130 -0.020142913 0.08029033 0.121645192
## California 0.05193271 0.038935464 0.09525685 0.138580994 0.0302706352 0.08225961 0.121251336 0.0302706352 0.01727339 0.043267878 0.1125865076 0.138580994 0.06492995 0.034603050
## Chicago 0.01648568 -0.020142913 0.13858099 0.260676307 -0.0445619760 0.10195240 0.211838182 -0.0445619760 -0.08119057 -0.007933382 0.1874191189 0.260676307 0.05311427 -0.032352445
## Cleveland 0.10510325 0.127553030 0.03027064 -0.044561976 0.1425195521 0.05272042 -0.014628932 0.1425195521 0.16496934 0.120069769 0.0003375907 -0.044561976 0.08265346 0.135036291
## Detroit 0.06256681 0.056658977 0.08225961 0.101952400 0.0527204186 0.07635177 0.094075283 0.0527204186 0.04681258 0.058628256 0.0901367242 0.101952400 0.06847465 0.054689698
## Kansas_City 0.03066449 0.003488438 0.12125134 0.211838182 -0.0146289315 0.09407528 0.175603443 -0.0146289315 -0.04180499 0.012547122 0.1574860744 0.211838182 0.05784054 -0.005570247
## Milwaukee 0.10510325 0.127553030 0.03027064 -0.044561976 0.1425195521 0.05272042 -0.014628932 0.1425195521 0.16496934 0.120069769 0.0003375907 -0.044561976 0.08265346 0.135036291
## Minnesota 0.11573735 0.145276543 0.01727339 -0.081190570 0.1649693355 0.04681258 -0.041804985 0.1649693355 0.19450852 0.135430147 -0.0221121927 -0.081190570 0.08619817 0.155122939
## New York 0.09446914 0.109829517 0.04326788 -0.007933382 0.1200697688 0.05862826 0.012547122 0.1200697688 0.13543015 0.104709391 0.0227873741 -0.007933382 0.07910876 0.114949643
## Oakland 0.03775390 0.015304113 0.11258651 0.187419119 0.0003375907 0.09013672 0.157486074 0.0003375907 -0.02211219 0.022787374 0.1425195521 0.187419119 0.06020368 0.007820852
## Seattle 0.01648568 -0.020142913 0.13858099 0.260676307 -0.0445619760 0.10195240 0.211838182 -0.0445619760 -0.08119057 -0.007933382 0.1874191189 0.260676307 0.05311427 -0.032352445
## Texas 0.07674563 0.080290328 0.06492995 0.053114274 0.0826534631 0.06847465 0.057840545 0.0826534631 0.08619817 0.079108760 0.0602036797 0.053114274 0.07320092 0.081471896
## Toronto 0.10155854 0.121645192 0.03460305 -0.032352445 0.1350362910 0.05468970 -0.005570247 0.1350362910 0.15512294 0.114949643 0.0078208519 -0.032352445 0.08147190 0.128340742
sum(Hs) # Hs es centrada
## [1] 14
lev = diag(Hs);lev # apalancamiento
## Baltimore Boston California Chicago Cleveland Detroit Kansas_City Milwaukee Minnesota New York Oakland Seattle Texas Toronto
## 0.08737973 0.11573735 0.09525685 0.26067631 0.14251955 0.07635177 0.17560344 0.14251955 0.19450852 0.10470939 0.14251955 0.26067631 0.07320092 0.12834074
pesos = cbind(x,w,b,y,c,lev) #construcción de una salida cojunta
rownames(pesos) = lab
pesos
## x w b y c lev
## Baltimore 0.266 0.015951162 16.38095238 0.574 3.544703 0.08737973
## Boston 0.269 0.044308783 21.42857143 0.661 5.907838 0.11573735
## California 0.256 0.023828279 -1.40259740 0.508 -4.332414 0.09525685
## Chicago 0.246 0.189247735 5.82488479 0.410 -12.209531 0.26067631
## Cleveland 0.271 0.071090981 -0.03007519 0.500 7.483261 0.14251955
## Detroit 0.259 0.004923198 13.31428571 0.467 -1.969279 0.07635177
## Kansas_City 0.250 0.104174872 -0.67080745 0.508 -9.058685 0.17560344
## Milwaukee 0.271 0.071090981 2.60150376 0.525 7.483261 0.14251955
## Minnesota 0.274 0.123079953 -7.78285714 0.403 9.846396 0.19450852
## New York 0.268 0.033280819 13.34065934 0.587 5.120126 0.10470939
## Oakland 0.252 0.071090981 8.24060150 0.422 -7.483261 0.14251955
## Seattle 0.246 0.189247735 7.05069124 0.391 -12.209531 0.26067631
## Texas 0.263 0.001772351 31.80952381 0.548 1.181568 0.07320092
## Toronto 0.270 0.056912170 -0.03361345 0.500 6.695549 0.12834074
# Comentario: Chigago y Seatle tienen un mayor peso y también poseen el mayor apalancamiento, por tanto se evaluará el retiro de estas muestras
# Además se evaluará el retiro de Minesota, ya que visualmente, podría representar un valor extremos y ser influyente. Además de tener un valor absoluto del residuo alto.
Pregunta 8
# lm1 : todas las muestras
# lm2: todas las muestras menos Chigago y Seatle
# lm3: todas las muestras menos Minesota
lm1=lm(WinningPerc~BattingAvg,data=Baseball); lm1
##
## Call:
## lm(formula = WinningPerc ~ BattingAvg, data = Baseball)
##
## Coefficients:
## (Intercept) BattingAvg
## -0.5245 3.9189
lm2=lm(WinningPerc~BattingAvg,data=Baseball[c(1:3,5:11,13:14),]); lm2
##
## Call:
## lm(formula = WinningPerc ~ BattingAvg, data = Baseball[c(1:3,
## 5:11, 13:14), ])
##
## Coefficients:
## (Intercept) BattingAvg
## 0.008028 1.927001
lm3=lm(WinningPerc~BattingAvg, data=Baseball[c(1:8,10:14),]);lm3
##
## Call:
## lm(formula = WinningPerc ~ BattingAvg, data = Baseball[c(1:8,
## 10:14), ])
##
## Coefficients:
## (Intercept) BattingAvg
## -0.9791 5.7069
plot(BattingAvg,WinningPerc)
text(BattingAvg,WinningPerc,labels = lab)
abline(lm1,col="red") # recta con Chicago y Seatle
abline(lm2,col="blue") # recta sin Chicago y Seatle
abline(lm3,col="green") # recta sin Minesota
# Agregar leyenda
legend("topleft", # ubicación de la leyenda dentro del gráfico
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin Chicago y Seattle", "lm3: Modelo sin Minnesota"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.8)
# Comentarios:
# modelo lm2: tiene una pendiente menos pronunciada respecto al lm1. Esto dado que se retiro las dos muestras de Chicago como Minesota, quienes tenian un alto peso y apalancamiento
# modelo lm3: Tiene una pendiente más pronunciada que lm1 y lm2. El intercepto tiene un valor más pronunciado que en lm1. Lo que podría sugerir que Minnesota tiene un impacto en la estimación.
Students.csv
Pregunta 1,2,3,4
# Lectura de los datos
Students <- read.csv("Students.csv", row.names = 1);Students
## midterm final hw total
## 1 24.5 26.0 28.5 79.0
## 2 22.5 24.5 28.2 75.2
## 3 23.5 26.5 28.3 78.3
## 4 23.5 34.5 29.2 87.2
## 5 22.5 30.5 27.3 80.3
## 6 16.0 31.0 27.5 74.5
## 7 27.5 33.5 29.7 90.7
## 8 22.5 31.0 29.0 82.5
## 9 25.0 29.5 27.3 81.8
## 10 30.0 37.5 27.2 94.7
## 11 17.5 19.5 27.8 64.8
## 12 16.5 23.5 28.5 68.5
## 13 22.5 21.0 24.3 67.8
## 14 22.5 20.0 26.2 68.7
## 15 11.5 15.5 29.0 56.0
## 16 20.0 20.0 28.7 68.7
## 17 24.0 31.0 29.3 84.3
## 18 9.5 23.5 22.5 55.5
## 19 20.0 22.0 28.2 70.2
## 20 26.5 30.5 28.5 85.5
## 21 18.5 28.5 28.5 75.5
## 22 18.5 23.0 26.0 67.5
## 23 14.5 32.5 25.7 72.7
## 24 18.5 26.5 29.3 74.3
## 25 17.5 28.5 26.8 72.8
## 26 23.0 30.5 28.0 81.5
## 27 14.0 21.0 23.7 58.7
## 28 27.5 25.5 29.3 82.3
## 29 24.5 23.0 28.3 75.8
## 30 22.5 28.5 27.5 78.5
## 31 20.0 29.0 28.7 77.7
## 32 17.5 27.0 29.0 73.5
## 33 17.5 19.5 27.2 64.2
## 34 22.5 27.5 9.2 59.2
## 35 26.5 24.0 27.7 78.2
## 36 18.5 27.0 24.2 69.7
## 37 20.5 32.5 25.0 78.0
## 38 14.5 22.0 18.7 55.2
## 39 16.0 29.5 11.3 56.8
## 40 24.0 32.5 29.3 85.8
## 41 16.0 23.5 26.2 65.7
## 42 22.5 28.5 27.0 78.0
## 43 20.0 24.5 26.0 70.5
## 44 17.0 26.0 28.2 71.2
## 45 14.0 23.0 27.2 64.2
## 46 25.5 30.0 19.3 74.8
## 47 14.0 13.0 23.5 50.5
## 48 8.5 19.5 20.3 48.3
## 49 27.5 32.5 27.3 87.3
## 50 18.0 30.0 24.0 72.0
## 51 22.5 27.0 27.5 77.0
## 52 15.0 26.5 27.5 69.0
## 53 22.5 23.0 29.0 74.5
## 54 26.5 33.0 27.5 87.0
## 55 23.5 28.0 24.3 75.8
Pregunta 5
attach(Students) #archivo en uso
lab = rownames(Students) #etiquetas de las unidades en lab
#Regresión a mano
# definición de los datos para el modelo
n = dim(Students)[1];n # n es el número de observaciones
## [1] 55
x = Students[,1]; x # x es el caracter descriptivo
## [1] 24.5 22.5 23.5 23.5 22.5 16.0 27.5 22.5 25.0 30.0 17.5 16.5 22.5 22.5 11.5 20.0 24.0 9.5 20.0 26.5 18.5 18.5 14.5 18.5 17.5 23.0 14.0 27.5 24.5 22.5 20.0 17.5 17.5 22.5 26.5 18.5 20.5 14.5 16.0 24.0 16.0 22.5 20.0 17.0 14.0 25.5 14.0 8.5 27.5 18.0 22.5 15.0 22.5 26.5 23.5
y = Students[,2]; y # y es el caracter respuesta
## [1] 26.0 24.5 26.5 34.5 30.5 31.0 33.5 31.0 29.5 37.5 19.5 23.5 21.0 20.0 15.5 20.0 31.0 23.5 22.0 30.5 28.5 23.0 32.5 26.5 28.5 30.5 21.0 25.5 23.0 28.5 29.0 27.0 19.5 27.5 24.0 27.0 32.5 22.0 29.5 32.5 23.5 28.5 24.5 26.0 23.0 30.0 13.0 19.5 32.5 30.0 27.0 26.5 23.0 33.0 28.0
nom = colnames(Students[,1:2]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 20.31818
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 26.49091
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 23947.25
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 39922.5
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 30303
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 1241.682
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 1241.682
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] 699.4091
varx = ssxc/n; varx # varx es la varianza de x
## [1] 22.57603
vary = ssyc/n; vary # vary es la varianza de y
## [1] 24.09537
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] 12.71653
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## midterm final xy
## Mínimo 8.500000 13.000000 0.00000
## Máximo 30.000000 37.500000 0.00000
## Promedio 20.318182 26.490909 0.00000
## Total 1117.500000 1457.000000 0.00000
## Suma de cuadrados 23947.250000 39922.500000 30303.00000
## Cuadrados centrados 1241.681818 1325.245455 699.40909
## Varianza covarianza 22.576033 24.095372 12.71653
## Desvío estándar 4.751424 4.908704 0.00000
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] 0.5632756
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 15.04617
eta = ah + bh *x; eta # valores estimados
## [1] 28.84643 27.71987 28.28315 28.28315 27.71987 24.05858 30.53625 27.71987 29.12806 31.94444 24.90350 24.34022 27.71987 27.71987 21.52384 26.31169 28.56479 20.39729 26.31169 29.97298 25.46677 25.46677 23.21367 25.46677 24.90350 28.00151 22.93203 30.53625 28.84643 27.71987 26.31169 24.90350
## [33] 24.90350 27.71987 29.97298 25.46677 26.59332 23.21367 24.05858 28.56479 24.05858 27.71987 26.31169 24.62186 22.93203 29.40970 22.93203 19.83402 30.53625 25.18513 27.71987 23.49531 27.71987 29.97298 28.28315
res = y - eta; res #residuos
## [1] -2.84642530 -3.21987407 -1.78314969 6.21685031 2.78012593 6.94141743 2.96374785 3.28012593 0.37193689 5.55555881 -5.40349599 -0.84022038 -6.71987407 -7.71987407 -6.02384230 -6.31168503 2.43521251 3.10270894 -4.31168503 0.52702347 3.03322839 -2.46677161 9.28633086 1.03322839
## [25] 3.59650401 2.49848812 -1.93203134 -5.03625215 -5.84642530 0.78012593 2.68831497 2.09650401 -5.40349599 -0.21987407 -5.97297653 1.53322839 5.90667716 -1.21366914 5.44141743 3.93521251 -0.55858257 0.78012593 -1.81168503 1.37814182 0.06796866 0.59029908 -9.93203134 -0.33401545
## [49] 1.96374785 4.81486620 -0.71987407 3.00469305 -4.71987407 3.02702347 -0.28314969
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## midterm final eta residuos %res
## [1,] 24.5 26.0 28.84643 -2.84642530 -10.9477896
## [2,] 22.5 24.5 27.71987 -3.21987407 -13.1423431
## [3,] 23.5 26.5 28.28315 -1.78314969 -6.7288667
## [4,] 23.5 34.5 28.28315 6.21685031 18.0198560
## [5,] 22.5 30.5 27.71987 2.78012593 9.1151670
## [6,] 16.0 31.0 24.05858 6.94141743 22.3916691
## [7,] 27.5 33.5 30.53625 2.96374785 8.8470085
## [8,] 22.5 31.0 27.71987 3.28012593 10.5810514
## [9,] 25.0 29.5 29.12806 0.37193689 1.2608030
## [10,] 30.0 37.5 31.94444 5.55555881 14.8148235
## [11,] 17.5 19.5 24.90350 -5.40349599 -27.7102359
## [12,] 16.5 23.5 24.34022 -0.84022038 -3.5754059
## [13,] 22.5 21.0 27.71987 -6.71987407 -31.9994003
## [14,] 22.5 20.0 27.71987 -7.71987407 -38.5993704
## [15,] 11.5 15.5 21.52384 -6.02384230 -38.8634987
## [16,] 20.0 20.0 26.31169 -6.31168503 -31.5584252
## [17,] 24.0 31.0 28.56479 2.43521251 7.8555242
## [18,] 9.5 23.5 20.39729 3.10270894 13.2030167
## [19,] 20.0 22.0 26.31169 -4.31168503 -19.5985683
## [20,] 26.5 30.5 29.97298 0.52702347 1.7279458
## [21,] 18.5 28.5 25.46677 3.03322839 10.6429066
## [22,] 18.5 23.0 25.46677 -2.46677161 -10.7250939
## [23,] 14.5 32.5 23.21367 9.28633086 28.5733257
## [24,] 18.5 26.5 25.46677 1.03322839 3.8989751
## [25,] 17.5 28.5 24.90350 3.59650401 12.6193123
## [26,] 23.0 30.5 28.00151 2.49848812 8.1917643
## [27,] 14.0 21.0 22.93203 -1.93203134 -9.2001492
## [28,] 27.5 25.5 30.53625 -5.03625215 -19.7500084
## [29,] 24.5 23.0 28.84643 -5.84642530 -25.4192404
## [30,] 22.5 28.5 27.71987 0.78012593 2.7372840
## [31,] 20.0 29.0 26.31169 2.68831497 9.2700516
## [32,] 17.5 27.0 24.90350 2.09650401 7.7648297
## [33,] 17.5 19.5 24.90350 -5.40349599 -27.7102359
## [34,] 22.5 27.5 27.71987 -0.21987407 -0.7995421
## [35,] 26.5 24.0 29.97298 -5.97297653 -24.8874022
## [36,] 18.5 27.0 25.46677 1.53322839 5.6786237
## [37,] 20.5 32.5 26.59332 5.90667716 18.1743913
## [38,] 14.5 22.0 23.21367 -1.21366914 -5.5166779
## [39,] 16.0 29.5 24.05858 5.44141743 18.4454828
## [40,] 24.0 32.5 28.56479 3.93521251 12.1083462
## [41,] 16.0 23.5 24.05858 -0.55858257 -2.3769471
## [42,] 22.5 28.5 27.71987 0.78012593 2.7372840
## [43,] 20.0 24.5 26.31169 -1.81168503 -7.3946328
## [44,] 17.0 26.0 24.62186 1.37814182 5.3005454
## [45,] 14.0 23.0 22.93203 0.06796866 0.2955159
## [46,] 25.5 30.0 29.40970 0.59029908 1.9676636
## [47,] 14.0 13.0 22.93203 -9.93203134 -76.4002410
## [48,] 8.5 19.5 19.83402 -0.33401545 -1.7128997
## [49,] 27.5 32.5 30.53625 1.96374785 6.0423011
## [50,] 18.0 30.0 25.18513 4.81486620 16.0495540
## [51,] 22.5 27.0 27.71987 -0.71987407 -2.6662003
## [52,] 15.0 26.5 23.49531 3.00469305 11.3384643
## [53,] 22.5 23.0 27.71987 -4.71987407 -20.5211916
## [54,] 26.5 33.0 29.97298 3.02702347 9.1727984
## [55,] 23.5 28.0 28.28315 -0.28314969 -1.0112489
# gráfico clásico
plot(x,y,xlab="midterm",ylab="final")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topleft", # Ubicación de la leyenda en el gráfico
legend = expression(y(final) == 15.04617 + 0.5632756 * x(midterm)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 15.04617 + 0.5632756*x
# Observamos una relación positiva entre el final y midterm (dado el valor de la estimación bh = 0.5632756). Esto quiere decir que a medida que el midterm aumenta, también lo hace, final
## Gráficos de Residuos vs Estimados:
# En general gran parte de los residuos se concentran alrededor de la línea horizontal (que marca residuo cero), lo cual sugiere que las estimaciones están cercanas a los valores reales.
# Analizando el gráfico de residuos vs estimados, se observa que la muestra 23 tiene un residuo positivo grande(respecto al resto, 9.28633086), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 47 tiene un residuo negativo grande (respecto al resto,-9.93203134), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 47)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 1.265406
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 25.71075
ym # promedio de y
## [1] 26.49091
etam = mean(b0*x);etam # promedio de eta
## [1] 25.71075
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 42.90851
Se/n # desvío promedio
## [1] 0.7801547
ym - etam # diferencia de promedios
## [1] 0.7801547
etasi = b0*x #etasi
plot(x,y,xlab="midterm",ylab="final")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topleft",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
#Comentarios:
# El modelo lineal para el origen tiene una tendencia al igual que la recta de modelo lineal (linea color rojo). Sin embargo su pendiente (linea azul) es b0 = 1.265406
# Además la tener un valor de ym - etam = 0.7801547, sugiere que el modelo que pasa por el origen (linea de color azul) está subestimando a la variable de respuesta ("final") por 0.7801547 unidades
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 1.408380e-02 3.833777e-03 8.153431e-03 8.153431e-03 3.833777e-03 1.501729e-02 4.153923e-02 3.833777e-03 1.765301e-02 7.549245e-02 6.396283e-03 1.174094e-02 3.833777e-03 3.833777e-03 6.262501e-02 8.153431e-05 1.091728e-02 9.425366e-02 8.153431e-05 3.077671e-02 2.662345e-03 2.662345e-03
## [23] 2.726241e-02 2.662345e-03 6.396283e-03 5.792264e-03 3.214948e-02 4.153923e-02 1.408380e-02 3.833777e-03 8.153431e-05 6.396283e-03 6.396283e-03 3.833777e-03 3.077671e-02 2.662345e-03 2.662345e-05 2.726241e-02 1.501729e-02 1.091728e-02 1.501729e-02 3.833777e-03 8.153431e-05 8.867272e-03
## [45] 3.214948e-02 2.162490e-02 3.214948e-02 1.124841e-01 4.153923e-02 4.327974e-03 3.833777e-03 2.277802e-02 3.833777e-03 3.077671e-02 8.153431e-03
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] -0.117391304 -0.912500000 0.002857143 2.517142857 1.837500000 -1.044210526 0.975949367 2.066666667 0.642718447 1.137089202 2.480645161 0.783333333 -2.516666667 -2.975000000 1.246391753 20.400000000 1.224691358 0.276470588 14.114285714 0.648529412 -1.105000000 1.920000000
## [23] -1.032812500 -0.005000000 -0.712903226 1.494915254 0.869064748 -0.137974684 -0.834782609 0.920833333 -7.885714286 -0.180645161 2.480645161 0.462500000 -0.402941176 -0.280000000 33.050000000 0.771875000 -0.696842105 1.632098765 0.692631579 0.920833333 6.257142857 0.147945205
## [45] 0.552517986 0.677192982 2.135251799 0.591538462 0.836708861 -1.513725490 0.233333333 -0.001709402 -1.600000000 1.052941176 0.474285714
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] 0.5632756
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.0033678662 0.0017571476 0.0025625069 0.0025625069 0.0017571476 -0.0034776879 0.0057839441 0.0017571476 0.0037705458 0.0077973423 -0.0022696489 -0.0030750082 0.0017571476 0.0017571476 -0.0071018047 -0.0002562507 0.0029651865 -0.0087125233 -0.0002562507 0.0049785848 -0.0014642896
## [22] -0.0014642896 -0.0046857268 -0.0014642896 -0.0022696489 0.0021598272 -0.0050884065 0.0057839441 0.0033678662 0.0017571476 -0.0002562507 -0.0022696489 -0.0022696489 0.0017571476 0.0049785848 -0.0014642896 0.0001464290 -0.0046857268 -0.0034776879 0.0029651865 -0.0034776879 0.0017571476
## [43] -0.0002562507 -0.0026723286 -0.0050884065 0.0041732255 -0.0050884065 -0.0095178826 0.0057839441 -0.0018669693 0.0017571476 -0.0042830472 0.0017571476 0.0049785848 0.0025625069
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] 0.5632756
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
## 1 0.0322656221 0.0255298898 0.028897756 0.028897756 0.0255298898 0.0036387597 0.042369221 0.0255298898 0.033949555 0.050788886 0.008690559 0.0053226928 0.0255298898 0.0255298898 -0.0115166380 0.01711022 0.0305816891 -0.0182523703 0.01711022 0.0390013545 0.012058425 0.012058425
## 2 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 3 0.0288977560 0.0237727422 0.026335249 0.026335249 0.0237727422 0.0071164476 0.036585277 0.0237727422 0.030179009 0.042991544 0.010960208 0.0083977011 0.0237727422 0.0237727422 -0.0044148333 0.01736648 0.0276165025 -0.0095398470 0.01736648 0.0340227697 0.013522715 0.013522715
## 4 0.0288977560 0.0237727422 0.026335249 0.026335249 0.0237727422 0.0071164476 0.036585277 0.0237727422 0.030179009 0.042991544 0.010960208 0.0083977011 0.0237727422 0.0237727422 -0.0044148333 0.01736648 0.0276165025 -0.0095398470 0.01736648 0.0340227697 0.013522715 0.013522715
## 5 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 6 0.0036387597 0.0105941355 0.007116448 0.007116448 0.0105941355 0.0331991068 -0.006794304 0.0105941355 0.001899916 -0.015488524 0.027982575 0.0314602628 0.0105941355 0.0105941355 0.0488487023 0.01928836 0.0053776037 0.0558040780 0.01928836 -0.0033166160 0.024504887 0.024504887
## 7 0.0423692206 0.0308013325 0.036585277 0.036585277 0.0308013325 -0.0067943039 0.059721053 0.0308013325 0.045261193 0.074180913 0.001881612 -0.0039023319 0.0308013325 0.0308013325 -0.0328220522 0.01634147 0.0394772486 -0.0443899403 0.01634147 0.0539371088 0.007665556 0.007665556
## 8 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 9 0.0339495552 0.0264084636 0.030179009 0.030179009 0.0264084636 0.0018999158 0.045261193 0.0264084636 0.035834828 0.054687557 0.007555735 0.0037851887 0.0264084636 0.0264084636 -0.0150675404 0.01698210 0.0320642823 -0.0226086320 0.01698210 0.0414906468 0.011326280 0.011326280
## 10 0.0507888860 0.0351942014 0.042991544 0.042991544 0.0351942014 -0.0154885236 0.074180913 0.0351942014 0.054687557 0.093674269 -0.003792510 -0.0115898525 0.0351942014 0.0351942014 -0.0505765640 0.01570085 0.0468902149 -0.0661712487 0.01570085 0.0663835707 0.004004832 0.004004832
## 11 0.0086905590 0.0132298569 0.010960208 0.010960208 0.0132298569 0.0279825750 0.001881612 0.0132298569 0.007555735 -0.003792510 0.024578102 0.0268477505 0.0132298569 0.0132298569 0.0381959952 0.01890398 0.0098253835 0.0427352930 0.01890398 0.0041512611 0.022308453 0.022308453
## 12 0.0053226928 0.0114727093 0.008397701 0.008397701 0.0114727093 0.0314602628 -0.003902332 0.0114727093 0.003785189 -0.011589852 0.026847750 0.0299227587 0.0114727093 0.0114727093 0.0452977999 0.01916023 0.0068601969 0.0514478164 0.01916023 -0.0008273236 0.023772742 0.023772742
## 13 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 14 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 15 -0.0115166380 0.0026869715 -0.004414833 -0.004414833 0.0026869715 0.0488487023 -0.032822052 0.0026869715 -0.015067540 -0.050576564 0.038195995 0.0452977999 0.0026869715 0.0026869715 0.0808068236 0.02044148 -0.0079657356 0.0950104331 0.02044148 -0.0257202475 0.031094190 0.031094190
## 16 0.0171102244 0.0176227258 0.017366475 0.017366475 0.0176227258 0.0192883552 0.016341472 0.0176227258 0.016982099 0.015700846 0.018903979 0.0191602299 0.0176227258 0.0176227258 0.0204414833 0.01826335 0.0172383497 0.0209539847 0.01826335 0.0165977230 0.018647729 0.018647729
## 17 0.0305816891 0.0246513160 0.027616503 0.027616503 0.0246513160 0.0053776037 0.039477249 0.0246513160 0.032064282 0.046890215 0.009825383 0.0068601969 0.0246513160 0.0246513160 -0.0079657356 0.01723835 0.0290990958 -0.0138961087 0.01723835 0.0365120621 0.012790570 0.012790570
## 18 -0.0182523703 -0.0008273236 -0.009539847 -0.009539847 -0.0008273236 0.0558040780 -0.044389940 -0.0008273236 -0.022608632 -0.066171249 0.042735293 0.0514478164 -0.0008273236 -0.0008273236 0.0950104331 0.02095398 -0.0138961087 0.1124354797 0.02095398 -0.0356774170 0.034022770 0.034022770
## 19 0.0171102244 0.0176227258 0.017366475 0.017366475 0.0176227258 0.0192883552 0.016341472 0.0176227258 0.016982099 0.015700846 0.018903979 0.0191602299 0.0176227258 0.0176227258 0.0204414833 0.01826335 0.0172383497 0.0209539847 0.01826335 0.0165977230 0.018647729 0.018647729
## 20 0.0390013545 0.0290441849 0.034022770 0.034022770 0.0290441849 -0.0033166160 0.053937109 0.0290441849 0.041490647 0.066383571 0.004151261 -0.0008273236 0.0290441849 0.0290441849 -0.0257202475 0.01659772 0.0365120621 -0.0356774170 0.01659772 0.0489585240 0.009129846 0.009129846
## 21 0.0120584252 0.0149870044 0.013522715 0.013522715 0.0149870044 0.0245048871 0.007665556 0.0149870044 0.011326280 0.004004832 0.022308453 0.0237727422 0.0149870044 0.0149870044 0.0310941904 0.01864773 0.0127905700 0.0340227697 0.01864773 0.0091298459 0.020844163 0.020844163
## 22 0.0120584252 0.0149870044 0.013522715 0.013522715 0.0149870044 0.0245048871 0.007665556 0.0149870044 0.011326280 0.004004832 0.022308453 0.0237727422 0.0149870044 0.0149870044 0.0310941904 0.01864773 0.0127905700 0.0340227697 0.01864773 0.0091298459 0.020844163 0.020844163
## 23 -0.0014130395 0.0079584142 0.003272687 0.003272687 0.0079584142 0.0384156386 -0.015470220 0.0079584142 -0.003755903 -0.027184537 0.031387048 0.0360727752 0.0079584142 0.0079584142 0.0595014094 0.01967273 0.0009298239 0.0688728631 0.01967273 -0.0107844932 0.026701322 0.026701322
## 24 0.0120584252 0.0149870044 0.013522715 0.013522715 0.0149870044 0.0245048871 0.007665556 0.0149870044 0.011326280 0.004004832 0.022308453 0.0237727422 0.0149870044 0.0149870044 0.0310941904 0.01864773 0.0127905700 0.0340227697 0.01864773 0.0091298459 0.020844163 0.020844163
## 25 0.0086905590 0.0132298569 0.010960208 0.010960208 0.0132298569 0.0279825750 0.001881612 0.0132298569 0.007555735 -0.003792510 0.024578102 0.0268477505 0.0132298569 0.0132298569 0.0381959952 0.01890398 0.0098253835 0.0427352930 0.01890398 0.0041512611 0.022308453 0.022308453
## 26 0.0272138229 0.0228941685 0.025053996 0.025053996 0.0228941685 0.0088552916 0.033693305 0.0228941685 0.028293737 0.039092873 0.012095032 0.0099352052 0.0228941685 0.0228941685 -0.0008639309 0.01749460 0.0261339093 -0.0051835853 0.01749460 0.0315334773 0.014254860 0.014254860
## 27 -0.0030969726 0.0070798404 0.001991434 0.001991434 0.0070798404 0.0401544826 -0.018362192 0.0070798404 -0.005641176 -0.031083208 0.032521873 0.0376102793 0.0070798404 0.0070798404 0.0630523117 0.01980086 -0.0005527693 0.0732291247 0.01980086 -0.0132737856 0.027433466 0.027433466
## 28 0.0423692206 0.0308013325 0.036585277 0.036585277 0.0308013325 -0.0067943039 0.059721053 0.0308013325 0.045261193 0.074180913 0.001881612 -0.0039023319 0.0308013325 0.0308013325 -0.0328220522 0.01634147 0.0394772486 -0.0443899403 0.01634147 0.0539371088 0.007665556 0.007665556
## 29 0.0322656221 0.0255298898 0.028897756 0.028897756 0.0255298898 0.0036387597 0.042369221 0.0255298898 0.033949555 0.050788886 0.008690559 0.0053226928 0.0255298898 0.0255298898 -0.0115166380 0.01711022 0.0305816891 -0.0182523703 0.01711022 0.0390013545 0.012058425 0.012058425
## 30 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 31 0.0171102244 0.0176227258 0.017366475 0.017366475 0.0176227258 0.0192883552 0.016341472 0.0176227258 0.016982099 0.015700846 0.018903979 0.0191602299 0.0176227258 0.0176227258 0.0204414833 0.01826335 0.0172383497 0.0209539847 0.01826335 0.0165977230 0.018647729 0.018647729
## 32 0.0086905590 0.0132298569 0.010960208 0.010960208 0.0132298569 0.0279825750 0.001881612 0.0132298569 0.007555735 -0.003792510 0.024578102 0.0268477505 0.0132298569 0.0132298569 0.0381959952 0.01890398 0.0098253835 0.0427352930 0.01890398 0.0041512611 0.022308453 0.022308453
## 33 0.0086905590 0.0132298569 0.010960208 0.010960208 0.0132298569 0.0279825750 0.001881612 0.0132298569 0.007555735 -0.003792510 0.024578102 0.0268477505 0.0132298569 0.0132298569 0.0381959952 0.01890398 0.0098253835 0.0427352930 0.01890398 0.0041512611 0.022308453 0.022308453
## 34 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 35 0.0390013545 0.0290441849 0.034022770 0.034022770 0.0290441849 -0.0033166160 0.053937109 0.0290441849 0.041490647 0.066383571 0.004151261 -0.0008273236 0.0290441849 0.0290441849 -0.0257202475 0.01659772 0.0365120621 -0.0356774170 0.01659772 0.0489585240 0.009129846 0.009129846
## 36 0.0120584252 0.0149870044 0.013522715 0.013522715 0.0149870044 0.0245048871 0.007665556 0.0149870044 0.011326280 0.004004832 0.022308453 0.0237727422 0.0149870044 0.0149870044 0.0310941904 0.01864773 0.0127905700 0.0340227697 0.01864773 0.0091298459 0.020844163 0.020844163
## 37 0.0187941575 0.0185012996 0.018647729 0.018647729 0.0185012996 0.0175495113 0.019233444 0.0185012996 0.018867372 0.019599517 0.017769155 0.0176227258 0.0185012996 0.0185012996 0.0168905810 0.01813523 0.0187209430 0.0165977230 0.01813523 0.0190870154 0.017915584 0.017915584
## 38 -0.0014130395 0.0079584142 0.003272687 0.003272687 0.0079584142 0.0384156386 -0.015470220 0.0079584142 -0.003755903 -0.027184537 0.031387048 0.0360727752 0.0079584142 0.0079584142 0.0595014094 0.01967273 0.0009298239 0.0688728631 0.01967273 -0.0107844932 0.026701322 0.026701322
## 39 0.0036387597 0.0105941355 0.007116448 0.007116448 0.0105941355 0.0331991068 -0.006794304 0.0105941355 0.001899916 -0.015488524 0.027982575 0.0314602628 0.0105941355 0.0105941355 0.0488487023 0.01928836 0.0053776037 0.0558040780 0.01928836 -0.0033166160 0.024504887 0.024504887
## 40 0.0305816891 0.0246513160 0.027616503 0.027616503 0.0246513160 0.0053776037 0.039477249 0.0246513160 0.032064282 0.046890215 0.009825383 0.0068601969 0.0246513160 0.0246513160 -0.0079657356 0.01723835 0.0290990958 -0.0138961087 0.01723835 0.0365120621 0.012790570 0.012790570
## 41 0.0036387597 0.0105941355 0.007116448 0.007116448 0.0105941355 0.0331991068 -0.006794304 0.0105941355 0.001899916 -0.015488524 0.027982575 0.0314602628 0.0105941355 0.0105941355 0.0488487023 0.01928836 0.0053776037 0.0558040780 0.01928836 -0.0033166160 0.024504887 0.024504887
## 42 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 43 0.0171102244 0.0176227258 0.017366475 0.017366475 0.0176227258 0.0192883552 0.016341472 0.0176227258 0.016982099 0.015700846 0.018903979 0.0191602299 0.0176227258 0.0176227258 0.0204414833 0.01826335 0.0172383497 0.0209539847 0.01826335 0.0165977230 0.018647729 0.018647729
## 44 0.0070066259 0.0123512831 0.009678954 0.009678954 0.0123512831 0.0297214189 -0.001010360 0.0123512831 0.005670462 -0.007691181 0.025712926 0.0283852546 0.0123512831 0.0123512831 0.0417468975 0.01903210 0.0083427902 0.0470915547 0.01903210 0.0016619687 0.023040597 0.023040597
## 45 -0.0030969726 0.0070798404 0.001991434 0.001991434 0.0070798404 0.0401544826 -0.018362192 0.0070798404 -0.005641176 -0.031083208 0.032521873 0.0376102793 0.0070798404 0.0070798404 0.0630523117 0.01980086 -0.0005527693 0.0732291247 0.01980086 -0.0132737856 0.027433466 0.027433466
## 46 0.0356334883 0.0272870374 0.031460263 0.031460263 0.0272870374 0.0001610719 0.048153165 0.0272870374 0.037720101 0.058586228 0.006420910 0.0022476846 0.0272870374 0.0272870374 -0.0186184427 0.01685397 0.0335468756 -0.0269648937 0.01685397 0.0439799392 0.010594136 0.010594136
## 47 -0.0030969726 0.0070798404 0.001991434 0.001991434 0.0070798404 0.0401544826 -0.018362192 0.0070798404 -0.005641176 -0.031083208 0.032521873 0.0376102793 0.0070798404 0.0070798404 0.0630523117 0.01980086 -0.0005527693 0.0732291247 0.01980086 -0.0132737856 0.027433466 0.027433466
## 48 -0.0216202365 -0.0025844712 -0.012102354 -0.012102354 -0.0025844712 0.0592817659 -0.050173884 -0.0025844712 -0.026379178 -0.073968591 0.045004942 0.0545228246 -0.0025844712 -0.0025844712 0.1021122378 0.02121024 -0.0168612952 0.1211480031 0.02121024 -0.0406560018 0.035487059 0.035487059
## 49 0.0423692206 0.0308013325 0.036585277 0.036585277 0.0308013325 -0.0067943039 0.059721053 0.0308013325 0.045261193 0.074180913 0.001881612 -0.0039023319 0.0308013325 0.0308013325 -0.0328220522 0.01634147 0.0394772486 -0.0443899403 0.01634147 0.0539371088 0.007665556 0.007665556
## 50 0.0103744921 0.0141084306 0.012241461 0.012241461 0.0141084306 0.0262437310 0.004773584 0.0141084306 0.009441007 0.000106161 0.023443277 0.0253102464 0.0141084306 0.0141084306 0.0346450928 0.01877585 0.0113079767 0.0383790314 0.01877585 0.0066405535 0.021576308 0.021576308
## 51 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 52 0.0002708936 0.0088369880 0.004553941 0.004553941 0.0088369880 0.0366767947 -0.012578248 0.0088369880 -0.001870630 -0.023285866 0.030252224 0.0345352711 0.0088369880 0.0088369880 0.0559505070 0.01954461 0.0024124172 0.0645166014 0.01954461 -0.0082952008 0.025969177 0.025969177
## 53 0.0255298898 0.0220155947 0.023772742 0.023772742 0.0220155947 0.0105941355 0.030801333 0.0220155947 0.026408464 0.035194201 0.013229857 0.0114727093 0.0220155947 0.0220155947 0.0026869715 0.01762273 0.0246513160 -0.0008273236 0.01762273 0.0290441849 0.014987004 0.014987004
## 54 0.0390013545 0.0290441849 0.034022770 0.034022770 0.0290441849 -0.0033166160 0.053937109 0.0290441849 0.041490647 0.066383571 0.004151261 -0.0008273236 0.0290441849 0.0290441849 -0.0257202475 0.01659772 0.0365120621 -0.0356774170 0.01659772 0.0489585240 0.009129846 0.009129846
## 55 0.0288977560 0.0237727422 0.026335249 0.026335249 0.0237727422 0.0071164476 0.036585277 0.0237727422 0.030179009 0.042991544 0.010960208 0.0083977011 0.0237727422 0.0237727422 -0.0044148333 0.01736648 0.0276165025 -0.0095398470 0.01736648 0.0340227697 0.013522715 0.013522715
## 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
## 1 -0.0014130395 0.012058425 0.008690559 0.0272138229 -0.0030969726 0.042369221 0.0322656221 0.0255298898 0.01711022 0.008690559 0.008690559 0.0255298898 0.0390013545 0.012058425 0.01879416 -0.0014130395 0.0036387597 0.0305816891 0.0036387597 0.0255298898 0.01711022 0.007006626
## 2 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 3 0.0032726873 0.013522715 0.010960208 0.0250539957 0.0019914339 0.036585277 0.0288977560 0.0237727422 0.01736648 0.010960208 0.010960208 0.0237727422 0.0340227697 0.013522715 0.01864773 0.0032726873 0.0071164476 0.0276165025 0.0071164476 0.0237727422 0.01736648 0.009678954
## 4 0.0032726873 0.013522715 0.010960208 0.0250539957 0.0019914339 0.036585277 0.0288977560 0.0237727422 0.01736648 0.010960208 0.010960208 0.0237727422 0.0340227697 0.013522715 0.01864773 0.0032726873 0.0071164476 0.0276165025 0.0071164476 0.0237727422 0.01736648 0.009678954
## 5 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 6 0.0384156386 0.024504887 0.027982575 0.0088552916 0.0401544826 -0.006794304 0.0036387597 0.0105941355 0.01928836 0.027982575 0.027982575 0.0105941355 -0.0033166160 0.024504887 0.01754951 0.0384156386 0.0331991068 0.0053776037 0.0331991068 0.0105941355 0.01928836 0.029721419
## 7 -0.0154702200 0.007665556 0.001881612 0.0336933045 -0.0183621920 0.059721053 0.0423692206 0.0308013325 0.01634147 0.001881612 0.001881612 0.0308013325 0.0539371088 0.007665556 0.01923344 -0.0154702200 -0.0067943039 0.0394772486 -0.0067943039 0.0308013325 0.01634147 -0.001010360
## 8 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 9 -0.0037559029 0.011326280 0.007555735 0.0282937365 -0.0056411758 0.045261193 0.0339495552 0.0264084636 0.01698210 0.007555735 0.007555735 0.0264084636 0.0414906468 0.011326280 0.01886737 -0.0037559029 0.0018999158 0.0320642823 0.0018999158 0.0264084636 0.01698210 0.005670462
## 10 -0.0271845371 0.004004832 -0.003792510 0.0390928726 -0.0310832083 0.074180913 0.0507888860 0.0351942014 0.01570085 -0.003792510 -0.003792510 0.0351942014 0.0663835707 0.004004832 0.01959952 -0.0271845371 -0.0154885236 0.0468902149 -0.0154885236 0.0351942014 0.01570085 -0.007691181
## 11 0.0313870484 0.022308453 0.024578102 0.0120950324 0.0325218728 0.001881612 0.0086905590 0.0132298569 0.01890398 0.024578102 0.024578102 0.0132298569 0.0041512611 0.022308453 0.01776915 0.0313870484 0.0279825750 0.0098253835 0.0279825750 0.0132298569 0.01890398 0.025712926
## 12 0.0360727752 0.023772742 0.026847750 0.0099352052 0.0376102793 -0.003902332 0.0053226928 0.0114727093 0.01916023 0.026847750 0.026847750 0.0114727093 -0.0008273236 0.023772742 0.01762273 0.0360727752 0.0314602628 0.0068601969 0.0314602628 0.0114727093 0.01916023 0.028385255
## 13 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 14 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 15 0.0595014094 0.031094190 0.038195995 -0.0008639309 0.0630523117 -0.032822052 -0.0115166380 0.0026869715 0.02044148 0.038195995 0.038195995 0.0026869715 -0.0257202475 0.031094190 0.01689058 0.0595014094 0.0488487023 -0.0079657356 0.0488487023 0.0026869715 0.02044148 0.041746898
## 16 0.0196727313 0.018647729 0.018903979 0.0174946004 0.0198008566 0.016341472 0.0171102244 0.0176227258 0.01826335 0.018903979 0.018903979 0.0176227258 0.0165977230 0.018647729 0.01813523 0.0196727313 0.0192883552 0.0172383497 0.0192883552 0.0176227258 0.01826335 0.019032105
## 17 0.0009298239 0.012790570 0.009825383 0.0261339093 -0.0005527693 0.039477249 0.0305816891 0.0246513160 0.01723835 0.009825383 0.009825383 0.0246513160 0.0365120621 0.012790570 0.01872094 0.0009298239 0.0053776037 0.0290990958 0.0053776037 0.0246513160 0.01723835 0.008342790
## 18 0.0688728631 0.034022770 0.042735293 -0.0051835853 0.0732291247 -0.044389940 -0.0182523703 -0.0008273236 0.02095398 0.042735293 0.042735293 -0.0008273236 -0.0356774170 0.034022770 0.01659772 0.0688728631 0.0558040780 -0.0138961087 0.0558040780 -0.0008273236 0.02095398 0.047091555
## 19 0.0196727313 0.018647729 0.018903979 0.0174946004 0.0198008566 0.016341472 0.0171102244 0.0176227258 0.01826335 0.018903979 0.018903979 0.0176227258 0.0165977230 0.018647729 0.01813523 0.0196727313 0.0192883552 0.0172383497 0.0192883552 0.0176227258 0.01826335 0.019032105
## 20 -0.0107844932 0.009129846 0.004151261 0.0315334773 -0.0132737856 0.053937109 0.0390013545 0.0290441849 0.01659772 0.004151261 0.004151261 0.0290441849 0.0489585240 0.009129846 0.01908702 -0.0107844932 -0.0033166160 0.0365120621 -0.0033166160 0.0290441849 0.01659772 0.001661969
## 21 0.0267013215 0.020844163 0.022308453 0.0142548596 0.0274334663 0.007665556 0.0120584252 0.0149870044 0.01864773 0.022308453 0.022308453 0.0149870044 0.0091298459 0.020844163 0.01791558 0.0267013215 0.0245048871 0.0127905700 0.0245048871 0.0149870044 0.01864773 0.023040597
## 22 0.0267013215 0.020844163 0.022308453 0.0142548596 0.0274334663 0.007665556 0.0120584252 0.0149870044 0.01864773 0.022308453 0.022308453 0.0149870044 0.0091298459 0.020844163 0.01791558 0.0267013215 0.0245048871 0.0127905700 0.0245048871 0.0149870044 0.01864773 0.023040597
## 23 0.0454442289 0.026701322 0.031387048 0.0056155508 0.0477870923 -0.015470220 -0.0014130395 0.0079584142 0.01967273 0.031387048 0.031387048 0.0079584142 -0.0107844932 0.026701322 0.01732987 0.0454442289 0.0384156386 0.0009298239 0.0384156386 0.0079584142 0.01967273 0.033729912
## 24 0.0267013215 0.020844163 0.022308453 0.0142548596 0.0274334663 0.007665556 0.0120584252 0.0149870044 0.01864773 0.022308453 0.022308453 0.0149870044 0.0091298459 0.020844163 0.01791558 0.0267013215 0.0245048871 0.0127905700 0.0245048871 0.0149870044 0.01864773 0.023040597
## 25 0.0313870484 0.022308453 0.024578102 0.0120950324 0.0325218728 0.001881612 0.0086905590 0.0132298569 0.01890398 0.024578102 0.024578102 0.0132298569 0.0041512611 0.022308453 0.01776915 0.0313870484 0.0279825750 0.0098253835 0.0279825750 0.0132298569 0.01890398 0.025712926
## 26 0.0056155508 0.014254860 0.012095032 0.0239740821 0.0045356371 0.033693305 0.0272138229 0.0228941685 0.01749460 0.012095032 0.012095032 0.0228941685 0.0315334773 0.014254860 0.01857451 0.0056155508 0.0088552916 0.0261339093 0.0088552916 0.0228941685 0.01749460 0.011015119
## 27 0.0477870923 0.027433466 0.032521873 0.0045356371 0.0503312955 -0.018362192 -0.0030969726 0.0070798404 0.01980086 0.032521873 0.032521873 0.0070798404 -0.0132737856 0.027433466 0.01725665 0.0477870923 0.0401544826 -0.0005527693 0.0401544826 0.0070798404 0.01980086 0.035066076
## 28 -0.0154702200 0.007665556 0.001881612 0.0336933045 -0.0183621920 0.059721053 0.0423692206 0.0308013325 0.01634147 0.001881612 0.001881612 0.0308013325 0.0539371088 0.007665556 0.01923344 -0.0154702200 -0.0067943039 0.0394772486 -0.0067943039 0.0308013325 0.01634147 -0.001010360
## 29 -0.0014130395 0.012058425 0.008690559 0.0272138229 -0.0030969726 0.042369221 0.0322656221 0.0255298898 0.01711022 0.008690559 0.008690559 0.0255298898 0.0390013545 0.012058425 0.01879416 -0.0014130395 0.0036387597 0.0305816891 0.0036387597 0.0255298898 0.01711022 0.007006626
## 30 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 31 0.0196727313 0.018647729 0.018903979 0.0174946004 0.0198008566 0.016341472 0.0171102244 0.0176227258 0.01826335 0.018903979 0.018903979 0.0176227258 0.0165977230 0.018647729 0.01813523 0.0196727313 0.0192883552 0.0172383497 0.0192883552 0.0176227258 0.01826335 0.019032105
## 32 0.0313870484 0.022308453 0.024578102 0.0120950324 0.0325218728 0.001881612 0.0086905590 0.0132298569 0.01890398 0.024578102 0.024578102 0.0132298569 0.0041512611 0.022308453 0.01776915 0.0313870484 0.0279825750 0.0098253835 0.0279825750 0.0132298569 0.01890398 0.025712926
## 33 0.0313870484 0.022308453 0.024578102 0.0120950324 0.0325218728 0.001881612 0.0086905590 0.0132298569 0.01890398 0.024578102 0.024578102 0.0132298569 0.0041512611 0.022308453 0.01776915 0.0313870484 0.0279825750 0.0098253835 0.0279825750 0.0132298569 0.01890398 0.025712926
## 34 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 35 -0.0107844932 0.009129846 0.004151261 0.0315334773 -0.0132737856 0.053937109 0.0390013545 0.0290441849 0.01659772 0.004151261 0.004151261 0.0290441849 0.0489585240 0.009129846 0.01908702 -0.0107844932 -0.0033166160 0.0365120621 -0.0033166160 0.0290441849 0.01659772 0.001661969
## 36 0.0267013215 0.020844163 0.022308453 0.0142548596 0.0274334663 0.007665556 0.0120584252 0.0149870044 0.01864773 0.022308453 0.022308453 0.0149870044 0.0091298459 0.020844163 0.01791558 0.0267013215 0.0245048871 0.0127905700 0.0245048871 0.0149870044 0.01864773 0.023040597
## 37 0.0173298678 0.017915584 0.017769155 0.0185745140 0.0172566534 0.019233444 0.0187941575 0.0185012996 0.01813523 0.017769155 0.017769155 0.0185012996 0.0190870154 0.017915584 0.01820844 0.0173298678 0.0175495113 0.0187209430 0.0175495113 0.0185012996 0.01813523 0.017695940
## 38 0.0454442289 0.026701322 0.031387048 0.0056155508 0.0477870923 -0.015470220 -0.0014130395 0.0079584142 0.01967273 0.031387048 0.031387048 0.0079584142 -0.0107844932 0.026701322 0.01732987 0.0454442289 0.0384156386 0.0009298239 0.0384156386 0.0079584142 0.01967273 0.033729912
## 39 0.0384156386 0.024504887 0.027982575 0.0088552916 0.0401544826 -0.006794304 0.0036387597 0.0105941355 0.01928836 0.027982575 0.027982575 0.0105941355 -0.0033166160 0.024504887 0.01754951 0.0384156386 0.0331991068 0.0053776037 0.0331991068 0.0105941355 0.01928836 0.029721419
## 40 0.0009298239 0.012790570 0.009825383 0.0261339093 -0.0005527693 0.039477249 0.0305816891 0.0246513160 0.01723835 0.009825383 0.009825383 0.0246513160 0.0365120621 0.012790570 0.01872094 0.0009298239 0.0053776037 0.0290990958 0.0053776037 0.0246513160 0.01723835 0.008342790
## 41 0.0384156386 0.024504887 0.027982575 0.0088552916 0.0401544826 -0.006794304 0.0036387597 0.0105941355 0.01928836 0.027982575 0.027982575 0.0105941355 -0.0033166160 0.024504887 0.01754951 0.0384156386 0.0331991068 0.0053776037 0.0331991068 0.0105941355 0.01928836 0.029721419
## 42 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 43 0.0196727313 0.018647729 0.018903979 0.0174946004 0.0198008566 0.016341472 0.0171102244 0.0176227258 0.01826335 0.018903979 0.018903979 0.0176227258 0.0165977230 0.018647729 0.01813523 0.0196727313 0.0192883552 0.0172383497 0.0192883552 0.0176227258 0.01826335 0.019032105
## 44 0.0337299118 0.023040597 0.025712926 0.0110151188 0.0350660761 -0.001010360 0.0070066259 0.0123512831 0.01903210 0.025712926 0.025712926 0.0123512831 0.0016619687 0.023040597 0.01769594 0.0337299118 0.0297214189 0.0083427902 0.0297214189 0.0123512831 0.01903210 0.027049090
## 45 0.0477870923 0.027433466 0.032521873 0.0045356371 0.0503312955 -0.018362192 -0.0030969726 0.0070798404 0.01980086 0.032521873 0.032521873 0.0070798404 -0.0132737856 0.027433466 0.01725665 0.0477870923 0.0401544826 -0.0005527693 0.0401544826 0.0070798404 0.01980086 0.035066076
## 46 -0.0060987663 0.010594136 0.006420910 0.0293736501 -0.0081853791 0.048153165 0.0356334883 0.0272870374 0.01685397 0.006420910 0.006420910 0.0272870374 0.0439799392 0.010594136 0.01894059 -0.0060987663 0.0001610719 0.0335468756 0.0001610719 0.0272870374 0.01685397 0.004334297
## 47 0.0477870923 0.027433466 0.032521873 0.0045356371 0.0503312955 -0.018362192 -0.0030969726 0.0070798404 0.01980086 0.032521873 0.032521873 0.0070798404 -0.0132737856 0.027433466 0.01725665 0.0477870923 0.0401544826 -0.0005527693 0.0401544826 0.0070798404 0.01980086 0.035066076
## 48 0.0735585899 0.035487059 0.045004942 -0.0073434125 0.0783175312 -0.050173884 -0.0216202365 -0.0025844712 0.02121024 0.045004942 0.045004942 -0.0025844712 -0.0406560018 0.035487059 0.01645129 0.0735585899 0.0592817659 -0.0168612952 0.0592817659 -0.0025844712 0.02121024 0.049763883
## 49 -0.0154702200 0.007665556 0.001881612 0.0336933045 -0.0183621920 0.059721053 0.0423692206 0.0308013325 0.01634147 0.001881612 0.001881612 0.0308013325 0.0539371088 0.007665556 0.01923344 -0.0154702200 -0.0067943039 0.0394772486 -0.0067943039 0.0308013325 0.01634147 -0.001010360
## 50 0.0290441849 0.021576308 0.023443277 0.0131749460 0.0299776696 0.004773584 0.0103744921 0.0141084306 0.01877585 0.023443277 0.023443277 0.0141084306 0.0066405535 0.021576308 0.01784237 0.0290441849 0.0262437310 0.0113079767 0.0262437310 0.0141084306 0.01877585 0.024376762
## 51 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 52 0.0431013655 0.025969177 0.030252224 0.0066954644 0.0452428890 -0.012578248 0.0002708936 0.0088369880 0.01954461 0.030252224 0.030252224 0.0088369880 -0.0082952008 0.025969177 0.01740308 0.0431013655 0.0366767947 0.0024124172 0.0366767947 0.0088369880 0.01954461 0.032393747
## 53 0.0079584142 0.014987004 0.013229857 0.0228941685 0.0070798404 0.030801333 0.0255298898 0.0220155947 0.01762273 0.013229857 0.013229857 0.0220155947 0.0290441849 0.014987004 0.01850130 0.0079584142 0.0105941355 0.0246513160 0.0105941355 0.0220155947 0.01762273 0.012351283
## 54 -0.0107844932 0.009129846 0.004151261 0.0315334773 -0.0132737856 0.053937109 0.0390013545 0.0290441849 0.01659772 0.004151261 0.004151261 0.0290441849 0.0489585240 0.009129846 0.01908702 -0.0107844932 -0.0033166160 0.0365120621 -0.0033166160 0.0290441849 0.01659772 0.001661969
## 55 0.0032726873 0.013522715 0.010960208 0.0250539957 0.0019914339 0.036585277 0.0288977560 0.0237727422 0.01736648 0.010960208 0.010960208 0.0237727422 0.0340227697 0.013522715 0.01864773 0.0032726873 0.0071164476 0.0276165025 0.0071164476 0.0237727422 0.01736648 0.009678954
## 45 46 47 48 49 50 51 52 53 54 55
## 1 -0.0030969726 0.0356334883 -0.0030969726 -0.021620236 0.042369221 0.010374492 0.0255298898 0.0002708936 0.0255298898 0.0390013545 0.028897756
## 2 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 3 0.0019914339 0.0314602628 0.0019914339 -0.012102354 0.036585277 0.012241461 0.0237727422 0.0045539408 0.0237727422 0.0340227697 0.026335249
## 4 0.0019914339 0.0314602628 0.0019914339 -0.012102354 0.036585277 0.012241461 0.0237727422 0.0045539408 0.0237727422 0.0340227697 0.026335249
## 5 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 6 0.0401544826 0.0001610719 0.0401544826 0.059281766 -0.006794304 0.026243731 0.0105941355 0.0366767947 0.0105941355 -0.0033166160 0.007116448
## 7 -0.0183621920 0.0481531647 -0.0183621920 -0.050173884 0.059721053 0.004773584 0.0308013325 -0.0125782480 0.0308013325 0.0539371088 0.036585277
## 8 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 9 -0.0056411758 0.0377201010 -0.0056411758 -0.026379178 0.045261193 0.009441007 0.0264084636 -0.0018706300 0.0264084636 0.0414906468 0.030179009
## 10 -0.0310832083 0.0585862284 -0.0310832083 -0.073968591 0.074180913 0.000106161 0.0351942014 -0.0232858659 0.0351942014 0.0663835707 0.042991544
## 11 0.0325218728 0.0064209101 0.0325218728 0.045004942 0.001881612 0.023443277 0.0132298569 0.0302522239 0.0132298569 0.0041512611 0.010960208
## 12 0.0376102793 0.0022476846 0.0376102793 0.054522825 -0.003902332 0.025310246 0.0114727093 0.0345352711 0.0114727093 -0.0008273236 0.008397701
## 13 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 14 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 15 0.0630523117 -0.0186184427 0.0630523117 0.102112238 -0.032822052 0.034645093 0.0026869715 0.0559505070 0.0026869715 -0.0257202475 -0.004414833
## 16 0.0198008566 0.0168539737 0.0198008566 0.021210235 0.016341472 0.018775854 0.0176227258 0.0195446059 0.0176227258 0.0165977230 0.017366475
## 17 -0.0005527693 0.0335468756 -0.0005527693 -0.016861295 0.039477249 0.011307977 0.0246513160 0.0024124172 0.0246513160 0.0365120621 0.027616503
## 18 0.0732291247 -0.0269648937 0.0732291247 0.121148003 -0.044389940 0.038379031 -0.0008273236 0.0645166014 -0.0008273236 -0.0356774170 -0.009539847
## 19 0.0198008566 0.0168539737 0.0198008566 0.021210235 0.016341472 0.018775854 0.0176227258 0.0195446059 0.0176227258 0.0165977230 0.017366475
## 20 -0.0132737856 0.0439799392 -0.0132737856 -0.040656002 0.053937109 0.006640554 0.0290441849 -0.0082952008 0.0290441849 0.0489585240 0.034022770
## 21 0.0274334663 0.0105941355 0.0274334663 0.035487059 0.007665556 0.021576308 0.0149870044 0.0259691767 0.0149870044 0.0091298459 0.013522715
## 22 0.0274334663 0.0105941355 0.0274334663 0.035487059 0.007665556 0.021576308 0.0149870044 0.0259691767 0.0149870044 0.0091298459 0.013522715
## 23 0.0477870923 -0.0060987663 0.0477870923 0.073558590 -0.015470220 0.029044185 0.0079584142 0.0431013655 0.0079584142 -0.0107844932 0.003272687
## 24 0.0274334663 0.0105941355 0.0274334663 0.035487059 0.007665556 0.021576308 0.0149870044 0.0259691767 0.0149870044 0.0091298459 0.013522715
## 25 0.0325218728 0.0064209101 0.0325218728 0.045004942 0.001881612 0.023443277 0.0132298569 0.0302522239 0.0132298569 0.0041512611 0.010960208
## 26 0.0045356371 0.0293736501 0.0045356371 -0.007343413 0.033693305 0.013174946 0.0228941685 0.0066954644 0.0228941685 0.0315334773 0.025053996
## 27 0.0503312955 -0.0081853791 0.0503312955 0.078317531 -0.018362192 0.029977670 0.0070798404 0.0452428890 0.0070798404 -0.0132737856 0.001991434
## 28 -0.0183621920 0.0481531647 -0.0183621920 -0.050173884 0.059721053 0.004773584 0.0308013325 -0.0125782480 0.0308013325 0.0539371088 0.036585277
## 29 -0.0030969726 0.0356334883 -0.0030969726 -0.021620236 0.042369221 0.010374492 0.0255298898 0.0002708936 0.0255298898 0.0390013545 0.028897756
## 30 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 31 0.0198008566 0.0168539737 0.0198008566 0.021210235 0.016341472 0.018775854 0.0176227258 0.0195446059 0.0176227258 0.0165977230 0.017366475
## 32 0.0325218728 0.0064209101 0.0325218728 0.045004942 0.001881612 0.023443277 0.0132298569 0.0302522239 0.0132298569 0.0041512611 0.010960208
## 33 0.0325218728 0.0064209101 0.0325218728 0.045004942 0.001881612 0.023443277 0.0132298569 0.0302522239 0.0132298569 0.0041512611 0.010960208
## 34 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 35 -0.0132737856 0.0439799392 -0.0132737856 -0.040656002 0.053937109 0.006640554 0.0290441849 -0.0082952008 0.0290441849 0.0489585240 0.034022770
## 36 0.0274334663 0.0105941355 0.0274334663 0.035487059 0.007665556 0.021576308 0.0149870044 0.0259691767 0.0149870044 0.0091298459 0.013522715
## 37 0.0172566534 0.0189405864 0.0172566534 0.016451294 0.019233444 0.017842369 0.0185012996 0.0174030823 0.0185012996 0.0190870154 0.018647729
## 38 0.0477870923 -0.0060987663 0.0477870923 0.073558590 -0.015470220 0.029044185 0.0079584142 0.0431013655 0.0079584142 -0.0107844932 0.003272687
## 39 0.0401544826 0.0001610719 0.0401544826 0.059281766 -0.006794304 0.026243731 0.0105941355 0.0366767947 0.0105941355 -0.0033166160 0.007116448
## 40 -0.0005527693 0.0335468756 -0.0005527693 -0.016861295 0.039477249 0.011307977 0.0246513160 0.0024124172 0.0246513160 0.0365120621 0.027616503
## 41 0.0401544826 0.0001610719 0.0401544826 0.059281766 -0.006794304 0.026243731 0.0105941355 0.0366767947 0.0105941355 -0.0033166160 0.007116448
## 42 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 43 0.0198008566 0.0168539737 0.0198008566 0.021210235 0.016341472 0.018775854 0.0176227258 0.0195446059 0.0176227258 0.0165977230 0.017366475
## 44 0.0350660761 0.0043342973 0.0350660761 0.049763883 -0.001010360 0.024376762 0.0123512831 0.0323937475 0.0123512831 0.0016619687 0.009678954
## 45 0.0503312955 -0.0081853791 0.0503312955 0.078317531 -0.018362192 0.029977670 0.0070798404 0.0452428890 0.0070798404 -0.0132737856 0.001991434
## 46 -0.0081853791 0.0398067138 -0.0081853791 -0.031138119 0.048153165 0.008507523 0.0272870374 -0.0040121536 0.0272870374 0.0439799392 0.031460263
## 47 0.0503312955 -0.0081853791 0.0503312955 0.078317531 -0.018362192 0.029977670 0.0070798404 0.0452428890 0.0070798404 -0.0132737856 0.001991434
## 48 0.0783175312 -0.0311381191 0.0783175312 0.130665886 -0.050173884 0.040246001 -0.0025844712 0.0687996486 -0.0025844712 -0.0406560018 -0.012102354
## 49 -0.0183621920 0.0481531647 -0.0183621920 -0.050173884 0.059721053 0.004773584 0.0308013325 -0.0125782480 0.0308013325 0.0539371088 0.036585277
## 50 0.0299776696 0.0085075228 0.0299776696 0.040246001 0.004773584 0.022509792 0.0141084306 0.0281107003 0.0141084306 0.0066405535 0.012241461
## 51 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 52 0.0452428890 -0.0040121536 0.0452428890 0.068799649 -0.012578248 0.028110700 0.0088369880 0.0409598419 0.0088369880 -0.0082952008 0.004553941
## 53 0.0070798404 0.0272870374 0.0070798404 -0.002584471 0.030801333 0.014108431 0.0220155947 0.0088369880 0.0220155947 0.0290441849 0.023772742
## 54 -0.0132737856 0.0439799392 -0.0132737856 -0.040656002 0.053937109 0.006640554 0.0290441849 -0.0082952008 0.0290441849 0.0489585240 0.034022770
## 55 0.0019914339 0.0314602628 0.0019914339 -0.012102354 0.036585277 0.012241461 0.0237727422 0.0045539408 0.0237727422 0.0340227697 0.026335249
sum(Hs) # Hs es centrada
## [1] 55
lev <- diag(Hs); lev # apalancamientos
## 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
## 0.03226562 0.02201559 0.02633525 0.02633525 0.02201559 0.03319911 0.05972105 0.02201559 0.03583483 0.09367427 0.02457810 0.02992276 0.02201559 0.02201559 0.08080682 0.01826335 0.02909910 0.11243548 0.01826335 0.04895852 0.02084416 0.02084416 0.04544423 0.02084416 0.02457810 0.02397408 0.05033130
## 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
## 0.05972105 0.03226562 0.02201559 0.01826335 0.02457810 0.02457810 0.02201559 0.04895852 0.02084416 0.01820844 0.04544423 0.03319911 0.02909910 0.03319911 0.02201559 0.01826335 0.02704909 0.05033130 0.03980671 0.05033130 0.13066589 0.05972105 0.02250979 0.02201559 0.04095984 0.02201559 0.04895852
## 55
## 0.02633525
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 24.5 1.408380e-02 -0.117391304 26.0 0.0033678662 0.03226562
## 2 22.5 3.833777e-03 -0.912500000 24.5 0.0017571476 0.02201559
## 3 23.5 8.153431e-03 0.002857143 26.5 0.0025625069 0.02633525
## 4 23.5 8.153431e-03 2.517142857 34.5 0.0025625069 0.02633525
## 5 22.5 3.833777e-03 1.837500000 30.5 0.0017571476 0.02201559
## 6 16.0 1.501729e-02 -1.044210526 31.0 -0.0034776879 0.03319911
## 7 27.5 4.153923e-02 0.975949367 33.5 0.0057839441 0.05972105
## 8 22.5 3.833777e-03 2.066666667 31.0 0.0017571476 0.02201559
## 9 25.0 1.765301e-02 0.642718447 29.5 0.0037705458 0.03583483
## 10 30.0 7.549245e-02 1.137089202 37.5 0.0077973423 0.09367427
## 11 17.5 6.396283e-03 2.480645161 19.5 -0.0022696489 0.02457810
## 12 16.5 1.174094e-02 0.783333333 23.5 -0.0030750082 0.02992276
## 13 22.5 3.833777e-03 -2.516666667 21.0 0.0017571476 0.02201559
## 14 22.5 3.833777e-03 -2.975000000 20.0 0.0017571476 0.02201559
## 15 11.5 6.262501e-02 1.246391753 15.5 -0.0071018047 0.08080682
## 16 20.0 8.153431e-05 20.400000000 20.0 -0.0002562507 0.01826335
## 17 24.0 1.091728e-02 1.224691358 31.0 0.0029651865 0.02909910
## 18 9.5 9.425366e-02 0.276470588 23.5 -0.0087125233 0.11243548
## 19 20.0 8.153431e-05 14.114285714 22.0 -0.0002562507 0.01826335
## 20 26.5 3.077671e-02 0.648529412 30.5 0.0049785848 0.04895852
## 21 18.5 2.662345e-03 -1.105000000 28.5 -0.0014642896 0.02084416
## 22 18.5 2.662345e-03 1.920000000 23.0 -0.0014642896 0.02084416
## 23 14.5 2.726241e-02 -1.032812500 32.5 -0.0046857268 0.04544423
## 24 18.5 2.662345e-03 -0.005000000 26.5 -0.0014642896 0.02084416
## 25 17.5 6.396283e-03 -0.712903226 28.5 -0.0022696489 0.02457810
## 26 23.0 5.792264e-03 1.494915254 30.5 0.0021598272 0.02397408
## 27 14.0 3.214948e-02 0.869064748 21.0 -0.0050884065 0.05033130
## 28 27.5 4.153923e-02 -0.137974684 25.5 0.0057839441 0.05972105
## 29 24.5 1.408380e-02 -0.834782609 23.0 0.0033678662 0.03226562
## 30 22.5 3.833777e-03 0.920833333 28.5 0.0017571476 0.02201559
## 31 20.0 8.153431e-05 -7.885714286 29.0 -0.0002562507 0.01826335
## 32 17.5 6.396283e-03 -0.180645161 27.0 -0.0022696489 0.02457810
## 33 17.5 6.396283e-03 2.480645161 19.5 -0.0022696489 0.02457810
## 34 22.5 3.833777e-03 0.462500000 27.5 0.0017571476 0.02201559
## 35 26.5 3.077671e-02 -0.402941176 24.0 0.0049785848 0.04895852
## 36 18.5 2.662345e-03 -0.280000000 27.0 -0.0014642896 0.02084416
## 37 20.5 2.662345e-05 33.050000000 32.5 0.0001464290 0.01820844
## 38 14.5 2.726241e-02 0.771875000 22.0 -0.0046857268 0.04544423
## 39 16.0 1.501729e-02 -0.696842105 29.5 -0.0034776879 0.03319911
## 40 24.0 1.091728e-02 1.632098765 32.5 0.0029651865 0.02909910
## 41 16.0 1.501729e-02 0.692631579 23.5 -0.0034776879 0.03319911
## 42 22.5 3.833777e-03 0.920833333 28.5 0.0017571476 0.02201559
## 43 20.0 8.153431e-05 6.257142857 24.5 -0.0002562507 0.01826335
## 44 17.0 8.867272e-03 0.147945205 26.0 -0.0026723286 0.02704909
## 45 14.0 3.214948e-02 0.552517986 23.0 -0.0050884065 0.05033130
## 46 25.5 2.162490e-02 0.677192982 30.0 0.0041732255 0.03980671
## 47 14.0 3.214948e-02 2.135251799 13.0 -0.0050884065 0.05033130
## 48 8.5 1.124841e-01 0.591538462 19.5 -0.0095178826 0.13066589
## 49 27.5 4.153923e-02 0.836708861 32.5 0.0057839441 0.05972105
## 50 18.0 4.327974e-03 -1.513725490 30.0 -0.0018669693 0.02250979
## 51 22.5 3.833777e-03 0.233333333 27.0 0.0017571476 0.02201559
## 52 15.0 2.277802e-02 -0.001709402 26.5 -0.0042830472 0.04095984
## 53 22.5 3.833777e-03 -1.600000000 23.0 0.0017571476 0.02201559
## 54 26.5 3.077671e-02 1.052941176 33.0 0.0049785848 0.04895852
## 55 23.5 8.153431e-03 0.474285714 28.0 0.0025625069 0.02633525
# la muestra 48 tiene un mayor peso y también posee el mayor apalancamiento, por tanto se evaluará el retiro de esta muestra
# Además se evaluará el retiro de la observación 47, ya que visualmente, podría representar un valor extremos y ser influyente. Además de tener un valor absoluto del residuo alto.
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra menos la 48
# lm3: todas las muestras menos la número 47
lm1=lm(final~midterm,data=Students); lm1
##
## Call:
## lm(formula = final ~ midterm, data = Students)
##
## Coefficients:
## (Intercept) midterm
## 15.0462 0.5633
lm2=lm(final~midterm,data=Students[c(1:47,49:55),]); lm2
##
## Call:
## lm(formula = final ~ midterm, data = Students[c(1:47, 49:55),
## ])
##
## Coefficients:
## (Intercept) midterm
## 15.1275 0.5596
lm3=lm(final~midterm, data=Students[c(1:46,48:55),]);lm3
##
## Call:
## lm(formula = final ~ midterm, data = Students[c(1:46, 48:55),
## ])
##
## Coefficients:
## (Intercept) midterm
## 16.3176 0.5101
plot(midterm,final)
text(midterm,final,labels = lab)
abline(lm1,col="red") # recta con todas las muestras
abline(lm2,col="blue") # recta sin muestra 48
abline(lm3,col="green") # recta sin muestra 47
# Agregar leyenda
legend("topleft",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 48", "lm3: Modelo sin muestra 47"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Comentarios:
# Al eliminar de la regresión la muestra 47 muestra cambios respecto a los coeficientes, especialmente en el intercepto,lo que hace indicar que de acuerdo al análisis previo es porque se le considero como un valor extremo dado su valor residual. Haciendo que tenga una influencia en el modelo
# Las rectas lm1 y lm2 son ligeramente parecidas, lo que podría hacernos pensar que la eliminación de la muestra 47 no afectaba el ajuste del modelo de manera sustancial.
Linnerrud.csv
Pregunta 1,2,3,4
# Lectura de los datos
Linnerud <- read.csv("Linnerud.csv", row.names = 1);Linnerud
## Weight Waist Pulse Pulls Squats Jumps
## 1 191 36 50 5 162 60
## 2 189 37 52 2 110 60
## 3 193 38 58 12 101 101
## 4 162 35 62 12 105 37
## 5 189 35 46 13 155 58
## 6 182 36 56 4 101 42
## 7 211 38 56 8 101 38
## 8 167 34 60 6 125 40
## 9 176 31 74 15 200 40
## 10 154 33 56 17 251 250
## 11 169 34 50 17 120 38
## 12 166 33 52 13 210 115
## 13 154 34 64 14 215 105
## 14 247 46 50 1 50 50
## 15 193 36 46 6 70 31
## 16 202 37 62 12 210 120
## 17 176 37 54 4 60 25
## 18 157 32 52 11 230 80
## 19 156 33 54 15 225 73
## 20 138 33 68 2 110 43
Pregunta 5
attach(Linnerud) #archivo en uso
lab = rownames(Linnerud) #etiquetas de las unidades en lab
i) Pulls y Weight
#Regresión a mano
# definición de los datos para el modelo
# Pulls y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,1]; x # x es el caracter descriptivo
## [1] 191 189 193 162 189 182 211 167 176 154 169 166 154 247 193 202 176 157 156 138
y = Linnerud[,4]; y # y es el caracter respuesta
## [1] 5 2 12 12 13 4 8 6 15 17 17 13 14 1 6 12 4 11 15 2
nom = colnames(Linnerud[c(1,4)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 178.6
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 9.45
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 649542
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 2317
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 32789
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -966.4
varx = ssxc/n; varx # varx es la varianza de x
## [1] 579.14
vary = ssyc/n; vary # vary es la varianza de y
## [1] 26.5475
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -48.32
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## Weight Pulls xy
## Mínimo 138.00000 1.000000 0.00
## Máximo 247.00000 17.000000 0.00
## Promedio 178.60000 9.450000 0.00
## Total 3572.00000 189.000000 0.00
## Suma de cuadrados 649542.00000 2317.000000 32789.00
## Cuadrados centrados 11582.80000 530.950000 -966.40
## Varianza covarianza 579.14000 26.547500 -48.32
## Desvío estándar 24.06533 5.152427 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -0.08343406
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 24.35132
eta = ah + bh *x; eta # valores estimados
## [1] 8.415418 8.582286 8.248550 10.835005 8.582286 9.166324 6.746737 10.417835 9.666929 11.502478 10.250967 10.501269 11.502478 3.743110 8.248550 7.497643 9.666929 11.252176 11.335610 12.837423
res = y - eta; res #residuos
## [1] -3.4154177 -6.5822858 3.7514504 1.1649946 4.4177142 -5.1663242 1.2532635 -4.4178351 5.3330715 5.4975222 6.7490330 2.4987309 2.4975222 -2.7431105 -2.2485496 4.5023569 -5.6669285 -0.2521756 3.6643903 -10.8374227
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Weight Pulls eta residuos %res
## [1,] 191 5 8.415418 -3.4154177 -68.308354
## [2,] 189 2 8.582286 -6.5822858 -329.114290
## [3,] 193 12 8.248550 3.7514504 31.262087
## [4,] 162 12 10.835005 1.1649946 9.708289
## [5,] 189 13 8.582286 4.4177142 33.982417
## [6,] 182 4 9.166324 -5.1663242 -129.158105
## [7,] 211 8 6.746737 1.2532635 15.665793
## [8,] 167 6 10.417835 -4.4178351 -73.630584
## [9,] 176 15 9.666929 5.3330715 35.553810
## [10,] 154 17 11.502478 5.4975222 32.338366
## [11,] 169 17 10.250967 6.7490330 39.700194
## [12,] 166 13 10.501269 2.4987309 19.221007
## [13,] 154 14 11.502478 2.4975222 17.839444
## [14,] 247 1 3.743110 -2.7431105 -274.311047
## [15,] 193 6 8.248550 -2.2485496 -37.475826
## [16,] 202 12 7.497643 4.5023569 37.519641
## [17,] 176 4 9.666929 -5.6669285 -141.673214
## [18,] 157 11 11.252176 -0.2521756 -2.292506
## [19,] 156 15 11.335610 3.6643903 24.429269
## [20,] 138 2 12.837423 -10.8374227 -541.871137
# gráfico clásico
plot(x,y,xlab="Weight",ylab="Pulls")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Pulls) == 24.35132 -0.08343406 * x(Weight)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 24.35132 -0.08343406*x
# Observamos una relación inversa entre el Weight y Pulls (dado el valor de la estimación bh = -0.08343406). Esto quiere decir que a medida que el Weight aumenta, la variable Pulls disminuye. Lo que sugiere que sería más difícil realizar un número elevado de Pulls debido al incrementeo del esfuerzo requerido.
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos, lo que indica que el modelo no está sesgado
# Se observa que la muestra 11 tiene un residuo positivo grande(respecto al resto, 6.7490330), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 20 tiene un residuo negativo grande (respecto al resto,-10.8374227), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 20)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 0.05048018
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 9.015761
ym # promedio de y
## [1] 9.45
etam = mean(b0*x);etam # promedio de eta
## [1] 9.015761
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 8.684781
Se/n # desvío promedio
## [1] 0.434239
ym - etam # diferencia de promedios
## [1] 0.434239
etasi = b0*x #etasi
plot(x,y,xlab="Weight",ylab="Pulls")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 0.05048018) es inusual dada la naturaleza de los datos. Ya que se espera de los Pulls no incrementen con el Weight.
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0132748558 0.0093379839 0.0179024070 0.0237904479 0.0093379839 0.0009980316 0.0906309355 0.0116172255 0.0005836240 0.0522464344 0.0079566253 0.0137065304 0.0522464344 0.4039230583 0.0179024070 0.0472735435 0.0005836240 0.0402804158 0.0440964188 0.1423110129
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] -0.35887097 -0.71634615 0.17708333 -0.15361446 0.34134615 -1.60294118 -0.04475309 0.29741379 -2.13461538 -0.30691057 -0.78645833 -0.28174603 -0.18495935 -0.12353801 -0.23958333 0.10897436 2.09615385 -0.07175926 -0.24557522 0.18349754
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -0.08343406
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.0010705529 0.0008978831 0.0012432227 -0.0014331595 0.0008978831 0.0002935387 0.0027972511 -0.0010014850 -0.0002244708 -0.0021238388 -0.0008288151 -0.0010878199 -0.0021238388 0.0059053079 0.0012432227 0.0020202369 -0.0002244708 -0.0018648341 -0.0019511690 -0.0035051974
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -0.08343406
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.063274856 0.06113375 0.065415962 0.032228822 0.06113375 0.05363988 0.084685914 0.03758159 0.04721656 0.0236643989 0.039722692 0.03651103 0.0236643989 0.123225818 0.065415962 0.0750509376 0.04721656 0.026876058 0.025805505 0.006535553
## 2 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 3 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 4 0.032228822 0.03509514 0.029362503 0.073790448 0.03509514 0.04512726 0.003565632 0.06662465 0.05372621 0.0852557240 0.063758331 0.06805781 0.0852557240 -0.048028111 0.029362503 0.0164640674 0.05372621 0.080956245 0.082389405 0.108186276
## 5 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 6 0.053639880 0.05305280 0.054226957 0.045127258 0.05305280 0.05099803 0.059510654 0.04659495 0.04923680 0.0427789481 0.047182029 0.04630141 0.0427789481 0.070078047 0.054226957 0.0568688055 0.04923680 0.043659564 0.043366025 0.038082329
## 7 0.084685914 0.07909141 0.090280416 0.003565632 0.07909141 0.05951065 0.140630936 0.01755189 0.04272715 -0.0188123770 0.023146389 0.01475464 -0.0188123770 0.241331975 0.090280416 0.1154556757 0.04272715 -0.010420624 -0.013217875 -0.063568395
## 8 0.037581586 0.03958456 0.035578617 0.066624650 0.03958456 0.04659495 0.017551887 0.06161723 0.05260386 0.0746365300 0.059614256 0.06261871 0.0746365300 -0.018501571 0.035578617 0.0265652519 0.05260386 0.071632075 0.072633560 0.090660289
## 9 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 10 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 11 0.039722692 0.04138032 0.038065062 0.063758331 0.04138032 0.04718203 0.023146389 0.05961426 0.05215492 0.0703888524 0.057956625 0.06044307 0.0703888524 -0.006690956 0.038065062 0.0306057257 0.05215492 0.067902407 0.068731222 0.083649895
## 12 0.036511034 0.03868667 0.034335394 0.068057810 0.03868667 0.04630141 0.014754636 0.06261871 0.05282833 0.0767603688 0.060443071 0.06370653 0.0767603688 -0.024406879 0.034335394 0.0245450150 0.05282833 0.073496909 0.074584729 0.094165487
## 13 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 14 0.123225818 0.11141520 0.135036433 -0.048028111 0.11141520 0.07007805 0.241331975 -0.01850157 0.03464620 -0.0952705736 -0.006690956 -0.02440688 -0.0952705736 0.453923058 0.135036433 0.1881842042 0.03464620 -0.077554650 -0.083459958 -0.189755500
## 15 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 16 0.075050938 0.07101046 0.079091411 0.016464067 0.07101046 0.05686881 0.115455676 0.02656525 0.04474738 0.0003021722 0.030605726 0.02454502 0.0003021722 0.188184204 0.079091411 0.0972735435 0.04474738 0.006362883 0.004342646 -0.032021618
## 17 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 18 0.026876058 0.03060573 0.023146389 0.080956245 0.03060573 0.04365956 -0.010420624 0.07163208 0.05484857 0.0958749180 0.067902407 0.07349691 0.0958749180 -0.077554650 0.023146389 0.0063628829 0.05484857 0.090280416 0.092145250 0.125712263
## 19 0.025805505 0.02970784 0.021903167 0.082389405 0.02970784 0.04336603 -0.013217875 0.07263356 0.05507304 0.0979987568 0.068731222 0.07458473 0.0979987568 -0.083459958 0.021903167 0.0043426460 0.05507304 0.092145250 0.094096419 0.129217460
## 20 0.006535553 0.01354595 -0.000474842 0.108186276 0.01354595 0.03808233 -0.063568395 0.09066029 0.05911351 0.1362278551 0.083649895 0.09416549 0.1362278551 -0.189755500 -0.000474842 -0.0320216183 0.05911351 0.125712263 0.129217460 0.192311013
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.06327486 0.05933798 0.06790241 0.07379045 0.05933798 0.05099803 0.14063094 0.06161723 0.05058362 0.10224643 0.05795663 0.06370653 0.10224643 0.45392306 0.06790241 0.09727354 0.05058362 0.09028042 0.09409642 0.19231101
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 191 0.0132748558 -0.35887097 5 0.0010705529 0.06327486
## 2 189 0.0093379839 -0.71634615 2 0.0008978831 0.05933798
## 3 193 0.0179024070 0.17708333 12 0.0012432227 0.06790241
## 4 162 0.0237904479 -0.15361446 12 -0.0014331595 0.07379045
## 5 189 0.0093379839 0.34134615 13 0.0008978831 0.05933798
## 6 182 0.0009980316 -1.60294118 4 0.0002935387 0.05099803
## 7 211 0.0906309355 -0.04475309 8 0.0027972511 0.14063094
## 8 167 0.0116172255 0.29741379 6 -0.0010014850 0.06161723
## 9 176 0.0005836240 -2.13461538 15 -0.0002244708 0.05058362
## 10 154 0.0522464344 -0.30691057 17 -0.0021238388 0.10224643
## 11 169 0.0079566253 -0.78645833 17 -0.0008288151 0.05795663
## 12 166 0.0137065304 -0.28174603 13 -0.0010878199 0.06370653
## 13 154 0.0522464344 -0.18495935 14 -0.0021238388 0.10224643
## 14 247 0.4039230583 -0.12353801 1 0.0059053079 0.45392306
## 15 193 0.0179024070 -0.23958333 6 0.0012432227 0.06790241
## 16 202 0.0472735435 0.10897436 12 0.0020202369 0.09727354
## 17 176 0.0005836240 2.09615385 4 -0.0002244708 0.05058362
## 18 157 0.0402804158 -0.07175926 11 -0.0018648341 0.09028042
## 19 156 0.0440964188 -0.24557522 15 -0.0019511690 0.09409642
## 20 138 0.1423110129 0.18349754 2 -0.0035051974 0.19231101
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 20 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra sin la 14
# lm3: todas las muestras sin la 20
lm1=lm(Pulls~Weight,data=Linnerud); lm1
##
## Call:
## lm(formula = Pulls ~ Weight, data = Linnerud)
##
## Coefficients:
## (Intercept) Weight
## 24.35132 -0.08343
lm2=lm(Pulls~Weight,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Pulls ~ Weight, data = Linnerud[c(1:13, 15:20),
## ])
##
## Coefficients:
## (Intercept) Weight
## 19.30447 -0.05377
lm3=lm(Pulls~Weight, data=Linnerud[c(1:19),]);lm3
##
## Call:
## lm(formula = Pulls ~ Weight, data = Linnerud[c(1:19), ])
##
## Coefficients:
## (Intercept) Weight
## 33.4221 -0.1305
plot(Weight,Pulls)
text(Weight,Pulls,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 20
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 20"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Comentarios:
# Modelo lm2(color azul): La exclusión de la muestra 14 ha resultado en un intercepto más bajo y una pendiente menos negativa en comparación a lm1, lo que justifica que en realidad su tuvo un peso y apalancamiento que impactaba en el modelo.
# modelo lm3(color verde): la pendiente es más negativa respecto a lm1, lo que indica una relación más fuerte entre el Pulls y Weight despues de eliminar la muestra 20
ii)Squats y Weight
#Regresión a mano
# definición de los datos para el modelo
# Squats y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,1]; x # x es el caracter descriptivo
## [1] 191 189 193 162 189 182 211 167 176 154 169 166 154 247 193 202 176 157 156 138
y = Linnerud[,5]; y # y es el caracter respuesta
## [1] 162 110 101 105 155 101 101 125 200 251 120 210 215 50 70 210 60 230 225 110
nom = colnames(Linnerud[c(1,5)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 178.6
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 145.55
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 649542
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 498073
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 505432
ssxc = ssx - n*(xm^2); ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
ssyc = ssy - n*(ym^2); ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -14472.6
varx = ssxc/n; varx # varx es la varianza de x
## [1] 579.14
vary = ssyc/n; vary # vary es la varianza de y
## [1] 3718.847
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -723.63
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## Weight Squats xy
## Mínimo 138.00000 50.00000 0.00
## Máximo 247.00000 251.00000 0.00
## Promedio 178.60000 145.55000 0.00
## Total 3572.00000 2911.00000 0.00
## Suma de cuadrados 649542.00000 498073.00000 505432.00
## Cuadrados centrados 11582.80000 74376.95000 -14472.60
## Varianza covarianza 579.14000 3718.84750 -723.63
## Desvío estándar 24.06533 60.98235 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -1.249491
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 368.709
eta = ah + bh *x; eta # valores estimados
## [1] 130.05632 132.55530 127.55734 166.29154 132.55530 141.30173 105.06650 160.04409 148.79868 176.28747 157.54511 161.29358 176.28747 60.08484 127.55734 116.31192 148.79868 172.53900 173.78849 196.27932
res = y - eta; res #residuos
## [1] 31.943684 -22.555298 -26.557335 -61.291544 22.444702 -40.301732 -4.066504 -35.044091 51.201324 74.712531 -37.545110 48.706418 38.712531 -10.084841 -57.557335 93.688081 -88.798676 57.461003 51.211512 -86.279319
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Weight Squats eta residuos %res
## [1,] 191 162 130.05632 31.943684 19.718323
## [2,] 189 110 132.55530 -22.555298 -20.504816
## [3,] 193 101 127.55734 -26.557335 -26.294391
## [4,] 162 105 166.29154 -61.291544 -58.372899
## [5,] 189 155 132.55530 22.444702 14.480453
## [6,] 182 101 141.30173 -40.301732 -39.902705
## [7,] 211 101 105.06650 -4.066504 -4.026241
## [8,] 167 125 160.04409 -35.044091 -28.035273
## [9,] 176 200 148.79868 51.201324 25.600662
## [10,] 154 251 176.28747 74.712531 29.765948
## [11,] 169 120 157.54511 -37.545110 -31.287592
## [12,] 166 210 161.29358 48.706418 23.193532
## [13,] 154 215 176.28747 38.712531 18.005828
## [14,] 247 50 60.08484 -10.084841 -20.169683
## [15,] 193 70 127.55734 -57.557335 -82.224764
## [16,] 202 210 116.31192 93.688081 44.613372
## [17,] 176 60 148.79868 -88.798676 -147.997793
## [18,] 157 230 172.53900 57.461003 24.983045
## [19,] 156 225 173.78849 51.211512 22.760672
## [20,] 138 110 196.27932 -86.279319 -78.435745
# gráfico clásico
plot(x,y,xlab="Weight",ylab="Squats")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Squats) == 368.709 -1.249491 * x(Weight)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 2368.709 -1.249491*x
# Observamos que la pendiente de la línea es negativa, lo que indica una relación inversa entre Weight y Squats. Esto quiere decir que a medida que el Weight aumenta, la variable Squats disminuye.Lo que indica que a medida que aumenta el Weight, la capacidad de realizar Squats disminuye.
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos. Sin embargo, hay puntos que están relativamente lejos de dicha recta, lo que indica errores más grandes en la predicción del modelo
# Se observa que la muestra 16 tiene un residuo positivo grande(respecto al resto, 93.688081), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 17 tiene un residuo negativo grande (respecto al resto,-86.279319), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 16)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 0.778136
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 138.9751
ym # promedio de y
## [1] 145.55
etam = mean(b0*x);etam # promedio de eta
## [1] 138.9751
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 131.4983
Se/n # desvío promedio
## [1] 6.574914
ym - etam # diferencia de promedios
## [1] 6.574914
etasi = b0*x #etasi
plot(x,y,xlab="Weight",ylab="Squats")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 0.778136) es inusual dada la naturaleza de los datos. Ya que se espera de los Squats no incrementen con el Weight.
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0132748558 0.0093379839 0.0179024070 0.0237904479 0.0093379839 0.0009980316 0.0906309355 0.0116172255 0.0005836240 0.0522464344 0.0079566253 0.0137065304 0.0522464344 0.4039230583 0.0179024070 0.0472735435 0.0005836240 0.0402804158 0.0440964188 0.1423110129
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] 1.3266129 -3.4182692 -3.0937500 2.4427711 0.9086538 -13.1029412 -1.3750000 1.7715517 -20.9423077 -4.2865854 2.6614583 -5.1150794 -2.8231707 -1.3969298 -5.2465278 2.7542735 32.9038462 -3.9097222 -3.5154867 0.8756158
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -1.249491
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.0010705529 0.0008978831 0.0012432227 -0.0014331595 0.0008978831 0.0002935387 0.0027972511 -0.0010014850 -0.0002244708 -0.0021238388 -0.0008288151 -0.0010878199 -0.0021238388 0.0059053079 0.0012432227 0.0020202369 -0.0002244708 -0.0018648341 -0.0019511690 -0.0035051974
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -1.249491
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.063274856 0.06113375 0.065415962 0.032228822 0.06113375 0.05363988 0.084685914 0.03758159 0.04721656 0.0236643989 0.039722692 0.03651103 0.0236643989 0.123225818 0.065415962 0.0750509376 0.04721656 0.026876058 0.025805505 0.006535553
## 2 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 3 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 4 0.032228822 0.03509514 0.029362503 0.073790448 0.03509514 0.04512726 0.003565632 0.06662465 0.05372621 0.0852557240 0.063758331 0.06805781 0.0852557240 -0.048028111 0.029362503 0.0164640674 0.05372621 0.080956245 0.082389405 0.108186276
## 5 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 6 0.053639880 0.05305280 0.054226957 0.045127258 0.05305280 0.05099803 0.059510654 0.04659495 0.04923680 0.0427789481 0.047182029 0.04630141 0.0427789481 0.070078047 0.054226957 0.0568688055 0.04923680 0.043659564 0.043366025 0.038082329
## 7 0.084685914 0.07909141 0.090280416 0.003565632 0.07909141 0.05951065 0.140630936 0.01755189 0.04272715 -0.0188123770 0.023146389 0.01475464 -0.0188123770 0.241331975 0.090280416 0.1154556757 0.04272715 -0.010420624 -0.013217875 -0.063568395
## 8 0.037581586 0.03958456 0.035578617 0.066624650 0.03958456 0.04659495 0.017551887 0.06161723 0.05260386 0.0746365300 0.059614256 0.06261871 0.0746365300 -0.018501571 0.035578617 0.0265652519 0.05260386 0.071632075 0.072633560 0.090660289
## 9 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 10 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 11 0.039722692 0.04138032 0.038065062 0.063758331 0.04138032 0.04718203 0.023146389 0.05961426 0.05215492 0.0703888524 0.057956625 0.06044307 0.0703888524 -0.006690956 0.038065062 0.0306057257 0.05215492 0.067902407 0.068731222 0.083649895
## 12 0.036511034 0.03868667 0.034335394 0.068057810 0.03868667 0.04630141 0.014754636 0.06261871 0.05282833 0.0767603688 0.060443071 0.06370653 0.0767603688 -0.024406879 0.034335394 0.0245450150 0.05282833 0.073496909 0.074584729 0.094165487
## 13 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 14 0.123225818 0.11141520 0.135036433 -0.048028111 0.11141520 0.07007805 0.241331975 -0.01850157 0.03464620 -0.0952705736 -0.006690956 -0.02440688 -0.0952705736 0.453923058 0.135036433 0.1881842042 0.03464620 -0.077554650 -0.083459958 -0.189755500
## 15 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 16 0.075050938 0.07101046 0.079091411 0.016464067 0.07101046 0.05686881 0.115455676 0.02656525 0.04474738 0.0003021722 0.030605726 0.02454502 0.0003021722 0.188184204 0.079091411 0.0972735435 0.04474738 0.006362883 0.004342646 -0.032021618
## 17 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 18 0.026876058 0.03060573 0.023146389 0.080956245 0.03060573 0.04365956 -0.010420624 0.07163208 0.05484857 0.0958749180 0.067902407 0.07349691 0.0958749180 -0.077554650 0.023146389 0.0063628829 0.05484857 0.090280416 0.092145250 0.125712263
## 19 0.025805505 0.02970784 0.021903167 0.082389405 0.02970784 0.04336603 -0.013217875 0.07263356 0.05507304 0.0979987568 0.068731222 0.07458473 0.0979987568 -0.083459958 0.021903167 0.0043426460 0.05507304 0.092145250 0.094096419 0.129217460
## 20 0.006535553 0.01354595 -0.000474842 0.108186276 0.01354595 0.03808233 -0.063568395 0.09066029 0.05911351 0.1362278551 0.083649895 0.09416549 0.1362278551 -0.189755500 -0.000474842 -0.0320216183 0.05911351 0.125712263 0.129217460 0.192311013
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.06327486 0.05933798 0.06790241 0.07379045 0.05933798 0.05099803 0.14063094 0.06161723 0.05058362 0.10224643 0.05795663 0.06370653 0.10224643 0.45392306 0.06790241 0.09727354 0.05058362 0.09028042 0.09409642 0.19231101
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 191 0.0132748558 1.3266129 162 0.0010705529 0.06327486
## 2 189 0.0093379839 -3.4182692 110 0.0008978831 0.05933798
## 3 193 0.0179024070 -3.0937500 101 0.0012432227 0.06790241
## 4 162 0.0237904479 2.4427711 105 -0.0014331595 0.07379045
## 5 189 0.0093379839 0.9086538 155 0.0008978831 0.05933798
## 6 182 0.0009980316 -13.1029412 101 0.0002935387 0.05099803
## 7 211 0.0906309355 -1.3750000 101 0.0027972511 0.14063094
## 8 167 0.0116172255 1.7715517 125 -0.0010014850 0.06161723
## 9 176 0.0005836240 -20.9423077 200 -0.0002244708 0.05058362
## 10 154 0.0522464344 -4.2865854 251 -0.0021238388 0.10224643
## 11 169 0.0079566253 2.6614583 120 -0.0008288151 0.05795663
## 12 166 0.0137065304 -5.1150794 210 -0.0010878199 0.06370653
## 13 154 0.0522464344 -2.8231707 215 -0.0021238388 0.10224643
## 14 247 0.4039230583 -1.3969298 50 0.0059053079 0.45392306
## 15 193 0.0179024070 -5.2465278 70 0.0012432227 0.06790241
## 16 202 0.0472735435 2.7542735 210 0.0020202369 0.09727354
## 17 176 0.0005836240 32.9038462 60 -0.0002244708 0.05058362
## 18 157 0.0402804158 -3.9097222 230 -0.0018648341 0.09028042
## 19 156 0.0440964188 -3.5154867 225 -0.0019511690 0.09409642
## 20 138 0.1423110129 0.8756158 110 -0.0035051974 0.19231101
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 16 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra sin la 14
# lm3: todas las muestras número sin la 16
lm1=lm(Squats~Weight,data=Linnerud); lm1
##
## Call:
## lm(formula = Squats ~ Weight, data = Linnerud)
##
## Coefficients:
## (Intercept) Weight
## 368.709 -1.249
lm2=lm(Squats~Weight,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Squats ~ Weight, data = Linnerud[c(1:13, 15:20),
## ])
##
## Coefficients:
## (Intercept) Weight
## 350.15 -1.14
lm3=lm(Squats~Weight, data=Linnerud[c(1:15,17:20),]);lm3
##
## Call:
## lm(formula = Squats ~ Weight, data = Linnerud[c(1:15, 17:20),
## ])
##
## Coefficients:
## (Intercept) Weight
## 400.966 -1.459
plot(Weight,Squats)
text(Weight,Squats,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 16
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 16"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Modelo lm2 (linea color azul): Esto resultó en un intercepto ligeramente más bajo y una pendiente también más baja respecto a lm1 (-1.14 en comparación con -1.249), indicando que sin la muestra 14, se predice una relación ligeramente menos pronunciada entre el peso y el número de sentadillas. La muestra 14, por lo tanto, estaba ejerciendo una influencia en el modelo original, haciendo que la pendiente fuera más empinada.
# Modelo lm3 (Línea Verde): Excluye la muestra número 16, eliminada por tener un residuo alto. La exclusión de esta muestra aumentó el intercepto a 400.966 y la pendiente a -1.459.Lo que indica que al excluir la muestra 16, el efecto del peso en la disminución del número de sentadillas es más grande.
iii)Jumps y Weight
#Regresión a mano
# definición de los datos para el modelo
# Squats y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,1]; x # x es el caracter descriptivo
## [1] 191 189 193 162 189 182 211 167 176 154 169 166 154 247 193 202 176 157 156 138
y = Linnerud[,6]; y # y es el caracter respuesta
## [1] 60 60 101 37 58 42 38 40 40 250 38 115 105 50 31 120 25 80 73 43
nom = colnames(Linnerud[c(1,6)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 178.6
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 70.3
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 649542
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 148800
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 245668
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 11582.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -5443.6
varx = ssxc/n; varx # varx es la varianza de x
## [1] 579.14
vary = ssyc/n; vary # vary es la varianza de y
## [1] 2497.91
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -272.18
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats
## Weight Jumps xy
## Mínimo 138.00000 25.0000 0.00
## Máximo 247.00000 250.0000 0.00
## Promedio 178.60000 70.3000 0.00
## Total 3572.00000 1406.0000 0.00
## Suma de cuadrados 649542.00000 148800.0000 245668.00
## Cuadrados centrados 11582.80000 49958.2000 -5443.60
## Varianza covarianza 579.14000 2497.9100 -272.18
## Desvío estándar 24.06533 49.9791 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -0.4699727
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 154.2371
eta = ah + bh *x; eta # valores estimados
## [1] 64.47234 65.41228 63.53239 78.10155 65.41228 68.70209 55.07288 75.75168 71.52193 81.86133 74.81174 76.22166 81.86133 38.15387 63.53239 59.30264 71.52193 80.45141 80.92138 89.38089
res = y - eta; res #residuos
## [1] -4.4723383 -5.4122837 37.4676071 -41.1015471 -7.4122837 -26.7020928 -17.0728839 -35.7516835 -31.5219291 168.1386711 -36.8117381 38.7783438 23.1386711 11.8461339 -32.5323929 60.6973616 -46.5219291 -0.4514107 -7.9213834 -46.3808924
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Weight Jumps eta residuos %res
## [1,] 191 60 64.47234 -4.4723383 -7.4538972
## [2,] 189 60 65.41228 -5.4122837 -9.0204729
## [3,] 193 101 63.53239 37.4676071 37.0966407
## [4,] 162 37 78.10155 -41.1015471 -111.0852625
## [5,] 189 58 65.41228 -7.4122837 -12.7797995
## [6,] 182 42 68.70209 -26.7020928 -63.5764113
## [7,] 211 38 55.07288 -17.0728839 -44.9286419
## [8,] 167 40 75.75168 -35.7516835 -89.3792088
## [9,] 176 40 71.52193 -31.5219291 -78.8048227
## [10,] 154 250 81.86133 168.1386711 67.2554685
## [11,] 169 38 74.81174 -36.8117381 -96.8729950
## [12,] 166 115 76.22166 38.7783438 33.7202989
## [13,] 154 105 81.86133 23.1386711 22.0368297
## [14,] 247 50 38.15387 11.8461339 23.6922678
## [15,] 193 31 63.53239 -32.5323929 -104.9432028
## [16,] 202 120 59.30264 60.6973616 50.5811347
## [17,] 176 25 71.52193 -46.5219291 -186.0877163
## [18,] 157 80 80.45141 -0.4514107 -0.5642634
## [19,] 156 73 80.92138 -7.9213834 -10.8512102
## [20,] 138 43 89.38089 -46.3808924 -107.8625404
# gráfico clásico
plot(x,y,xlab="Weight",ylab="Jumps")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Jumps) == 154.2371 -0.4699727 * x(Weight)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 154.2371 -0.4699727*x
# Observamos que la pendiente de la línea es negativa, lo que indica una relación inversa entre Weight y Jumps Esto quiere decir que a medida que el Weight aumenta, la variable Jumps disminuye.Lo que indica que a medida que aumenta el Weight, la capacidad de realizar Jumps disminuye.
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos. Sin embargo, el rango de los residuos es bastante amplio, lo que podría afectar la predicción
# Se observa que la muestra 10 tiene un residuo positivo grande(respecto al resto, 168.1386711), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 17 tiene un residuo negativo grande (respecto al resto,-46.5219291), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 10)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 0.3782173
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 67.5496
ym # promedio de y
## [1] 70.3
etam = mean(b0*x);etam # promedio de eta
## [1] 67.5496
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 55.00792
Se/n # desvío promedio
## [1] 2.750396
ym - etam # diferencia de promedios
## [1] 2.750396
etasi = b0*x #etasi
plot(x,y,xlab="Jumps",ylab="Weight")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 0.3782173) es inusual dada la naturaleza de los datos. Ya que se espera de los Jumps no incrementen con el Weight.
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0132748558 0.0093379839 0.0179024070 0.0237904479 0.0093379839 0.0009980316 0.0906309355 0.0116172255 0.0005836240 0.0522464344 0.0079566253 0.0137065304 0.0522464344 0.4039230583 0.0179024070 0.0472735435 0.0005836240 0.0402804158 0.0440964188 0.1423110129
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] -0.8306452 -0.9903846 2.1319444 2.0060241 -1.1826923 -8.3235294 -0.9969136 2.6120690 11.6538462 -7.3048780 3.3645833 -3.5476190 -1.4105691 -0.2967836 -2.7291667 2.1239316 17.4230769 -0.4490741 -0.1194690 0.6724138
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -0.4699727
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.0010705529 0.0008978831 0.0012432227 -0.0014331595 0.0008978831 0.0002935387 0.0027972511 -0.0010014850 -0.0002244708 -0.0021238388 -0.0008288151 -0.0010878199 -0.0021238388 0.0059053079 0.0012432227 0.0020202369 -0.0002244708 -0.0018648341 -0.0019511690 -0.0035051974
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -0.4699727
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.063274856 0.06113375 0.065415962 0.032228822 0.06113375 0.05363988 0.084685914 0.03758159 0.04721656 0.0236643989 0.039722692 0.03651103 0.0236643989 0.123225818 0.065415962 0.0750509376 0.04721656 0.026876058 0.025805505 0.006535553
## 2 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 3 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 4 0.032228822 0.03509514 0.029362503 0.073790448 0.03509514 0.04512726 0.003565632 0.06662465 0.05372621 0.0852557240 0.063758331 0.06805781 0.0852557240 -0.048028111 0.029362503 0.0164640674 0.05372621 0.080956245 0.082389405 0.108186276
## 5 0.061133750 0.05933798 0.062929516 0.035095141 0.05933798 0.05305280 0.079091411 0.03958456 0.04766550 0.0279120765 0.041380323 0.03868667 0.0279120765 0.111415202 0.062929516 0.0710104638 0.04766550 0.030605726 0.029707843 0.013545947
## 6 0.053639880 0.05305280 0.054226957 0.045127258 0.05305280 0.05099803 0.059510654 0.04659495 0.04923680 0.0427789481 0.047182029 0.04630141 0.0427789481 0.070078047 0.054226957 0.0568688055 0.04923680 0.043659564 0.043366025 0.038082329
## 7 0.084685914 0.07909141 0.090280416 0.003565632 0.07909141 0.05951065 0.140630936 0.01755189 0.04272715 -0.0188123770 0.023146389 0.01475464 -0.0188123770 0.241331975 0.090280416 0.1154556757 0.04272715 -0.010420624 -0.013217875 -0.063568395
## 8 0.037581586 0.03958456 0.035578617 0.066624650 0.03958456 0.04659495 0.017551887 0.06161723 0.05260386 0.0746365300 0.059614256 0.06261871 0.0746365300 -0.018501571 0.035578617 0.0265652519 0.05260386 0.071632075 0.072633560 0.090660289
## 9 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 10 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 11 0.039722692 0.04138032 0.038065062 0.063758331 0.04138032 0.04718203 0.023146389 0.05961426 0.05215492 0.0703888524 0.057956625 0.06044307 0.0703888524 -0.006690956 0.038065062 0.0306057257 0.05215492 0.067902407 0.068731222 0.083649895
## 12 0.036511034 0.03868667 0.034335394 0.068057810 0.03868667 0.04630141 0.014754636 0.06261871 0.05282833 0.0767603688 0.060443071 0.06370653 0.0767603688 -0.024406879 0.034335394 0.0245450150 0.05282833 0.073496909 0.074584729 0.094165487
## 13 0.023664399 0.02791208 0.019416721 0.085255724 0.02791208 0.04277895 -0.018812377 0.07463653 0.05552198 0.1022464344 0.070388852 0.07676037 0.1022464344 -0.095270574 0.019416721 0.0003021722 0.05552198 0.095874918 0.097998757 0.136227855
## 14 0.123225818 0.11141520 0.135036433 -0.048028111 0.11141520 0.07007805 0.241331975 -0.01850157 0.03464620 -0.0952705736 -0.006690956 -0.02440688 -0.0952705736 0.453923058 0.135036433 0.1881842042 0.03464620 -0.077554650 -0.083459958 -0.189755500
## 15 0.065415962 0.06292952 0.067902407 0.029362503 0.06292952 0.05422696 0.090280416 0.03557862 0.04676762 0.0194167213 0.038065062 0.03433539 0.0194167213 0.135036433 0.067902407 0.0790914114 0.04676762 0.023146389 0.021903167 -0.000474842
## 16 0.075050938 0.07101046 0.079091411 0.016464067 0.07101046 0.05686881 0.115455676 0.02656525 0.04474738 0.0003021722 0.030605726 0.02454502 0.0003021722 0.188184204 0.079091411 0.0972735435 0.04474738 0.006362883 0.004342646 -0.032021618
## 17 0.047216562 0.04766550 0.046767621 0.053726215 0.04766550 0.04923680 0.042727147 0.05260386 0.05058362 0.0555219809 0.052154919 0.05282833 0.0555219809 0.034646200 0.046767621 0.0447473841 0.05058362 0.054848569 0.055073039 0.059113513
## 18 0.026876058 0.03060573 0.023146389 0.080956245 0.03060573 0.04365956 -0.010420624 0.07163208 0.05484857 0.0958749180 0.067902407 0.07349691 0.0958749180 -0.077554650 0.023146389 0.0063628829 0.05484857 0.090280416 0.092145250 0.125712263
## 19 0.025805505 0.02970784 0.021903167 0.082389405 0.02970784 0.04336603 -0.013217875 0.07263356 0.05507304 0.0979987568 0.068731222 0.07458473 0.0979987568 -0.083459958 0.021903167 0.0043426460 0.05507304 0.092145250 0.094096419 0.129217460
## 20 0.006535553 0.01354595 -0.000474842 0.108186276 0.01354595 0.03808233 -0.063568395 0.09066029 0.05911351 0.1362278551 0.083649895 0.09416549 0.1362278551 -0.189755500 -0.000474842 -0.0320216183 0.05911351 0.125712263 0.129217460 0.192311013
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.06327486 0.05933798 0.06790241 0.07379045 0.05933798 0.05099803 0.14063094 0.06161723 0.05058362 0.10224643 0.05795663 0.06370653 0.10224643 0.45392306 0.06790241 0.09727354 0.05058362 0.09028042 0.09409642 0.19231101
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 191 0.0132748558 -0.8306452 60 0.0010705529 0.06327486
## 2 189 0.0093379839 -0.9903846 60 0.0008978831 0.05933798
## 3 193 0.0179024070 2.1319444 101 0.0012432227 0.06790241
## 4 162 0.0237904479 2.0060241 37 -0.0014331595 0.07379045
## 5 189 0.0093379839 -1.1826923 58 0.0008978831 0.05933798
## 6 182 0.0009980316 -8.3235294 42 0.0002935387 0.05099803
## 7 211 0.0906309355 -0.9969136 38 0.0027972511 0.14063094
## 8 167 0.0116172255 2.6120690 40 -0.0010014850 0.06161723
## 9 176 0.0005836240 11.6538462 40 -0.0002244708 0.05058362
## 10 154 0.0522464344 -7.3048780 250 -0.0021238388 0.10224643
## 11 169 0.0079566253 3.3645833 38 -0.0008288151 0.05795663
## 12 166 0.0137065304 -3.5476190 115 -0.0010878199 0.06370653
## 13 154 0.0522464344 -1.4105691 105 -0.0021238388 0.10224643
## 14 247 0.4039230583 -0.2967836 50 0.0059053079 0.45392306
## 15 193 0.0179024070 -2.7291667 31 0.0012432227 0.06790241
## 16 202 0.0472735435 2.1239316 120 0.0020202369 0.09727354
## 17 176 0.0005836240 17.4230769 25 -0.0002244708 0.05058362
## 18 157 0.0402804158 -0.4490741 80 -0.0018648341 0.09028042
## 19 156 0.0440964188 -0.1194690 73 -0.0019511690 0.09409642
## 20 138 0.1423110129 0.6724138 43 -0.0035051974 0.19231101
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 10 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra menos la 14
# lm3: todas las muestras menos la número 10
lm1=lm(Jumps~Weight,data=Linnerud); lm1
##
## Call:
## lm(formula = Jumps ~ Weight, data = Linnerud)
##
## Coefficients:
## (Intercept) Weight
## 154.24 -0.47
lm2=lm(Jumps~Weight,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Jumps ~ Weight, data = Linnerud[c(1:13, 15:20),
## ])
##
## Coefficients:
## (Intercept) Weight
## 176.0320 -0.5981
lm3=lm(Jumps~Weight, data=Linnerud[c(1:9,11:20),]);lm3
##
## Call:
## lm(formula = Jumps ~ Weight, data = Linnerud[c(1:9, 11:20), ])
##
## Coefficients:
## (Intercept) Weight
## 73.8310 -0.0722
plot(Weight,Jumps)
text(Weight,Jumps,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 10
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 10"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Modelo lm2 (linea color azul): Este modelo excluye la muestra número 14. La pendiente se vuelve más negativa (-0.5981 en comparación con -0.47 lm1), y el intercepto aumenta a 176.0320 , Esto indica que, sin la muestra 14, el modelo predice que el Weight tiene un impacto mayor en la reducción de los Jumps.
# Modelo lm3 (Línea Verde): Este modelo excluye la muestra número 10, retirada por tener un valor residual alto. La pendiente se reduce drásticamente (-0.0722), lo que sugiere una relación mucho menos pronunciada entre el Weight y la cantidad de Jumps.El intercepto aquí es significativamente más bajo (73.8310), lo que resulta en un ajuste muy diferente en comparación con los otros dos modelos.
iv) Pulls y Waist
#Regresión a mano
# definición de los datos para el modelo
# Pulls y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,2]; x # x es el caracter descriptivo
## [1] 36 37 38 35 35 36 38 34 31 33 34 33 34 46 36 37 37 32 33 33
y = Linnerud[,4]; y # y es el caracter respuesta
## [1] 5 2 12 12 13 4 8 6 15 17 17 13 14 1 6 12 4 11 15 2
nom = colnames(Linnerud[c(2,4)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 35.4
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 9.45
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 25258
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 2317
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 6513
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -177.6
varx = ssxc/n; varx # varx es la varianza de x
## [1] 9.74
vary = ssyc/n; vary # vary es la varianza de y
## [1] 26.5475
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -8.88
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## Waist Pulls xy
## Mínimo 31.000000 1.000000 0.00
## Máximo 46.000000 17.000000 0.00
## Promedio 35.400000 9.450000 0.00
## Total 708.000000 189.000000 0.00
## Suma de cuadrados 25258.000000 2317.000000 6513.00
## Cuadrados centrados 194.800000 530.950000 -177.60
## Varianza covarianza 9.740000 26.547500 -8.88
## Desvío estándar 3.120897 5.152427 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -0.9117043
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 41.72433
eta = ah + bh *x; eta # valores estimados
## [1] 8.9029774 7.9912731 7.0795688 9.8146817 9.8146817 8.9029774 7.0795688 10.7263860 13.4614990 11.6380903 10.7263860 11.6380903 10.7263860 -0.2140657 8.9029774 7.9912731 7.9912731 12.5497947 11.6380903 11.6380903
res = y - eta; res #residuos
## [1] -3.9029774 -5.9912731 4.9204312 2.1853183 3.1853183 -4.9029774 0.9204312 -4.7263860 1.5385010 5.3619097 6.2736140 1.3619097 3.2736140 1.2140657 -2.9029774 4.0087269 -3.9912731 -1.5497947 3.3619097 -9.6380903
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Waist Pulls eta residuos %res
## [1,] 36 5 8.9029774 -3.9029774 -78.05955
## [2,] 37 2 7.9912731 -5.9912731 -299.56366
## [3,] 38 12 7.0795688 4.9204312 41.00359
## [4,] 35 12 9.8146817 2.1853183 18.21099
## [5,] 35 13 9.8146817 3.1853183 24.50245
## [6,] 36 4 8.9029774 -4.9029774 -122.57444
## [7,] 38 8 7.0795688 0.9204312 11.50539
## [8,] 34 6 10.7263860 -4.7263860 -78.77310
## [9,] 31 15 13.4614990 1.5385010 10.25667
## [10,] 33 17 11.6380903 5.3619097 31.54065
## [11,] 34 17 10.7263860 6.2736140 36.90361
## [12,] 33 13 11.6380903 1.3619097 10.47623
## [13,] 34 14 10.7263860 3.2736140 23.38296
## [14,] 46 1 -0.2140657 1.2140657 121.40657
## [15,] 36 6 8.9029774 -2.9029774 -48.38296
## [16,] 37 12 7.9912731 4.0087269 33.40606
## [17,] 37 4 7.9912731 -3.9912731 -99.78183
## [18,] 32 11 12.5497947 -1.5497947 -14.08904
## [19,] 33 15 11.6380903 3.3619097 22.41273
## [20,] 33 2 11.6380903 -9.6380903 -481.90452
# gráfico clásico
plot(x,y,xlab="Waist",ylab="Pulls")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Pulls) == 41.72433 -0.9117043 * x(Waist)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 41.72433 -0.9117043*x
# Observamos una relación inversa entre el Waist y Pulls (dado el valor de la estimación bh = -0.9117043). Esto quiere decir que a medida que el Waist aumenta, la variable Pulls disminuye.Esto quiere decir un aumento en la circunferencia de la cintura estaría asociado con un menor número de tirones
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos, lo que indica que el modelo no está sesgado
# Se observa que la muestra 11 tiene un residuo positivo grande(respecto al resto, 6.2736140), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 20 tiene un residuo negativo grande (respecto al resto,-9.6380903), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 20)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 0.2578589
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 9.128205
ym # promedio de y
## [1] 9.45
etam = mean(b0*x);etam # promedio de eta
## [1] 9.128205
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 6.435901
Se/n # desvío promedio
## [1] 0.3217951
ym - etam # diferencia de promedios
## [1] 0.3217951
etasi = b0*x #etasi
plot(x,y,xlab="Waist",ylab="Pulls")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 0.2578589), que contradice la relación observada en los datos y la proporcionada por el modelo lineal con intercepto (línea color rojo).
# Visualmente la regresión con intercepto parece tener un mejor ajusto de los datos
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0018480493 0.0131416838 0.0347022587 0.0008213552 0.0008213552 0.0018480493 0.0347022587 0.0100616016 0.0993839836 0.0295687885 0.0100616016 0.0295687885 0.0100616016 0.5767967146 0.0018480493 0.0131416838 0.0131416838 0.0593429158 0.0295687885 0.0295687885
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] -7.4166667 -4.6562500 0.9807692 -6.3750000 -8.8750000 -9.0833333 -0.5576923 2.4642857 -1.2613636 -3.1458333 -5.3928571 -1.4791667 -3.2500000 -0.7971698 -5.7500000 1.5937500 -3.4062500 -0.4558824 -2.3125000 3.1041667
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -0.9117043
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.003080082 0.008213552 0.013347023 -0.002053388 -0.002053388 0.003080082 0.013347023 -0.007186858 -0.022587269 -0.012320329 -0.007186858 -0.012320329 -0.007186858 0.054414784 0.003080082 0.008213552 0.008213552 -0.017453799 -0.012320329 -0.012320329
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -0.9117043
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 2 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 3 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 4 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 5 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 6 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 7 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 8 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 9 0.03644764 0.01386037 -0.008726899 0.05903491 0.05903491 0.03644764 -0.008726899 0.08162218 0.149383984 0.10420945 0.08162218 0.10420945 0.08162218 -0.18942505 0.03644764 0.01386037 0.01386037 0.126796715 0.10420945 0.10420945
## 10 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 11 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 12 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 13 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 14 0.08264887 0.13706366 0.191478439 0.02823409 0.02823409 0.08264887 0.191478439 -0.02618070 -0.189425051 -0.08059548 -0.02618070 -0.08059548 -0.02618070 0.62679671 0.08264887 0.13706366 0.13706366 -0.135010267 -0.08059548 -0.08059548
## 15 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 16 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 17 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 18 0.03952772 0.02207392 0.004620123 0.05698152 0.05698152 0.03952772 0.004620123 0.07443532 0.126796715 0.09188912 0.07443532 0.09188912 0.07443532 -0.13501027 0.03952772 0.02207392 0.02207392 0.109342916 0.09188912 0.09188912
## 19 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 20 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.05184805 0.06314168 0.08470226 0.05082136 0.05082136 0.05184805 0.08470226 0.06006160 0.14938398 0.07956879 0.06006160 0.07956879 0.06006160 0.62679671 0.05184805 0.06314168 0.06314168 0.10934292 0.07956879 0.07956879
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 36 0.0018480493 -7.4166667 5 0.003080082 0.05184805
## 2 37 0.0131416838 -4.6562500 2 0.008213552 0.06314168
## 3 38 0.0347022587 0.9807692 12 0.013347023 0.08470226
## 4 35 0.0008213552 -6.3750000 12 -0.002053388 0.05082136
## 5 35 0.0008213552 -8.8750000 13 -0.002053388 0.05082136
## 6 36 0.0018480493 -9.0833333 4 0.003080082 0.05184805
## 7 38 0.0347022587 -0.5576923 8 0.013347023 0.08470226
## 8 34 0.0100616016 2.4642857 6 -0.007186858 0.06006160
## 9 31 0.0993839836 -1.2613636 15 -0.022587269 0.14938398
## 10 33 0.0295687885 -3.1458333 17 -0.012320329 0.07956879
## 11 34 0.0100616016 -5.3928571 17 -0.007186858 0.06006160
## 12 33 0.0295687885 -1.4791667 13 -0.012320329 0.07956879
## 13 34 0.0100616016 -3.2500000 14 -0.007186858 0.06006160
## 14 46 0.5767967146 -0.7971698 1 0.054414784 0.62679671
## 15 36 0.0018480493 -5.7500000 6 0.003080082 0.05184805
## 16 37 0.0131416838 1.5937500 12 0.008213552 0.06314168
## 17 37 0.0131416838 -3.4062500 4 0.008213552 0.06314168
## 18 32 0.0593429158 -0.4558824 11 -0.017453799 0.10934292
## 19 33 0.0295687885 -2.3125000 15 -0.012320329 0.07956879
## 20 33 0.0295687885 3.1041667 2 -0.012320329 0.07956879
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 20 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra sin la 14
# lm3: todas las muestras sin la 20
lm1=lm(Pulls~Waist,data=Linnerud); lm1
##
## Call:
## lm(formula = Pulls ~ Waist, data = Linnerud)
##
## Coefficients:
## (Intercept) Waist
## 41.7243 -0.9117
lm2=lm(Pulls~Waist,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Pulls ~ Waist, data = Linnerud[c(1:13, 15:20), ])
##
## Coefficients:
## (Intercept) Waist
## 47.828 -1.089
lm3=lm(Pulls~Waist, data=Linnerud[c(1:19),]);lm3
##
## Call:
## lm(formula = Pulls ~ Waist, data = Linnerud[c(1:19), ])
##
## Coefficients:
## (Intercept) Waist
## 46.815 -1.041
plot(Waist,Pulls)
text(Waist,Pulls,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 20
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 20"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Comentarios:
# Modelo lm2(color azul): La exclusión de la muestra 14 ha resultado en un en el aumento del intercepto a 47.828 y una pendiente más negativa (-1.089) en comparación a lm1. Lo que implica que la influencia de la circunferencia de la cintura (Waist) sobre el número de "Pulls" es más fuerte sin esta muestra
# modelo lm3(color verde): la pendiente es más negativa respecto a lm1, lo que indica una relación más fuerte entre el Pulls y Waist despues de eliminar la muestra 20 (no tanto como fue la exclusión de la muestra 14)
v) Squats y Waist
head(Linnerud)
## Weight Waist Pulse Pulls Squats Jumps
## 1 191 36 50 5 162 60
## 2 189 37 52 2 110 60
## 3 193 38 58 12 101 101
## 4 162 35 62 12 105 37
## 5 189 35 46 13 155 58
## 6 182 36 56 4 101 42
#Regresión a mano
# definición de los datos para el modelo
# Pulls y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,2]; x # x es el caracter descriptivo
## [1] 36 37 38 35 35 36 38 34 31 33 34 33 34 46 36 37 37 32 33 33
y = Linnerud[,5]; y # y es el caracter respuesta
## [1] 162 110 101 105 155 101 101 125 200 251 120 210 215 50 70 210 60 230 225 110
nom = colnames(Linnerud[c(2,5)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 35.4
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 145.55
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 25258
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 498073
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 100592
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -2457.4
varx = ssxc/n; varx # varx es la varianza de x
## [1] 9.74
vary = ssyc/n; vary # vary es la varianza de y
## [1] 3718.847
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -122.87
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## Waist Squats xy
## Mínimo 31.000000 50.00000 0.00
## Máximo 46.000000 251.00000 0.00
## Promedio 35.400000 145.55000 0.00
## Total 708.000000 2911.00000 0.00
## Suma de cuadrados 25258.000000 498073.00000 100592.00
## Cuadrados centrados 194.800000 74376.95000 -2457.40
## Varianza covarianza 9.740000 3718.84750 -122.87
## Desvío estándar 3.120897 60.98235 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -12.61499
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 592.1206
eta = ah + bh *x; eta # valores estimados
## [1] 137.98101 125.36602 112.75103 150.59600 150.59600 137.98101 112.75103 163.21099 201.05595 175.82598 163.21099 175.82598 163.21099 11.83111 137.98101 125.36602 125.36602 188.44097 175.82598 175.82598
res = y - eta; res #residuos
## [1] 24.018994 -15.366016 -11.751027 -45.595996 4.404004 -36.981006 -11.751027 -38.210986 -1.055955 75.174025 -43.210986 34.174025 51.789014 38.168891 -67.981006 84.633984 -65.366016 41.559035 49.174025 -65.825975
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Waist Squats eta residuos %res
## [1,] 36 162 137.98101 24.018994 14.8265394
## [2,] 37 110 125.36602 -15.366016 -13.9691058
## [3,] 38 101 112.75103 -11.751027 -11.6346799
## [4,] 35 105 150.59600 -45.595996 -43.4247580
## [5,] 35 155 150.59600 4.404004 2.8412930
## [6,] 36 101 137.98101 -36.981006 -36.6148576
## [7,] 38 101 112.75103 -11.751027 -11.6346799
## [8,] 34 125 163.21099 -38.210986 -30.5687885
## [9,] 31 200 201.05595 -1.055955 -0.5279774
## [10,] 33 251 175.82598 75.174025 29.9498106
## [11,] 34 120 163.21099 -43.210986 -36.0091547
## [12,] 33 210 175.82598 34.174025 16.2733451
## [13,] 34 215 163.21099 51.789014 24.0879137
## [14,] 46 50 11.83111 38.168891 76.3377823
## [15,] 36 70 137.98101 -67.981006 -97.1157231
## [16,] 37 210 125.36602 84.633984 40.3018969
## [17,] 37 60 125.36602 -65.366016 -108.9433607
## [18,] 32 230 188.44097 41.559035 18.0691456
## [19,] 33 225 175.82598 49.174025 21.8551221
## [20,] 33 110 175.82598 -65.825975 -59.8417958
# gráfico clásico
plot(x,y,xlab="Waist",ylab="Squats")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Squats) == 592.1206 -12.61499 * x(Waist)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 592.1206 -12.61499*x
# Observamos una relación inversa entre el Waist y Squats (dado el valor de la estimación bh = -12.61499). Esto quiere decir que a medida que el Waist aumenta, la variable Squats disminuye. Esto quiere decir un aumento en la circunferencia de la cintura estaría asociado con un menor número de sentadillas.
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos, lo que indica que el modelo no está sesgado
# Se observa que la muestra 16 tiene un residuo positivo grande(respecto al resto, 84.633984), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 20 tiene un residuo negativo grande (respecto al resto,-67.981006), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 16)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 3.98258
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 140.9833
ym # promedio de y
## [1] 145.55
etam = mean(b0*x);etam # promedio de eta
## [1] 140.9833
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 91.33352
Se/n # desvío promedio
## [1] 4.566676
ym - etam # diferencia de promedios
## [1] 4.566676
etasi = b0*x #etasi
plot(x,y,xlab="Waist",ylab="Squats")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 3.98258). La cual contradice la relación observada en los datos y la proporcionada por el modelo lineal con intercepto (línea color rojo).
# Visualmente la regresión con intercepto parece tener un mejor ajuste de los datos
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0018480493 0.0131416838 0.0347022587 0.0008213552 0.0008213552 0.0018480493 0.0347022587 0.0100616016 0.0993839836 0.0295687885 0.0100616016 0.0295687885 0.0100616016 0.5767967146 0.0018480493 0.0131416838 0.0131416838 0.0593429158 0.0295687885 0.0295687885
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] 27.416667 -22.218750 -17.134615 101.375000 -23.625000 -74.250000 -17.134615 14.678571 -12.375000 -43.937500 18.250000 -26.854167 -49.607143 -9.014151 -125.916667 40.281250 -53.468750 -24.838235 -33.104167 14.812500
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -12.61499
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.003080082 0.008213552 0.013347023 -0.002053388 -0.002053388 0.003080082 0.013347023 -0.007186858 -0.022587269 -0.012320329 -0.007186858 -0.012320329 -0.007186858 0.054414784 0.003080082 0.008213552 0.008213552 -0.017453799 -0.012320329 -0.012320329
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -12.61499
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 2 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 3 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 4 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 5 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 6 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 7 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 8 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 9 0.03644764 0.01386037 -0.008726899 0.05903491 0.05903491 0.03644764 -0.008726899 0.08162218 0.149383984 0.10420945 0.08162218 0.10420945 0.08162218 -0.18942505 0.03644764 0.01386037 0.01386037 0.126796715 0.10420945 0.10420945
## 10 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 11 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 12 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 13 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 14 0.08264887 0.13706366 0.191478439 0.02823409 0.02823409 0.08264887 0.191478439 -0.02618070 -0.189425051 -0.08059548 -0.02618070 -0.08059548 -0.02618070 0.62679671 0.08264887 0.13706366 0.13706366 -0.135010267 -0.08059548 -0.08059548
## 15 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 16 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 17 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 18 0.03952772 0.02207392 0.004620123 0.05698152 0.05698152 0.03952772 0.004620123 0.07443532 0.126796715 0.09188912 0.07443532 0.09188912 0.07443532 -0.13501027 0.03952772 0.02207392 0.02207392 0.109342916 0.09188912 0.09188912
## 19 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 20 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.05184805 0.06314168 0.08470226 0.05082136 0.05082136 0.05184805 0.08470226 0.06006160 0.14938398 0.07956879 0.06006160 0.07956879 0.06006160 0.62679671 0.05184805 0.06314168 0.06314168 0.10934292 0.07956879 0.07956879
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 36 0.0018480493 27.416667 162 0.003080082 0.05184805
## 2 37 0.0131416838 -22.218750 110 0.008213552 0.06314168
## 3 38 0.0347022587 -17.134615 101 0.013347023 0.08470226
## 4 35 0.0008213552 101.375000 105 -0.002053388 0.05082136
## 5 35 0.0008213552 -23.625000 155 -0.002053388 0.05082136
## 6 36 0.0018480493 -74.250000 101 0.003080082 0.05184805
## 7 38 0.0347022587 -17.134615 101 0.013347023 0.08470226
## 8 34 0.0100616016 14.678571 125 -0.007186858 0.06006160
## 9 31 0.0993839836 -12.375000 200 -0.022587269 0.14938398
## 10 33 0.0295687885 -43.937500 251 -0.012320329 0.07956879
## 11 34 0.0100616016 18.250000 120 -0.007186858 0.06006160
## 12 33 0.0295687885 -26.854167 210 -0.012320329 0.07956879
## 13 34 0.0100616016 -49.607143 215 -0.007186858 0.06006160
## 14 46 0.5767967146 -9.014151 50 0.054414784 0.62679671
## 15 36 0.0018480493 -125.916667 70 0.003080082 0.05184805
## 16 37 0.0131416838 40.281250 210 0.008213552 0.06314168
## 17 37 0.0131416838 -53.468750 60 0.008213552 0.06314168
## 18 32 0.0593429158 -24.838235 230 -0.017453799 0.10934292
## 19 33 0.0295687885 -33.104167 225 -0.012320329 0.07956879
## 20 33 0.0295687885 14.812500 110 -0.012320329 0.07956879
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 16 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra sin la 14
# lm3: todas las muestras sin la 16
lm1=lm(Squats~Waist,data=Linnerud); lm1
##
## Call:
## lm(formula = Squats ~ Waist, data = Linnerud)
##
## Coefficients:
## (Intercept) Waist
## 592.12 -12.61
lm2=lm(Squats~Waist,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Squats ~ Waist, data = Linnerud[c(1:13, 15:20),
## ])
##
## Coefficients:
## (Intercept) Waist
## 784.02 -18.18
lm3=lm(Squats~Waist, data=Linnerud[c(1:15,17:20),]);lm3
##
## Call:
## lm(formula = Squats ~ Waist, data = Linnerud[c(1:15, 17:20),
## ])
##
## Coefficients:
## (Intercept) Waist
## 613.87 -13.36
plot(Waist,Squats)
text(Waist,Squats,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 16
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 20"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Comentarios:
# Modelo lm2(color azul): La exclusión de la muestra 14 ha resultado en un intercepto más bajo y una pendiente menos negativa en comparación a lm1, lo que justifica que en realidad su tuvo un peso y apalancamiento que impactaba en el modelo.
# modelo lm3(color verde): la pendiente es más negativa respecto a lm1, lo que indica una relación más fuerte entre el Pulls y Weight despues de eliminar la muestra 20
vi) Jumps y Waist
head(Linnerud)
## Weight Waist Pulse Pulls Squats Jumps
## 1 191 36 50 5 162 60
## 2 189 37 52 2 110 60
## 3 193 38 58 12 101 101
## 4 162 35 62 12 105 37
## 5 189 35 46 13 155 58
## 6 182 36 56 4 101 42
#Regresión a mano
# definición de los datos para el modelo
# Pulls y Weight
n = dim(Linnerud)[1];n # n es el número de observaciones
## [1] 20
x = Linnerud[,2]; x # x es el caracter descriptivo
## [1] 36 37 38 35 35 36 38 34 31 33 34 33 34 46 36 37 37 32 33 33
y = Linnerud[,6]; y # y es el caracter respuesta
## [1] 60 60 101 37 58 42 38 40 40 250 38 115 105 50 31 120 25 80 73 43
nom = colnames(Linnerud[c(2,6)]) # etiquetas de las variables en nom
# Estadísticas
xm = sum(x)/n; xm # cálculo de xm, promedio de x
## [1] 35.4
ym = sum(y)/n; ym # cálculo de ym, promedio de y
## [1] 70.3
ssx = sum(x^2); ssx # ssx es la suma de los x cuadrados
## [1] 25258
ssy = sum(y^2); ssy # ssy es la suma de los y cuadrados
## [1] 148800
sxy = sum(x*y); sxy # sxy es la suma de los productos xy
## [1] 49175
ssxc = ssx - n*xm^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
ssyc = ssy - n*ym^2; ssxc # ssxc es ssx centrado sobre el promedio (variabilidad explicada por el modelo de la variabilidad total)
## [1] 194.8
sxyc = sxy - n*xm*ym ; sxyc # sxyc es sxy centrado sobre el promedio
## [1] -597.4
varx = ssxc/n; varx # varx es la varianza de x
## [1] 9.74
vary = ssyc/n; vary # vary es la varianza de y
## [1] 2497.91
covxy = sxyc/n; covxy # covxy es la covarianza de xy
## [1] -29.87
stats = matrix(24*0,nrow=8,ncol=3) # construcción de tabla de estadísticas
rownames(stats) = c("Mínimo","Máximo","Promedio","Total","Suma de cuadrados",
"Cuadrados centrados","Varianza covarianza","Desvío estándar")
colnames(stats) = c(nom,"xy")
stats[,1] = rbind(min(x),max(x),xm,sum(x),ssx,ssxc,varx,sqrt(varx))
stats[,2] = rbind(min(y),max(y),ym,sum(y),ssy,ssyc,vary,sqrt(vary))
stats[,3] = rbind(0,0,0,0,sxy,sxyc,covxy,0)
stats # impresión de la tabla
## Waist Jumps xy
## Mínimo 31.000000 25.0000 0.00
## Máximo 46.000000 250.0000 0.00
## Promedio 35.400000 70.3000 0.00
## Total 708.000000 1406.0000 0.00
## Suma de cuadrados 25258.000000 148800.0000 49175.00
## Cuadrados centrados 194.800000 49958.2000 -597.40
## Varianza covarianza 9.740000 2497.9100 -29.87
## Desvío estándar 3.120897 49.9791 0.00
#Estimación
bh = sxyc/ssxc ; bh # bh es la estimación de beta
## [1] -3.066735
ah = ym - bh*xm ; ah # ah es la estimación de alfa
## [1] 178.8624
eta = ah + bh *x; eta # valores estimados
## [1] 68.45996 65.39322 62.32649 71.52669 71.52669 68.45996 62.32649 74.59343 83.79363 77.66016 74.59343 77.66016 74.59343 37.79261 68.45996 65.39322 65.39322 80.72690 77.66016 77.66016
res = y - eta; res #residuos
## [1] -8.4599589 -5.3932238 38.6735113 -34.5266940 -13.5266940 -26.4599589 -24.3264887 -34.5934292 -43.7936345 172.3398357 -36.5934292 37.3398357 30.4065708 12.2073922 -37.4599589 54.6067762 -40.3932238 -0.7268994 -4.6601643 -34.6601643
porc_res = (res/y)*100 # porcentaje de residuos
unidad = cbind(x,y,eta,res,porc_res) # tabla de residuos
colnames(unidad) = c(nom,"eta","residuos","%res")
unidad
## Waist Jumps eta residuos %res
## [1,] 36 60 68.45996 -8.4599589 -14.0999316
## [2,] 37 60 65.39322 -5.3932238 -8.9887064
## [3,] 38 101 62.32649 38.6735113 38.2906052
## [4,] 35 37 71.52669 -34.5266940 -93.3153893
## [5,] 35 58 71.52669 -13.5266940 -23.3218863
## [6,] 36 42 68.45996 -26.4599589 -62.9999022
## [7,] 38 38 62.32649 -24.3264887 -64.0170755
## [8,] 34 40 74.59343 -34.5934292 -86.4835729
## [9,] 31 40 83.79363 -43.7936345 -109.4840862
## [10,] 33 250 77.66016 172.3398357 68.9359343
## [11,] 34 38 74.59343 -36.5934292 -96.2984978
## [12,] 33 115 77.66016 37.3398357 32.4694224
## [13,] 34 105 74.59343 30.4065708 28.9586389
## [14,] 46 50 37.79261 12.2073922 24.4147844
## [15,] 36 31 68.45996 -37.4599589 -120.8385772
## [16,] 37 120 65.39322 54.6067762 45.5056468
## [17,] 37 25 65.39322 -40.3932238 -161.5728953
## [18,] 32 80 80.72690 -0.7268994 -0.9086242
## [19,] 33 73 77.66016 -4.6601643 -6.3837867
## [20,] 33 43 77.66016 -34.6601643 -80.6050332
# gráfico clásico
plot(x,y,xlab="Waist",ylab="Jumps")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
# Agregar la leyenda con la ecuación
legend("topright", # Ubicación de la leyenda en el gráfico
legend = expression(y(Jumps) == 178.8624 -3.066735 * x(Waist)),
bty = "n",
col = "red",
cex = 0.7)
# gráficos de valores estimados y residuos
plot(eta,y,asp=1,xlab="estimados",ylab="observados")
abline(0,1,col="red")
text(eta,y,labels=lab)
plot(eta,res,asp=1,xlab="estimados",ylab="residuos")
abline(0,0,col="red")
text(eta,res,labels=lab)
## Analizando regresión:
# Ecuación de la recta: y = 178.8624 -3.066735*x
# Observamos una relación inversa entre el Waist y Jumps (dado el valor de la estimación bh = -3.066735). Esto quiere decir que a medida que el Waist aumenta, la variable Jumps disminuye. Esto quiere decir un aumento en la circunferencia de la cintura está asociado con una disminución en el número de saltos
## Gráficos de Residuos vs Estimados:
# Los residuos están dispersos aleatoriamente alrededor de la línea horizontal en cero. Lo que indica que no hay patrones que sugieran una no linealidad
# La línea roja que representa el residuo cero parece ser un buen punto central para la dispersión de residuos, lo que indica que el modelo no está sesgado
# La mayoría de los residuos están agrupados cerca de la línea horizontal de residuo cero, lo que sugiere que el modelo no está sistemáticamente sobreestimando ni subestimando las predicciones para la mayoría de las observaciones
# Se observa que la muestra 10 tiene un residuo positivo grande(respecto al resto, 172.3398357), lo que significa que el modelo subestimó el valor real de la observación
# Por otro lado, la muestra 9 tiene un residuo negativo grande (respecto al resto,-43.7936345), indicando una sobreestimación.
# Se evaluará retirar el que tenga el mayor valor absoluto (muestra 10)
Pregunta 6
#Regresión sin intercepto
b0 = sxy/ssx; b0 # estimación de beta
## [1] 1.946908
etaxm = b0*xm; etaxm # estimación al promedio de x
## [1] 68.92054
ym # promedio de y
## [1] 70.3
etam = mean(b0*x);etam # promedio de eta
## [1] 68.92054
Se = sum(y-b0*x);Se # Suma de desvío
## [1] 27.5892
Se/n # desvío promedio
## [1] 1.37946
ym - etam # diferencia de promedios
## [1] 1.37946
etasi = b0*x #etasi
plot(x,y,xlab="Waist",ylab="Jumps")
text(x,y,labels=lab)
points(x,eta,col="red")
abline(ah,bh,col="red")
lines(x,etasi , col= "blue")
legend("topright",
legend = c("Modelo lineal", "Regresión sin intercepto"),
col = c("red", "blue"),
lty = c(1, 1),
lwd = c(1, 2),
cex = 0.7)
# El modelo sin intercepto (linea color azul) al comenzar desde el origen y tener una pendiente ascendente (b0= 1.946908). Esto es atípico, ya que uno esperaría una relación inversa; es decir, a mayor circunferencia de la cintura, menos saltos se realizarían (dada la naturaleza de los datos)
Pregunta 7
# apalancamiento
w <- (x-xm)^2 / ssxc ; w # w pesos de los pendientes
## [1] 0.0018480493 0.0131416838 0.0347022587 0.0008213552 0.0008213552 0.0018480493 0.0347022587 0.0100616016 0.0993839836 0.0295687885 0.0100616016 0.0295687885 0.0100616016 0.5767967146 0.0018480493 0.0131416838 0.0131416838 0.0593429158 0.0295687885 0.0295687885
b <- (y-ym)/(x-xm) ; b # pendientes
## [1] -17.166667 -6.437500 11.807692 83.250000 30.750000 -47.166667 -12.423077 21.642857 6.886364 -74.875000 23.071429 -18.625000 -24.785714 -1.915094 -65.500000 31.062500 -28.312500 -2.852941 -1.125000 11.375000
bh2 <- t(w)%*%b ; bh2 # determinación alternativa de bh
## [,1]
## [1,] -3.066735
c <- (x-xm) / ssxc ; c # coeficientes de beta según y
## [1] 0.003080082 0.008213552 0.013347023 -0.002053388 -0.002053388 0.003080082 0.013347023 -0.007186858 -0.022587269 -0.012320329 -0.007186858 -0.012320329 -0.007186858 0.054414784 0.003080082 0.008213552 0.008213552 -0.017453799 -0.012320329 -0.012320329
bh3 <- t(c)%*%y ; bh3 # determinación alternativa de bh
## [,1]
## [1,] -3.066735
Hs <- matrix(0,n,n) # definición de H sombrero y su construcción
rownames(Hs)= lab # inclusivo de su etiquetas
colnames(Hs)=lab
for (i in 1:n) {
for (j in 1:n) {
Hs[i,j] <- 1 / n + c[j] * (x[i] - xm)
}
} ; Hs
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 2 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 3 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 4 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 5 0.04876797 0.04671458 0.044661191 0.05082136 0.05082136 0.04876797 0.044661191 0.05287474 0.059034908 0.05492813 0.05287474 0.05492813 0.05287474 0.02823409 0.04876797 0.04671458 0.04671458 0.056981520 0.05492813 0.05492813
## 6 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 7 0.05800821 0.07135524 0.084702259 0.04466119 0.04466119 0.05800821 0.084702259 0.03131417 -0.008726899 0.01796715 0.03131417 0.01796715 0.03131417 0.19147844 0.05800821 0.07135524 0.07135524 0.004620123 0.01796715 0.01796715
## 8 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 9 0.03644764 0.01386037 -0.008726899 0.05903491 0.05903491 0.03644764 -0.008726899 0.08162218 0.149383984 0.10420945 0.08162218 0.10420945 0.08162218 -0.18942505 0.03644764 0.01386037 0.01386037 0.126796715 0.10420945 0.10420945
## 10 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 11 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 12 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 13 0.04568789 0.03850103 0.031314168 0.05287474 0.05287474 0.04568789 0.031314168 0.06006160 0.081622177 0.06724846 0.06006160 0.06724846 0.06006160 -0.02618070 0.04568789 0.03850103 0.03850103 0.074435318 0.06724846 0.06724846
## 14 0.08264887 0.13706366 0.191478439 0.02823409 0.02823409 0.08264887 0.191478439 -0.02618070 -0.189425051 -0.08059548 -0.02618070 -0.08059548 -0.02618070 0.62679671 0.08264887 0.13706366 0.13706366 -0.135010267 -0.08059548 -0.08059548
## 15 0.05184805 0.05492813 0.058008214 0.04876797 0.04876797 0.05184805 0.058008214 0.04568789 0.036447639 0.04260780 0.04568789 0.04260780 0.04568789 0.08264887 0.05184805 0.05492813 0.05492813 0.039527721 0.04260780 0.04260780
## 16 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 17 0.05492813 0.06314168 0.071355236 0.04671458 0.04671458 0.05492813 0.071355236 0.03850103 0.013860370 0.03028747 0.03850103 0.03028747 0.03850103 0.13706366 0.05492813 0.06314168 0.06314168 0.022073922 0.03028747 0.03028747
## 18 0.03952772 0.02207392 0.004620123 0.05698152 0.05698152 0.03952772 0.004620123 0.07443532 0.126796715 0.09188912 0.07443532 0.09188912 0.07443532 -0.13501027 0.03952772 0.02207392 0.02207392 0.109342916 0.09188912 0.09188912
## 19 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
## 20 0.04260780 0.03028747 0.017967146 0.05492813 0.05492813 0.04260780 0.017967146 0.06724846 0.104209446 0.07956879 0.06724846 0.07956879 0.06724846 -0.08059548 0.04260780 0.03028747 0.03028747 0.091889117 0.07956879 0.07956879
sum(Hs) # Hs es centrada
## [1] 20
lev <- diag(Hs); lev # apalancamientos
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 0.05184805 0.06314168 0.08470226 0.05082136 0.05082136 0.05184805 0.08470226 0.06006160 0.14938398 0.07956879 0.06006160 0.07956879 0.06006160 0.62679671 0.05184805 0.06314168 0.06314168 0.10934292 0.07956879 0.07956879
pesos <- cbind(x,w,b,y,c,lev) # construcción de una salida conjunta
rownames(pesos) <- lab
pesos # salida
## x w b y c lev
## 1 36 0.0018480493 -17.166667 60 0.003080082 0.05184805
## 2 37 0.0131416838 -6.437500 60 0.008213552 0.06314168
## 3 38 0.0347022587 11.807692 101 0.013347023 0.08470226
## 4 35 0.0008213552 83.250000 37 -0.002053388 0.05082136
## 5 35 0.0008213552 30.750000 58 -0.002053388 0.05082136
## 6 36 0.0018480493 -47.166667 42 0.003080082 0.05184805
## 7 38 0.0347022587 -12.423077 38 0.013347023 0.08470226
## 8 34 0.0100616016 21.642857 40 -0.007186858 0.06006160
## 9 31 0.0993839836 6.886364 40 -0.022587269 0.14938398
## 10 33 0.0295687885 -74.875000 250 -0.012320329 0.07956879
## 11 34 0.0100616016 23.071429 38 -0.007186858 0.06006160
## 12 33 0.0295687885 -18.625000 115 -0.012320329 0.07956879
## 13 34 0.0100616016 -24.785714 105 -0.007186858 0.06006160
## 14 46 0.5767967146 -1.915094 50 0.054414784 0.62679671
## 15 36 0.0018480493 -65.500000 31 0.003080082 0.05184805
## 16 37 0.0131416838 31.062500 120 0.008213552 0.06314168
## 17 37 0.0131416838 -28.312500 25 0.008213552 0.06314168
## 18 32 0.0593429158 -2.852941 80 -0.017453799 0.10934292
## 19 33 0.0295687885 -1.125000 73 -0.012320329 0.07956879
## 20 33 0.0295687885 11.375000 43 -0.012320329 0.07956879
# De acuerdo a los resultados se observa que la muestra número 14 tiene alto
# apalancamiento y también un alto peso
# Por otro lado la observación número 10 visualmente parece ser un valor atipico, además de tener un valor residual en valor absoluto alto. Lo que podría generar una influencia alta
# Se evaluarán retirar estas observaciones para generar los siguiente modelos
Pregunta 8
# lm1 : todas las muestras
# lm2: todas la muestra sin la 14
# lm3: todas las muestras sin la 10
lm1=lm(Jumps~Waist,data=Linnerud); lm1
##
## Call:
## lm(formula = Jumps ~ Waist, data = Linnerud)
##
## Coefficients:
## (Intercept) Waist
## 178.862 -3.067
lm2=lm(Jumps~Waist,data=Linnerud[c(1:13,15:20),]); lm2
##
## Call:
## lm(formula = Jumps ~ Waist, data = Linnerud[c(1:13, 15:20), ])
##
## Coefficients:
## (Intercept) Waist
## 240.235 -4.847
lm3=lm(Jumps~Waist, data=Linnerud[c(1:9,11:20),]);lm3
##
## Call:
## lm(formula = Jumps ~ Waist, data = Linnerud[c(1:9, 11:20), ])
##
## Coefficients:
## (Intercept) Waist
## 87.8385 -0.7599
plot(Waist,Jumps)
text(Waist,Jumps,labels = lab)
abline(lm1,col="red") # recta con muestra 14
abline(lm2,col="blue") # recta sin muestra 14
abline(lm3,col="green") # recta sin muestra 10
# Agregar leyenda
legend("topright",
legend = c("lm1: Modelo con todas las muestras", "lm2: Modelo sin muestra 14", "lm3: Modelo sin muestra 10"),
col = c("red", "blue", "green"),
lty = 1,
cex = 0.5)
# Comentarios:
# Modelo lm2(color azul): La exclusión de la muestra 14 ha resultado en un intercepto significativamente mayor (240.235) y una pendiente más pronunciada (-4.847) respecto a lm1 (linea roja). lo que indica que la exclusión de esta muestra lleva a una relación más fuerte entre "Waist" y "Jumps". La muestra 14 (excluida en lm2) parece ejercer una influencia considerable en el modelo, ya que su exclusión conduce a un cambio notable en los coeficientes de la regresión
# modelo lm3(color verde): Excluye la muestra 10 por tener un alto valor absoluto residual. Este modelo tiene un intercepto menor (87.8385) y una pendiente menos pronunciada (-0.7599) respecto a lm1. Lo que sugiere que al retirar la muestra 10, la relación estimada (pendiente) entre "Waist" y "Jumps" tiene menor fuerza de asociación (respecto a lm1)