Lab 3: Estadistica Descriptiva 2

1 EJERCICIO 1

Con los datos del archivo SONIC.csv:

dat1 = import ("Lab-3_files/SONIC(1).csv")

dat2= dat1 %>% 
  select(where(is.numeric) & !ends_with(c('_c','_z')))

dat2 %>% head() %>% flextable()

1.1 Regresión Lineal

a.Realice una regresión lineal de Velocidad (km/s) con respecto a Densidad (g/cm3 ) (Velocidad~Densidad),

mod1 = lm(Velocidad_P~Densidad, data= dat1) # modelo de regresión lineal
mod1 %>% tidy()

mod1%>% glance()

1.2 Regresión Cuadrática

2. Realice una regresión cuadrática de Velocidad con respecto a Densidad

mod2 = lm(Velocidad_P ~ Densidad + I(Densidad^2), data = dat1) # modelo de regresión cuadrática
mod2 %>% tidy()

mod2 %>% glance()

1.3 Gráfico regresión lineal y cuadrática

3. Muestre ambas regresiones en un mismo gráfico

ggplot(dat1, aes(Densidad,Velocidad_P)) + geom_point() + geom_smooth(method = 'lm', aes(col='Lineal')) + geom_smooth(method = 'lm', aes(col='Cuadratico'), formula = y~poly(x, 2)) + scale_color_brewer('Modelo',palette = 'Dark2')

`geom_smooth()` using formula 'y ~ x'

1.4 Correlación

4. Estime la correlación utilizando la relación con la pendiente de la regresión lineal, y de la manera convencional (directamente entre las variables). Obtiene el mismo resultado?

x = dat1$Velocidad_P
y = dat1$Densidad

cor(x,y,method = "pearson",
    use = 'pairwise.complete.obs') # coeficiente de correlacion de Pearson

[1] 0.939

cov(x,y,use = 'pairwise.complete.obs') # covarianza

[1] 0.174

Relación entre correlación y regresión simple Estandarizando el modelo con variables originales

lm(Velocidad_P ~ Densidad, data = dat1) %>% 
standardize_parameters(method = 'refit') %>%
flextable() %>%
colformat_double()

map_dbl(dat1,sd) # desviacion estandar de cada columna

   Densidad Velocidad_P   Tipi_Roca 
      0.226       0.819       2.468 

(3.39*0.226/0.819)   # Coeficiente de correlación = Pendiente* Desv.est.Densidad/ Desv.est. Velocidad

[1] 0.935

1.5 Mejor ajuste

Comparando ambos modelos, cuál considera se ajusta mejor a los datos y por qué? (Recuerde que puede usar medidas de ajuste y gráficos diagnóstico)

R/ El modelo lineal tiene un error cuadrático medio de 0.08 el cual es menor que el del modelo cuadrático que es 0.26. Con respecto al R2 el modelo lineal tiene un valor de 0.881 mientras que el modelo cuadrático tiene un valor de 0.900. Según la puntuación de rendimiento (Performance score) el modelo lineal tiene un 66,67% y el modelo cuadrático un 33,33%. Por lo tanto el modelo lineal se ajusta más a los datos.

1.5.1 Gráficos diagnóstico lineal

# plot(mod1) 
check_model(mod1,panel=F)

$PP_CHECK

$NCV

$HOMOGENEITY

$OUTLIERS

$QQ

1.5.2 Gráficos diagnóstico cuadrática

# plot(mod2) 
check_model(mod2,panel=F)

$PP_CHECK

$NCV

$HOMOGENEITY

$OUTLIERS

$VIF

$QQ

1.5.3 Comparación de modelos

TMod(mod1,mod2) # DescTools

modelsummary(list(Lineal=mod1,Cuadratico=mod2),
             title = 'Comparasion de modelos',
             statistic = NULL, # 'conf.int',
             coef_omit = NULL, # 'Int'
             gof_omit = '^(?!R|Num|A)',
             stars = F,
             fmt = 4)

Comparasion de modelos

	Lineal	Cuadratico
(Intercept)	1.2403	18.9099
Velocidad_P	0.2596
Densidad		−11.7417
I(Densidad^2)		2.5487
Num.Obs.	357	357
R2	0.881	0.900
R2 Adj.	0.881	0.900
AIC	−802.3	53.7
RMSE	0.08	0.26

sjPlot::tab_model(mod1,mod2,
                  title = 'Comparasion de modelos',
                  show.std = NULL, # 'std', NULL
                  show.intercept = T,
                  show.ci = F, # .95
                  collapse.ci = F,
                  ci.hyphen = ', ',
                  show.stat = F,
                  show.p = F,
                  show.aic = T,
                  dv.labels = c('Lineal','Cuadrático'),
                  digits = 4,
                  file = 'sjplot_models_lab3.doc')

comp.mods = compare_performance(mod1,mod2,rank = T) # performance
comp.mods

# Comparison of Model Performance Indices

Name | Model |    R2 | R2 (adj.) |  RMSE | Sigma | AIC weights | BIC weights | Performance-Score
------------------------------------------------------------------------------------------------
mod1 |    lm | 0.881 |     0.881 | 0.078 | 0.078 |        1.00 |        1.00 |            66.67%
mod2 |    lm | 0.900 |     0.900 | 0.258 | 0.259 |     < 0.001 |     < 0.001 |            33.33%

plot(comp.mods)

2 EJERCICIO 2

Se tienen 3 grupos de conglomerados, y para cada uno se separan los clastos en mayor o menor a 5 cm. En el conglomerado I hay 20 clastos menores a 5 cm y 16 clastos mayores a 5 cm. En el conglomerado II hay 31 clastos menores a 5 cm y 25 clastos mayores a 5 cm. En el conglomerado III hay 12 clastos menores a 5 cm y 8 clastos mayores a 5 cm.

1. Cuál es la probabilidad de seleccionar un clasto menor a 5 cm?

R/ De la tabla 1 se obtiene que es 56%/100 = 0.56

2. Cuál es la probabilidad de seleccionar un clasto mayor a 5 cm, sabiendo que proviene del conglomerado III?

R/ De la tabla 2 se obtiene que es 40%/100 = 0.40

3. Cuál es la probabilidad de seleccionar un clasto del conglomerado I, sabiendo que es mayor a 5 cm?

R/ De la tabla 3 se obtiene que es 33%/100 = 0.33

4. Cuál es la probabilidad de seleccionar un clasto del conglomerado II?

R/ De la tabla 1 se obtiene que es 50%/100 = 0.50

A = matrix(data = c(16,20,25,31,8,12),nrow = 2,
           dimnames = list(Clasto=c('Mayor a 5','Menor a 5'),
                           Conglomerado=c('I','II','III')))

A.tb = Untable(A) %>% tibble()

tbl_cross(A.tb, percent = 'cell')

Característica	Conglomerado			Total
	I	II	III
Clasto
Mayor a 5	16 (14%)	25 (22%)	8 (7.1%)	49 (44%)
Menor a 5	20 (18%)	31 (28%)	12 (11%)	63 (56%)
Total	36 (32%)	56 (50%)	20 (18%)	112 (100%)

tbl_cross(A.tb, percent = 'column')

Característica	Conglomerado			Total
	I	II	III
Clasto
Mayor a 5	16 (44%)	25 (45%)	8 (40%)	49 (44%)
Menor a 5	20 (56%)	31 (55%)	12 (60%)	63 (56%)
Total	36 (100%)	56 (100%)	20 (100%)	112 (100%)

tbl_cross(A.tb, percent = 'row')

Característica	Conglomerado			Total
	I	II	III
Clasto
Mayor a 5	16 (33%)	25 (51%)	8 (16%)	49 (100%)
Menor a 5	20 (32%)	31 (49%)	12 (19%)	63 (100%)
Total	36 (32%)	56 (50%)	20 (18%)	112 (100%)

NA
NA

3 PARTE A MANO

knitr::include_graphics("Lab3_files/Parte a mano lab3.jpeg")

NA