Imporatacion de archivo
library(readr)
## Warning: package 'readr' was built under R version 4.4.2
practica_1_ejercicio <- read_csv("C:/Users/PBFCIS-SPP-02/Downloads/practica_1_ejercicio.csv")
## Rows: 6 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (3): Y, X1, X2
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(practica_1_ejercicio)
## # A tibble: 6 × 3
## Y X1 X2
## <dbl> <dbl> <dbl>
## 1 90 1 0
## 2 100 2 0
## 3 110 3 0
## 4 135 4 1
## 5 145 5 1
## 6 165 6 1
Ingreso de matrices
Matrix Y
matriz_Y<-matrix(data = c(90,100,110,135,145,165),
nrow = 6,
ncol = 1,byrow = TRUE)
colnames(matriz_Y) <-c("matriz_Y")
print(matriz_Y)
## matriz_Y
## [1,] 90
## [2,] 100
## [3,] 110
## [4,] 135
## [5,] 145
## [6,] 165
Matriz X
matriz_X <- cbind(rep(x = 1, 6),
matriz_X <-matrix(data = c(1, 0, 2, 0, 3, 0, 4, 1, 5, 1, 6, 1),
nrow = 6,
ncol = 2,
byrow = TRUE))
colnames(matriz_X) <-c("Cte", "X1", "X2")
print(matriz_X)
## Cte X1 X2
## [1,] 1 1 0
## [2,] 1 2 0
## [3,] 1 3 0
## [4,] 1 4 1
## [5,] 1 5 1
## [6,] 1 6 1
Producto escalar de la primera y segunda columnas de X
X1 <- c(1,2,3,4,5,6)
X2 <- c(0,0,0,1,1,1)
dot_product <- sum(X1 * X2)
print(dot_product)
## [1] 15
Calcular X′X y X′Y
#La siguiente operacion obtiene la matriz X'X (sigma matriz)
matriz_XX <- t(matriz_X) %*% matriz_X
print(matriz_XX)
## Cte X1 X2
## Cte 6 21 3
## X1 21 91 15
## X2 3 15 3
#La siguiente operacion obtiene la matriz X'Y
matriz_XY <- t(matriz_X) %*% matriz_Y
print(matriz_XY)
## matriz_Y
## Cte 745
## X1 2875
## X2 445
Inversa de X′X
XX_inv <- solve(matriz_XX)
print(XX_inv)
## Cte X1 X2
## Cte 1.333333 -0.50 1.166667
## X1 -0.500000 0.25 -0.750000
## X2 1.166667 -0.75 2.916667
Calcule el producto de [X′X]−1 y X′Y
Beta <- XX_inv %*% matriz_XY
colnames(Beta) <- c("parametros")
print(Beta)
## parametros
## Cte 75.00000
## X1 12.50000
## X2 10.83333
Calcule la matriz de proyeccion P, compruebe que P es una matriz
Idempotente
Matriz A
#Proyeccion de A
matriz_A <- solve(XX_inv) %*% t(matriz_X)
print(matriz_A)
## [,1] [,2] [,3] [,4] [,5] [,6]
## Cte 27 48 69 93 114 135
## X1 112 203 294 400 491 582
## X2 18 33 48 66 81 96
Beta
Beta <- matriz_A %*% matriz_Y
print(Beta)
## matriz_Y
## Cte 66180
## X1 283945
## X2 46695
Matriz P
#Proyeccion de P
matriz_P <- matriz_X %*% solve(t(matriz_X)%*% matriz_X) %*% t(matriz_X)
print(matriz_P)
## [,1] [,2] [,3] [,4] [,5]
## [1,] 5.833333e-01 3.333333e-01 8.333333e-02 2.500000e-01 -1.110223e-16
## [2,] 3.333333e-01 3.333333e-01 3.333333e-01 -1.110223e-16 -1.665335e-16
## [3,] 8.333333e-02 3.333333e-01 5.833333e-01 -2.500000e-01 0.000000e+00
## [4,] 2.500000e-01 2.220446e-16 -2.500000e-01 5.833333e-01 3.333333e-01
## [5,] 2.220446e-16 2.220446e-16 2.220446e-16 3.333333e-01 3.333333e-01
## [6,] -2.500000e-01 2.220446e-16 2.500000e-01 8.333333e-02 3.333333e-01
## [,6]
## [1,] -2.500000e-01
## [2,] -2.220446e-16
## [3,] 2.500000e-01
## [4,] 8.333333e-02
## [5,] 3.333333e-01
## [6,] 5.833333e-01
# Proyeccion de Y sobre XYˆ= PY
Estimacion de “Y”
y_estimada <- matriz_P %*% matriz_Y
print(y_estimada)
## matriz_Y
## [1,] 87.5000
## [2,] 100.0000
## [3,] 112.5000
## [4,] 135.8333
## [5,] 148.3333
## [6,] 160.8333
Matriz M
#Proyeccion de M
matriz_M <-diag(nrow(matriz_X))- matriz_P
print(matriz_M)
## [,1] [,2] [,3] [,4] [,5]
## [1,] 4.166667e-01 -3.333333e-01 -8.333333e-02 -2.500000e-01 1.110223e-16
## [2,] -3.333333e-01 6.666667e-01 -3.333333e-01 1.110223e-16 1.665335e-16
## [3,] -8.333333e-02 -3.333333e-01 4.166667e-01 2.500000e-01 0.000000e+00
## [4,] -2.500000e-01 -2.220446e-16 2.500000e-01 4.166667e-01 -3.333333e-01
## [5,] -2.220446e-16 -2.220446e-16 -2.220446e-16 -3.333333e-01 6.666667e-01
## [6,] 2.500000e-01 -2.220446e-16 -2.500000e-01 -8.333333e-02 -3.333333e-01
## [,6]
## [1,] 2.500000e-01
## [2,] 2.220446e-16
## [3,] -2.500000e-01
## [4,] -8.333333e-02
## [5,] -3.333333e-01
## [6,] 4.166667e-01
Idempotencia de P
# P.P = P
matriz_PP <- (matriz_P %*% matriz_P - matriz_P) |> round(digits = 4)
print(matriz_PP)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0 0 0 0 0 0
## [2,] 0 0 0 0 0 0
## [3,] 0 0 0 0 0 0
## [4,] 0 0 0 0 0 0
## [5,] 0 0 0 0 0 0
## [6,] 0 0 0 0 0 0
Diferencia de Y y Yˆ (residuales)
residuos <- matriz_Y - y_estimada
print(residuos)
## matriz_Y
## [1,] 2.500000e+00
## [2,] 1.136868e-13
## [3,] -2.500000e+00
## [4,] -8.333333e-01
## [5,] -3.333333e+00
## [6,] 4.166667e+00
Autovalores de X′X
autovalores_XX <- eigen(matriz_XX)
#Muestra los autovalores y los autovectores
print(autovalores_XX)
## eigen() decomposition
## $values
## [1] 98.356654 1.377669 0.265677
##
## $vectors
## [,1] [,2] [,3]
## [1,] -0.2238107 0.8591615 0.4601633
## [2,] -0.9616881 -0.1179798 -0.2474608
## [3,] -0.1583188 -0.4979179 0.8526505
#Muestra solo los autovalores
print(autovalores_XX$values)
## [1] 98.356654 1.377669 0.265677
#Todos los valores son positivos
Autovalores de P y comprobar que la traza de P es igual a la suma de
sus autovalores
autovalores_P <- eigen(matriz_P)
#Muestra los autovalores y los autovectores
print(autovalores_P)
## eigen() decomposition
## $values
## [1] 1.000000e+00 1.000000e+00 1.000000e+00 1.319950e-15 1.381689e-16
## [6] -2.553501e-15
##
## $vectors
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.17027481 0.55319973 -0.49830702 -0.01465309 0.64533088 5.384555e-05
## [2,] 0.11959527 0.05982443 -0.56165055 0.50484213 -0.50503474 -3.959053e-01
## [3,] 0.06891573 -0.43355086 -0.62499408 -0.49018903 -0.14029614 3.958514e-01
## [4,] 0.61246753 0.42129574 0.17529049 0.01769475 -0.38703946 5.162887e-01
## [5,] 0.56178799 -0.07207956 0.11194696 -0.51092544 -0.01154811 -6.367798e-01
## [6,] 0.51110845 -0.56545485 0.04860342 0.49323069 0.39858757 1.204911e-01
#Muestra solo los autovalores
print(autovalores_P$values)
## [1] 1.000000e+00 1.000000e+00 1.000000e+00 1.319950e-15 1.381689e-16
## [6] -2.553501e-15
print(sum(autovalores_P$values))
## [1] 3
Traza P
Traza_P <- sum(diag(matriz_P))
print(Traza_P)
## [1] 3
Comprobacion Traza p = suma de los autovalores de P
a <- Traza_P
b <- sum(autovalores_P$values)
all.equal(a, b)
## [1] TRUE