Ejercicio: La obsidiana.

La Obsidiana es un mineral de origen volcánico al que los pobladores de Mesoamérica, en la época prehispánica, atribuían propiedades mitológicas (a causa de la leyenda del guerrero Obsid) y era muy utilizado en la fabricación de elementos de caza y defensa (tales como puntas de flecha, de lanza, raspadores, cuchillos) así como objetos rituales. En Arqueología se cree que los dos factores que influyen en la Densidad en gramos, Y, de hallazgos de este mineral en los yacimientos arqueológicos son, la Distancia en kilómetros, X1, a la cual se hallaba la fuente de donde se extraía el mineral y el Tamaño en hectáreas, X2, del asentamiento. Examinados cinco asentamientos, se obtuvieron los siguientes datos:

Y | 40 | 35 | 30 | 20 |25

x1| 100 | 90 | 80 | 75 | 70

x2| 35 | 32 | 28 | 20 | 30

Y_Densidad<-c(40,35,30,20,25)
x1_Distancia<-c(100,90,80,75,70)
x2_Tamaño<-c(35,32,28,20,30)
df_Obsidiana <- data.frame(  x1_Distancia = x1_Distancia,  x2_Tamaño = x2_Tamaño,  Y_Densidad = Y_Densidad)
print(df_Obsidiana)
##   x1_Distancia x2_Tamaño Y_Densidad
## 1          100        35         40
## 2           90        32         35
## 3           80        28         30
## 4           75        20         20
## 5           70        30         25
# Visualización Matemática Preliminar 
pairs(df_Obsidiana, main = "Obsidiana: CDA, Distancia y Tamaño")

# Matriz de correlación 
cor_matrix1 <- cor(df_Obsidiana)
print(round(cor_matrix1, 4))
##              x1_Distancia x2_Tamaño Y_Densidad
## x1_Distancia       1.0000    0.6790     0.9191
## x2_Tamaño          0.6790    1.0000     0.8944
## Y_Densidad         0.9191    0.8944     1.0000
RM1c<-lm(Y_Densidad~x1_Distancia+x2_Tamaño)
summary(RM1c)
## 
## Call:
## lm(formula = Y_Densidad ~ x1_Distancia + x2_Tamaño)
## 
## Residuals:
##       1       2       3       4       5 
## -0.6635  0.2380  1.8406 -0.6523 -0.7628 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  -21.85680    5.45596  -4.006   0.0570 .
## x1_Distancia   0.37986    0.08845   4.294   0.0502 .
## x2_Tamaño      0.70099    0.18829   3.723   0.0652 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.564 on 2 degrees of freedom
## Multiple R-squared:  0.9804, Adjusted R-squared:  0.9609 
## F-statistic:  50.1 on 2 and 2 DF,  p-value: 0.01957
RM1x1<-lm(Y_Densidad~x1_Distancia)
summary(RM1x1)
## 
## Call:
## lm(formula = Y_Densidad ~ x1_Distancia)
## 
## Residuals:
##       1       2       3       4       5 
## -0.2586  0.7759  1.8103 -5.1724  2.8448 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  -20.0862    12.4970  -1.607   0.2064  
## x1_Distancia   0.6034     0.1493   4.041   0.0273 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.596 on 3 degrees of freedom
## Multiple R-squared:  0.8448, Adjusted R-squared:  0.7931 
## F-statistic: 16.33 on 1 and 3 DF,  p-value: 0.02726
RM1x2<-lm(Y_Densidad~x2_Tamaño)
summary(RM1x2)
## 
## Call:
## lm(formula = Y_Densidad ~ x2_Tamaño)
## 
## Residuals:
##     1     2     3     4     5 
##  2.50  1.25  1.25  1.25 -6.25 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  -6.2500    10.6225  -0.588   0.5976  
## x2_Tamaño     1.2500     0.3608   3.464   0.0405 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.082 on 3 degrees of freedom
## Multiple R-squared:    0.8,  Adjusted R-squared:  0.7333 
## F-statistic:    12 on 1 and 3 DF,  p-value: 0.04052

Ejercicio: Restos de Fauna

En un estudio de restos de fauna en varias cuevas del Pleistoceno, se cree que el número de fragmentos de huesos de lobo, X1, y de huesos de bóvido, X2, son significativos para predecir el total de fragmentos de la cueva, Y. Los datos de que se dispone son los siguientes:

x1| 1 | 111 | 278 | 63 | 81 | 16 | 24 | 0 | 9 | 5 |18

x2 | 31| 0 | 1622 | 150 | 13 | 3 | 33 | 58 | 107 | 25 | 5

Y| 1211 | 618 | 4260 | 187 | 137 | 249 | 296 | 128 | 505 | 998 | 250

Y_Fcueva<-c(1211,618,4260,187,137,249,296,128,505,998,250)
X1_Flobo<-c(1,111,278,63,81,16,24,0,9,5,18)
X2_FBovido<-c(31,0,1622,150,13,3,33,58,107,25,5)
df_Fauna<- data.frame(  X1_Flobo = X1_Flobo,  X2_FBovido = X2_FBovido,  Y_Fcueva = Y_Fcueva)
print(df_Fauna)
##    X1_Flobo X2_FBovido Y_Fcueva
## 1         1         31     1211
## 2       111          0      618
## 3       278       1622     4260
## 4        63        150      187
## 5        81         13      137
## 6        16          3      249
## 7        24         33      296
## 8         0         58      128
## 9         9        107      505
## 10        5         25      998
## 11       18          5      250
# Visualización Matemática Preliminar 
pairs(df_Fauna, main = "Restos de Fauna: Fauna, Lobo y Bovino")

# Matriz de correlación 
cor_matrix2 <- cor(df_Fauna)
print(round(cor_matrix2, 4))
##            X1_Flobo X2_FBovido Y_Fcueva
## X1_Flobo     1.0000     0.8886   0.8229
## X2_FBovido   0.8886     1.0000   0.9447
## Y_Fcueva     0.8229     0.9447   1.0000
RM2c<-lm(Y_Fcueva~X1_Flobo+X2_FBovido)
summary(RM2c)
## 
## Call:
## lm(formula = Y_Fcueva ~ X1_Flobo + X2_FBovido)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -515.5 -174.6 -134.9  203.9  740.4 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept) 392.8260   172.4990   2.277  0.05229 . 
## X1_Flobo     -1.1484     3.6574  -0.314  0.76156   
## X2_FBovido    2.5471     0.6303   4.041  0.00373 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 437.5 on 8 degrees of freedom
## Multiple R-squared:  0.8939, Adjusted R-squared:  0.8673 
## F-statistic: 33.69 on 2 and 8 DF,  p-value: 0.0001269
RM2x1<-lm(Y_Fcueva~X1_Flobo)
summary(RM2x1)
## 
## Call:
## lm(formula = Y_Fcueva ~ X1_Flobo)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -977.07 -423.13  -86.04  519.36 1055.74 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)  143.275    264.829   0.541  0.60163   
## X1_Flobo      11.985      2.758   4.345  0.00186 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 719.4 on 9 degrees of freedom
## Multiple R-squared:  0.6772, Adjusted R-squared:  0.6413 
## F-statistic: 18.88 on 1 and 9 DF,  p-value: 0.001864
RM2x2<-lm(Y_Fcueva~X2_FBovido)
summary(RM2x2)
## 
## Call:
## lm(formula = Y_Fcueva ~ X2_FBovido)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -531.0 -200.3 -120.4  153.7  775.2 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 362.2857   135.1395   2.681   0.0252 *  
## X2_FBovido    2.3712     0.2742   8.646 1.18e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 415 on 9 degrees of freedom
## Multiple R-squared:  0.8925, Adjusted R-squared:  0.8806 
## F-statistic: 74.76 on 1 and 9 DF,  p-value: 1.184e-05

Ejercicio: Capacidad de Atención Dirigida (CDA) en Adultos Mayores

Los investigadores Jansen y Keller (A-1) llevaron a cabo un estudio con el objetivo de predecir la capacidad de atención dirigida (CDA) en sujetos adultos mayores. Para este propósito, utilizaron como variables predictoras la edad (\(Age\)) y el nivel educativo (\(Ed-Level\)).

La CDA se define operacionalmente en este contexto como la medida de los mecanismos de inhibición neural que permiten enfocar la mente en lo significativo, bloqueando simultáneamente las distracciones. Scores elevados corresponden con un mejor funcionamineto atencional

El estudio recolectó información de un grupo de 71 mujeres mayores residentes en la comunidad que presentaban un estado mental normal.

age <- c(72, 68, 65, 85, 84, 90, 79, 74, 69, 87, 84, 79, 71, 76, 73, 86, 69, 66,
         79, 87, 71, 81, 66, 81, 80, 82, 65, 73, 85, 83, 83, 76, 77, 83, 79, 69)

ed_level <- c(20, 12, 13, 14, 13, 15, 12, 10, 12, 15, 12, 12, 12, 14, 14, 12, 17, 11,
              12, 12, 14, 16, 16, 16, 13, 12, 13, 16, 16, 17, 8, 20, 12, 12, 14, 12)

cda <- c(4.57, -3.04, 1.39, -3.55, -2.56, -4.66, -2.70, 0.30, -4.46, -6.29, -4.43, 
         0.18, -1.37, 3.26, -1.12, -0.77, 3.73, -5.92, 3.17, -1.19, 0.99, -2.94, 
         -2.21, -0.75, 5.07, -5.86, 5.00, 0.63, 2.62, 1.77, -3.79, 1.44, -5.77, 
         -5.77, -4.62, -2.03)

df_cda <- data.frame(  Age = age,  Ed_Level = ed_level,  CDA = cda)
# Visualización Matemática Preliminar 
pairs(df_cda, main = "Matriz de Dispersión: CDA, Edad y Educación")

# Matriz de correlación 
cor_matrix3 <- cor(df_cda)
print(round(cor_matrix3, 4))
##              Age Ed_Level     CDA
## Age       1.0000  -0.0254 -0.2786
## Ed_Level -0.0254   1.0000  0.3973
## CDA      -0.2786   0.3973  1.0000
if(!require(olsrr)) install.packages("olsrr")
## Cargando paquete requerido: olsrr
## 
## Adjuntando el paquete: 'olsrr'
## The following object is masked from 'package:datasets':
## 
##     rivers
library(olsrr)

# Modelo Completo 
modelo_full <- lm(CDA ~ Age + Ed_Level, data = df_cda)

# Selección Forward
seleccion_forward <- ols_step_forward_p(modelo_full, penter = 0.05, details = TRUE)
## Forward Selection Method 
## ------------------------
## 
## Candidate Terms: 
## 
## 1. Age 
## 2. Ed_Level 
## 
## 
## Step   => 0 
## Model  => CDA ~ 1 
## R2     => 0 
## 
## Initiating stepwise selection... 
## 
##                     Selection Metrics Table                     
## ---------------------------------------------------------------
## Predictor    Pr(>|t|)    R-Squared    Adj. R-Squared      AIC   
## ---------------------------------------------------------------
## Ed_Level      0.01642        0.158             0.133    189.107 
## Age           0.09984        0.078             0.051    192.382 
## ---------------------------------------------------------------
## 
## Step      => 1 
## Selected  => Ed_Level 
## Model     => CDA ~ Ed_Level 
## R2        => 0.158 
## 
##                     Selection Metrics Table                     
## ---------------------------------------------------------------
## Predictor    Pr(>|t|)    R-Squared    Adj. R-Squared      AIC   
## ---------------------------------------------------------------
## Age           0.08792        0.230             0.183    187.882 
## ---------------------------------------------------------------
## 
## Step      => 2 
## Selected  => Age 
## Model     => CDA ~ Ed_Level + Age 
## R2        => 0.23 
## 
## 
## Variables Selected: 
## 
## => Ed_Level 
## => Age
# Visualización de Resultados
print(seleccion_forward)
## 
## 
##                              Stepwise Summary                             
## ------------------------------------------------------------------------
## Step    Variable        AIC        SBC       SBIC       R2       Adj. R2 
## ------------------------------------------------------------------------
##  0      Base Model    193.292    196.459    90.757    0.00000    0.00000 
##  1      Ed_Level      189.107    193.858    86.933    0.15785    0.13308 
##  2      Age           187.882    194.216    86.247    0.23001    0.18334 
## ------------------------------------------------------------------------
## 
## Final Model Output 
## ------------------
## 
##                          Model Summary                           
## ----------------------------------------------------------------
## R                       0.480       RMSE                  2.943 
## R-Squared               0.230       MSE                   8.661 
## Adj. R-Squared          0.183       Coef. Var          -265.495 
## Pred R-Squared          0.099       AIC                 187.882 
## MAE                     2.452       SBC                 194.216 
## ----------------------------------------------------------------
##  RMSE: Root Mean Square Error 
##  MSE: Mean Square Error 
##  MAE: Mean Absolute Error 
##  AIC: Akaike Information Criteria 
##  SBC: Schwarz Bayesian Criteria 
## 
##                               ANOVA                                
## ------------------------------------------------------------------
##                Sum of                                             
##               Squares        DF    Mean Square      F        Sig. 
## ------------------------------------------------------------------
## Regression     93.140         2         46.570    4.929    0.0134 
## Residual      311.801        33          9.449                    
## Total         404.941        35                                   
## ------------------------------------------------------------------
## 
##                                    Parameter Estimates                                    
## -----------------------------------------------------------------------------------------
##       model      Beta    Std. Error    Std. Beta      t        Sig       lower     upper 
## -----------------------------------------------------------------------------------------
## (Intercept)     1.496         6.325                  0.236    0.815    -11.373    14.365 
##    Ed_Level     0.525         0.205        0.390     2.555    0.015      0.107     0.942 
##         Age    -0.127         0.072       -0.269    -1.759    0.088     -0.274     0.020 
## -----------------------------------------------------------------------------------------

Ejercicio: Apertura de la boca

El investigador Machiel Naeije estudió la relación entre la apertura máxima de la boca y las mediciones de la mandíbula inferior. El estudio incluyó a 35 sujetos y se centraron en las siguientes variables:Variable Dependiente (\(Y\)): Apertura máxima de la boca (MMO), medida en mm.Variable Predictora (\(X_1\)): Longitud mandibular (ML), medida en mm.Variable Predictora (\(X_2\)): Ángulo de rotación de la mandíbula (RA), medido en grados.

mmo_y <- c(52.34, 51.90, 52.80, 50.29, 57.79, 49.41, 53.28, 59.71, 53.32, 48.53, 
           51.59, 58.52, 62.93, 57.62, 65.64, 52.85, 64.43, 57.25, 50.82, 40.48, 
           59.68, 54.35, 47.00, 47.23, 41.19, 42.76, 51.88, 42.77, 52.34, 50.45, 
           43.18, 41.99, 39.45, 38.91, 49.10)

ml_x1 <- c(100.85, 93.08, 98.43, 102.95, 108.24, 98.34, 95.57, 98.85, 98.32, 92.70, 
           88.89, 104.06, 98.18, 91.01, 96.98, 97.85, 96.89, 98.35, 90.65, 92.99, 
           108.97, 91.85, 104.30, 93.16, 94.18, 89.56, 105.85, 89.29, 92.58, 98.64, 
           83.70, 88.46, 94.93, 96.81, 93.13)

ra_x2 <- c(32.08, 39.21, 33.74, 34.19, 35.13, 30.92, 37.71, 44.71, 33.17, 31.74, 
           37.07, 38.71, 43.89, 41.06, 41.92, 35.25, 45.11, 39.44, 38.33, 25.93, 
           36.78, 42.02, 27.20, 31.37, 27.87, 28.69, 31.04, 32.78, 37.82, 33.36, 
           31.93, 28.32, 24.82, 23.88, 36.17)

df_naeije <- data.frame(MMO = mmo_y,ML  = ml_x1,  RA  = ra_x2)
# Matriz de correlación 
cor_matrix4 <- cor(df_naeije)
print(round(cor_matrix4, 4))
##        MMO     ML     RA
## MMO 1.0000 0.4440 0.8784
## ML  0.4440 1.0000 0.0673
## RA  0.8784 0.0673 1.0000
# Visualización gráfica de las relaciones lineales
pairs(df_naeije,main = "Relaciones entre Apertura Bucal (MMO), Longitud (ML) y Ángulo (RA)",      pch = 21, bg = "lightblue")

# Modelo Completo 
modelo_full1 <- lm(mmo_y ~ ml_x1 + ra_x2, data = df_naeije)

# Selección Forward
seleccion_forward1 <- ols_step_forward_p(modelo_full1, penter = 0.05, details = TRUE)
## Forward Selection Method 
## ------------------------
## 
## Candidate Terms: 
## 
## 1. ml_x1 
## 2. ra_x2 
## 
## 
## Step   => 0 
## Model  => mmo_y ~ 1 
## R2     => 0 
## 
## Initiating stepwise selection... 
## 
##                     Selection Metrics Table                     
## ---------------------------------------------------------------
## Predictor    Pr(>|t|)    R-Squared    Adj. R-Squared      AIC   
## ---------------------------------------------------------------
## ra_x2         0.00000        0.772             0.765    189.810 
## ml_x1         0.00755        0.197             0.173    233.821 
## ---------------------------------------------------------------
## 
## Step      => 1 
## Selected  => ra_x2 
## Model     => mmo_y ~ ra_x2 
## R2        => 0.772 
## 
##                     Selection Metrics Table                     
## ---------------------------------------------------------------
## Predictor    Pr(>|t|)    R-Squared    Adj. R-Squared      AIC   
## ---------------------------------------------------------------
## ml_x1         0.00000        0.920             0.915    154.907 
## ---------------------------------------------------------------
## 
## Step      => 2 
## Selected  => ml_x1 
## Model     => mmo_y ~ ra_x2 + ml_x1 
## R2        => 0.92 
## 
## 
## Variables Selected: 
## 
## => ra_x2 
## => ml_x1