Pregunta 1

  1. Considere el archivo de datos EstudiantesMate.csv y el archivo DefinicionVariables.pdf donde se explica la naturaleza de cada una de las variables. Haga un analisis descriptivo para 6 variables de su eleccion. ## Carga de Librerias
library(tidyverse)
library(ggplot2)
library(dplyr)
library(knitr)
library(kableExtra)
library(DataExplorer)
library(SmartEDA)
library(readxl)

Carga de Base de Datos

Datos de la Base de datos

#create_report(base)
#ExpReport(base, op_file = "base.html")
table1 <- ExpData(data=base,type=2)
kable(table1, format = "pipe")
Index Variable_Name Variable_Type Sample_n Missing_Count Per_of_Missing No_of_distinct_values
1 school character 395 0 0 2
2 sex character 395 0 0 2
3 age integer 395 0 0 8
4 address character 395 0 0 2
5 famsize character 395 0 0 2
6 Pstatus character 395 0 0 2
7 Medu integer 395 0 0 5
8 Fedu integer 395 0 0 5
9 Mjob character 395 0 0 5
10 Fjob character 395 0 0 5
11 reason character 395 0 0 4
12 guardian character 395 0 0 3
13 traveltime integer 395 0 0 4
14 studytime integer 395 0 0 4
15 failures integer 395 0 0 4
16 schoolsup character 395 0 0 2
17 famsup character 395 0 0 2
18 paid character 395 0 0 2
19 activities character 395 0 0 2
20 nursery character 395 0 0 2
21 higher character 395 0 0 2
22 internet character 395 0 0 2
23 romantic character 395 0 0 2
24 famrel integer 395 0 0 5
25 freetime integer 395 0 0 5
26 goout integer 395 0 0 5
27 Dalc integer 395 0 0 5
28 Walc integer 395 0 0 5
29 health integer 395 0 0 5
30 absences integer 395 0 0 34

Seleccion de Variables para el analisis

Para la pregunta 1, se tendrian que seleccionar 6 variables, sin embargo se seleccionaran 11 variables para realizar el analsis exploratorio y de estas variables se escogeran las 6 mas principales, si asi lo requiere.

Previamente se verifico que ninguna variable tiene NA o valores omitidos, por lo que el analisis procede sin inconvenientes.

base <- base %>% select(higher, sex, age, Pstatus, Medu, Fedu, studytime,failures, activities, famrel,absences)%>%
  mutate(higher= as.factor(higher),activities = as.factor(activities),
         Pstatus= as.factor(Pstatus), Medu = as.factor(Medu), Fedu= as.factor(Fedu),
         sex = as.factor(sex), studytime = as.factor(studytime))

kable(head(base), format = "pipe")
higher sex age Pstatus Medu Fedu studytime failures activities famrel absences
yes F 18 A 4 4 2 0 no 4 6
yes F 17 T 1 1 2 0 no 5 4
yes F 15 T 1 1 2 3 no 4 10
yes F 15 T 4 2 3 0 yes 3 2
yes F 16 T 3 3 2 0 no 4 4
yes M 16 T 4 3 2 0 yes 5 10

Resumen Estadistico de las variables

kable(summary(base), format = "pipe")
higher sex age Pstatus Medu Fedu studytime failures activities famrel absences
no : 20 F:208 Min. :15.0 A: 41 0: 3 0: 2 1:105 Min. :0.0000 no :194 Min. :1.000 Min. : 0.000
yes:375 M:187 1st Qu.:16.0 T:354 1: 59 1: 82 2:198 1st Qu.:0.0000 yes:201 1st Qu.:4.000 1st Qu.: 0.000
NA NA Median :17.0 NA 2:103 2:115 3: 65 Median :0.0000 NA Median :4.000 Median : 4.000
NA NA Mean :16.7 NA 3: 99 3:100 4: 27 Mean :0.3342 NA Mean :3.944 Mean : 5.709
NA NA 3rd Qu.:18.0 NA 4:131 4: 96 NA 3rd Qu.:0.0000 NA 3rd Qu.:5.000 3rd Qu.: 8.000
NA NA Max. :22.0 NA NA NA NA Max. :3.0000 NA Max. :5.000 Max. :75.000 
summary(base)
 higher    sex          age       Pstatus Medu    Fedu    studytime
 no : 20   F:208   Min.   :15.0   A: 41   0:  3   0:  2   1:105    
 yes:375   M:187   1st Qu.:16.0   T:354   1: 59   1: 82   2:198    
                   Median :17.0           2:103   2:115   3: 65    
                   Mean   :16.7           3: 99   3:100   4: 27    
                   3rd Qu.:18.0           4:131   4: 96            
                   Max.   :22.0                                    
    failures      activities     famrel         absences     
 Min.   :0.0000   no :194    Min.   :1.000   Min.   : 0.000  
 1st Qu.:0.0000   yes:201    1st Qu.:4.000   1st Qu.: 0.000  
 Median :0.0000              Median :4.000   Median : 4.000  
 Mean   :0.3342              Mean   :3.944   Mean   : 5.709  
 3rd Qu.:0.0000              3rd Qu.:5.000   3rd Qu.: 8.000  
 Max.   :3.0000              Max.   :5.000   Max.   :75.000

Distribucion de las variables cuantitativas

Dado que se cuenta con variables cuantitativas y cualitativas tratadas con un formato “factor”, es necesario poder analizarlas por separado.

Primeramente, para las variables cuantitativas es necesaria poder determinar si estas variables se distribuyen de manera normal o tienen un sesgo claro que haria que la distribucion no sea homocedastica y que en el modelo final, los errores esten correlacionados.

ExpOutQQ(base,nlim=4,fname=NULL,Page=c(2,2),sample=nrow(base))
## $`0`

De la anterior figura que puede observar que las cuatros variables cuantitativas, muestran que no tienen una distribucion en comparacion a la distribcion teorica.

La edad, sigue un patron cercano a la teorica, dado que esta variable a pesar de ser una cuantitativa es una variable ordinal y se observa que hay segmentacion de edades.

La relacion de la familia, es una categorica pero se mantiene en ordinal para demostrar en que tipo de relacion familiar, las observaciones se encuentran, siendo que muchos estan situados en la categoria 5 que implica una excelente relacion familiar.

Para la variable " failures", muchos de esta base de datos, no tienen examenes desaprobados, por lo que hay un sesgo positivo para la determinacion de seguir estudiando o no.

Para la variable ausencia de escolares, se muestra tambien un sesgo hacia personas que no teiene ausencias, pero se ve una tendnecia a incrementar el nuemero de ausencias a medida que la data se vuelve mas dispareja.

Correlacion entre variables

library(corrplot)
## Warning: package 'corrplot' was built under R version 4.0.5
library(grDevices)

Correlaciones <- cor(base %>% select(age,famrel, failures,absences))
corrplot(Correlaciones,order = "hclust",addrect = 3, method = "number")

Se puede observar que claramente, existe mayor correlacion entre el numero de cursos desaprobados y la edad del encuestado, pero no implica causalidad.

Tambien hay un indice de correlacion del 18% entre la edad y el numero de ausencias escolares, lo que implicaria que a moyor edad puede que se cumpla que hay mayor auscentismo. Estas dos variables son las resaltables en terminos de correlacion.

Resumen de las Variables Categoricas

Despues de analizar las variables cuantitativas, es necesario poder obtener los resultados de un analsis para las variables cualitativas, especialmenye sus frecuencias relativas, lo que implicaria sesgos de la data para futuros modelos.

table2 <- ExpCTable(base,Target=NULL,margin=1,clim=10,nlim=5,round=2,bin=NULL,per=T)
kable(table2, format = "pipe")
Variable Valid Frequency Percent CumPercent
higher no 20 5.06 5.06
higher yes 375 94.94 100.00
higher TOTAL 395 NA NA
sex F 208 52.66 52.66
sex M 187 47.34 100.00
sex TOTAL 395 NA NA
Pstatus A 41 10.38 10.38
Pstatus T 354 89.62 100.00
Pstatus TOTAL 395 NA NA
Medu 0 3 0.76 0.76
Medu 1 59 14.94 15.70
Medu 2 103 26.08 41.78
Medu 3 99 25.06 66.84
Medu 4 131 33.16 100.00
Medu TOTAL 395 NA NA
Fedu 0 2 0.51 0.51
Fedu 1 82 20.76 21.27
Fedu 2 115 29.11 50.38
Fedu 3 100 25.32 75.70
Fedu 4 96 24.30 100.00
Fedu TOTAL 395 NA NA
studytime 1 105 26.58 26.58
studytime 2 198 50.13 76.71
studytime 3 65 16.46 93.17
studytime 4 27 6.84 100.01
studytime TOTAL 395 NA NA
activities no 194 49.11 49.11
activities yes 201 50.89 100.00
activities TOTAL 395 NA NA
failures 0 312 78.99 78.99
failures 1 50 12.66 91.65
failures 2 17 4.30 95.95
failures 3 16 4.05 100.00
failures TOTAL 395 NA NA
famrel 1 8 2.03 2.03
famrel 2 18 4.56 6.59
famrel 3 68 17.22 23.81
famrel 4 195 49.37 73.18
famrel 5 106 26.84 100.02
famrel TOTAL 395 NA NA

Nuestro anslisis en este segmento se centra en analizar la frecuencia de la variable dependiente, que es higher(implica el deseo de querer tener una educacion superior), donde el 95% de los observados si quieren seguir estudiando

table3 <- prop.table(table(base$higher,base$sex), margin = 1)
kable(table3, format = "pipe")
F M
no 0.200 0.800
yes 0.544 0.456

De los cuales, el 55% son mujeres las que quieren seguir estudiando, y el 20% de quienen no quieren estudiar pertencen a mujeres. Siendo los varones los que no quieren seguir estudiando.

Scater Plots

Es necesario poder determinar el analisis explotario para determinar las correlaciones y signos de sesgos en los datos.

library(gridExtra)
g1 <- base %>% ggplot(aes(age,absences, color= higher)) + geom_point(size= 3) + facet_wrap(.~Medu) + labs(title = "Ausencia  estudiantil por edad segun  nivel de educacion de la madre, que quiere ir a estudiar")
g2 <- base %>% ggplot(aes(age,failures, color= higher)) + geom_point(size= 3) + facet_wrap(.~Medu)+ labs(title = "Cursos fallados de estudiantes por edad segun  nivel de educacion de la madre, que quiere ir a estudiar")
g3 <- base %>% ggplot(aes(absences,failures, color= higher)) + geom_point(size= 3) + facet_wrap(.~Medu)+ labs(title = "Ausencia estudiantil por cursos fallados segun  nivel de educacion de la madre, que quiere ir a estudiar")


g4 <- base %>% ggplot(aes(age,absences, color= sex)) + geom_point(size= 3) + facet_wrap(.~Fedu)+ labs(title = "Ausencia  estudiantil por edad segun  nivel de educacion de la padre, exclusivo al genero")
g5 <- base %>% ggplot(aes(age,failures, color= sex)) + geom_point(size= 3) + facet_wrap(.~Fedu)+ labs(title = "Cursos fallados de estudiantes por edad segun  nivel de educacion de la padre, exclusivo al genero")
g6 <- base %>% ggplot(aes(absences,failures, color= sex)) + geom_point(size= 3) + facet_wrap(.~Fedu)+ labs(title = "Ausencia estudiantil por cursos fallados segun  nivel de educacion de la padre, exclusivo al genero")


g7 <- base %>% ggplot(aes(age,absences, color= Pstatus)) + geom_point(size= 3) + facet_wrap(.~activities)+ labs(title = "Ausencia  estudiantil por edad segun  Estatus parental, exclusivo al requerimiento de actividades extras")
g8 <-base %>% ggplot(aes(age,failures, color= Pstatus)) + geom_point(size= 3) + facet_wrap(.~activities) +labs(title = "Cursos fallados de estudiantes por edad segun Estatus parental, exclusivo al requerimiento de actividades extras")
g9 <-base %>% ggplot(aes(absences,failures, color= Pstatus)) + geom_point(size= 3) + facet_wrap(.~activities)+ labs(title = "Ausencia estudiantil por cursos fallados segun  Estatus parental, exclusivo al requerimiento de actividades extras")


g10 <- base %>% ggplot(aes(absences, fill= higher)) + geom_density(alpha= 0.5) + facet_wrap(.~sex) +labs(title = "Distribucion del ausentismo, por sexo segun condicion de querer estudiar")

g11 <- base %>% ggplot(aes(failures, fill= higher)) + geom_density(alpha= 0.5) + facet_wrap(.~sex)+labs(title = "Distribucion de los cursos fallidos, por sexo segun condicion de querer estudiar")

grid.arrange(g1,g2,g3)

grid.arrange(g4,g5,g6)

grid.arrange(g7,g8,g9)

grid.arrange(g10,g11)

Analisis Regresional

library(stargazer)

Please cite as: 
 Hlavac, Marek (2018). stargazer: Well-Formatted Regression and Summary Statistics Tables.
 R package version 5.2.2. https://CRAN.R-project.org/package=stargazer 
model1 <- glm(higher~ as.numeric(studytime)+sex+ age+failures + absences, data= base, family=binomial(link= logit ))

stargazer(model1, type = "text")

=================================================
                          Dependent variable:    
                      ---------------------------
                                higher           
-------------------------------------------------
as.numeric(studytime)           0.954**          
                                (0.475)          
                                                 
sexM                            -0.989           
                                (0.655)          
                                                 
age                            -0.457**          
                                (0.201)          
                                                 
failures                       -0.726***         
                                (0.243)          
                                                 
absences                        -0.022           
                                (0.027)          
                                                 
Constant                       10.405***         
                                (3.428)          
                                                 
-------------------------------------------------
Observations                      395            
Log Likelihood                  -58.085          
Akaike Inf. Crit.               128.170          
=================================================
Note:                 *p<0.1; **p<0.05; ***p<0.01

Pregunta 2

  1. Considere el archivo de datos : PNAD2015.csv. La Encuesta Na- cional por Muestreo de Hogares - PNAD investiga anualmente,

de manera permanente, características generales de la población, educación, trabajo, ingresos y vivienda y otras, con frecuencia variable, de acuerdo a las necesidades de información del país,

como las características sobre la migración. , fertilidad, matrimo- nio, salud, seguridad alimentaria, entre otros temas. La recopila- ción de estas estadísticas constituye, a lo largo de los 49 años de

realización de la investigación, un importante instrumento para la formulación, validación y evaluación de políticas orientadas al desarrollo socioeconómico y la mejora de las condiciones de vida en Brasil.

Haga un estudio descriptivo para las 5 ciudades con mayor canti- dad de encuestados.

Analsis Exploratorio

Primero cargamos la base de dato y mostramos un resumen de su contenido.

setwd("~/Preg2")
base2 <- read.csv("PNAD2015.csv", header = TRUE)

kable(head(base2), format = "pipe")
Region Sexo Edad ColorPiel AÃ.osEstudio Ingresos
11 0 23 8 12 800
11 1 23 2 12 1150
11 1 35 8 15 880
11 0 46 2 6 3500
11 1 47 8 9 150
11 1 34 8 12 790

Luego hacemos la transaformacion del nombre de la variable AÃ.osEstudio a AñoEstudio.

base2 <- base2 %>% mutate(AñoEstudio = AÃ.osEstudio)%>%
  select(Region, Sexo, Edad, ColorPiel, AñoEstudio, Ingresos) 

base2 %>% head() %>% kable(format = "pipe")
Region Sexo Edad ColorPiel AñoEstudio Ingresos
11 0 23 8 12 800
11 1 23 2 12 1150
11 1 35 8 15 880
11 0 46 2 6 3500
11 1 47 8 9 150
11 1 34 8 12 790

Luego se caracteriza las variables, para tener etiquetas y poder describirlas posteriormente.

base2 <- base2 %>% mutate(Sexo=ifelse(Sexo==0,"Masculino","Femenino"),
                ColorPiel=ifelse(ColorPiel==0,"Indigena",ifelse(ColorPiel==2,"Blanca",                                                             ifelse(ColorPiel==4,"Negra",ifelse(ColorPiel==6,"Amarillo",                                                                                                  ifelse(ColorPiel==8,"Marror","No_precisa"))))))
head(base2)
##   Region      Sexo Edad ColorPiel AñoEstudio Ingresos
## 1     11 Masculino   23    Marror         12      800
## 2     11  Femenino   23    Blanca         12     1150
## 3     11  Femenino   35    Marror         15      880
## 4     11 Masculino   46    Blanca          6     3500
## 5     11  Femenino   47    Marror          9      150
## 6     11  Femenino   34    Marror         12      790

Luego hacemos la prueba que no exista variables omitidas o perdidas, resultando que ninguna variable tiene este resultado.

table3 <- ExpData(data=base2,type=2)
kable(table3, format = "pipe")
Index Variable_Name Variable_Type Sample_n Missing_Count Per_of_Missing No_of_distinct_values
1 Region integer 76840 0 0 27
2 Sexo character 76840 0 0 2
3 Edad integer 76840 0 0 84
4 ColorPiel character 76840 0 0 5
5 AñoEstudio integer 76840 0 0 17
6 Ingresos integer 76840 0 0 1606 
g12 <- base2 %>% ggplot(aes(Sexo, fill= ColorPiel)) + geom_bar(stat = "count") +labs(title = "Distribucion por tipo de sexo segun tipo de piel")
g13 <- base2 %>% ggplot(aes(AñoEstudio, fill= ColorPiel)) + geom_density(alpha=0.5) + facet_wrap(.~Sexo)+labs(title = "Distribucion de los Años de estudio por tipo de sexo segun tipo de piel")
g14 <- base2 %>% ggplot(aes(Ingresos, fill= ColorPiel)) + geom_boxplot() + facet_wrap(.~Sexo)+labs(title = "Distribucion de los Ingresos por tipo de sexo segun tipo de piel")

grid.arrange(g12,g13,g14)

Seleccion de datos

Se selecciona los 5 primeras regiones:

bd_alter <- base2 %>% group_by(Region) %>% summarise(N= n()) %>% arrange(N)
## `summarise()` ungrouping output (override with `.groups` argument)
top5 <- c(bd_alter[(nrow(bd_alter)-5):nrow(bd_alter),1])

base2 <- base2 %>% filter(Region %in% unlist(top5))

Analisis Descriptivo

Para las regiones se hace un analisis exploratiori a nivel descriptivo de los ingresos en funcion de los años de estudio, donde se muestra que a mayor educacion, los niveles de ingresos aumentarian.

Ademas de ello se puede observar claramente que hay una ligera diferencia entre los niveles de ingresos entre varones y mujeres, por lo que puede haber otros factores que generen esta diferenciacion.

g15  <- base2 %>% filter(Region==15) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth() + labs(title = "Region 15: Ingresos en funcion del Estudio, segun sexo por color de piel") + facet_wrap(.~ColorPiel)
g16  <- base2 %>% filter(Region==33) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Region 33: Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)
g17  <- base2 %>% filter(Region==29) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Region 29: Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)
g18  <- base2 %>% filter(Region==43) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Region 43: Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)
g19  <- base2 %>% filter(Region==31) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Region 31: Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)
g20  <- base2 %>% filter(Region==35) %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Region 35: Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)

g15 
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

g16 
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

g17 
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

g18 
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

g19 
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

g20
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

De las graficas anteriores se puede deducir lo siguiente:

Todas las regiones presentan una relacion positiva entre ingresos y estudios, sin embargo la region 33 presenta menos disparidad en los niveles de ingresos segun sexo. Pero si presenta diferencias por tipo de color de piel, por lo que puede que estas regiones tengan presencia de discrimnacion.

La posible discriminacion, estaria situada entre las personas blancas, marrones y negras; de las cuales en todas las regiones, las personas de color Blanca ganan mas que las personas de otros colores en promedio.

La region 43 y la region 35, son las que presentan mayor dispercion y diferencia entre el salario esperado por hombres y mujeres, asi mismo la segmentacion por color de piel se hace mas notoria.

Estas conclusiones pueden deberse a que se tienen mas datos en estas regiones que en las previas antes mencionadas.

g21  <- base2 %>% ggplot(aes(AñoEstudio, Ingresos, col= Sexo)) + geom_point() + geom_smooth()+ labs(title = "Total de Top 5 Regiones : Ingresos en funcion del Estudio, segun sexo por color de piel")+ facet_wrap(.~ColorPiel)
g21
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## Warning: Computation failed in `stat_smooth()`:
## x has insufficient unique values to support 10 knots: reduce k.

Por lo tanto, se envidencia indicios de discrminacion cuando se hace el analisis por regiones, sin embargo en un consolidado en promedio no se observa cambio significativo en salarios por sexo ni por color de piel.

Sin embargo, la mayor dispercion se da en aquellos que estudiaron mas, y cuentan con mas titulos, y es en estos niveles en los que las regiones las Top5 muestran diferencias, especialmente la 43 y la 35.

La poblacion esta mas concentrada en la poblacion de color blanca, marron y negro, pero la poblacion indigena no recibe distinccion, lo que implica algo grave ya que no se les diferencia como a los demas y se les trata a todos ellos como un conjunto separado.

Pregunta 3

  1. Considere el archivo de datos CalCOFI.csv . El conjunto de da- tos de CalCOFI1

representa la serie temporal más larga (desde 1 https://calcofi.org/about-calcofi.html 1949 hasta el presente) y más completa (más de 50.000 estaciones de muestreo) de datos oceanográficos y de larvas de peces del mundo. Incluye datos de abundancia sobre las larvas de más de 250 especies de peces; datos de frecuencia de longitud de larvas y datos de abundancia de huevos en especies comerciales clave;

y datos oceanográficos y de plancton. Los datos físicos, quími- cos y biológicos recopilados a intervalos regulares de tiempo y

espacio rápidamente se volvieron valiosos para documentar los ciclos climáticos en la corriente de California y una variedad de respuestas biológicas a ellos. La investigación de CalCOFI llamó la atención mundial sobre la respuesta biológica al dramático evento de calentamiento del Pacífico en 1957-58 e introdujo el término “El Niño” en la literatura científica.

Elimine las columnas que tienen mas del 7 % de elementos NA. Para encontrar las columnas a eliminar use el siguiente código calcofi <- read.csv(“CalCOFI.csv”) apply(calcofi, 2, function(col)100*sum(is.na(col))/length(col)) Luego, elimine todas las las filas que coincidan con los outliers de la columna R_Depth.

Estudie las siguientes configuraciones para regresionar lineal- mente

Cargando la Base de datos y elimnacion de NA

De esta carga, se lee la base de datos, luego se crea un vector que identifica el porcentaje de NA que se tiene en cada columna de la base.

Luego de ello se procede a verificar aquellas columnas que estan por encima del 7% como porcentaje maximo a permitir NA, todos aquellos que sobrepasen el 7% seran eliminados.

setwd("~/Preg3")

base3 <- read.csv("CalCOFI.csv", header = TRUE)
porcentaje_max_NA_aceptado <- 7

columnas_NA <- apply(base3, 2, function(col)100*sum(is.na(col))/length(col))
columnas_NA <- as.data.frame(round(columnas_NA,2))
# eliminando los nombres del data frame
names(columnas_NA) <- "N.A"

indice_NA <- which(columnas_NA$N.A > porcentaje_max_NA_aceptado)
base3 <- base3[,-indice_NA]

kable(head(base3), format = "pipe")
Cst_Cnt Btl_Cnt Sta_ID Depth_ID Depthm T_degC Salnty STheta RecInd T_prec S_prec NH3q C14A1q C14A2q DarkAq MeanAq IncTim R_Depth R_TEMP R_POTEMP R_SALINITY R_SIGMA R_SVA R_DYNHT R_PRES DIC.Quality.Comment
1 1 054.0 056.0 19-4903CR-HY-060-0930-05400560-0000A-3 0 10.50 33.440 25.649 3 1 2 9 9 9 9 9 0 10.50 10.50 33.440 25.64 233.0 0.00 0
1 2 054.0 056.0 19-4903CR-HY-060-0930-05400560-0008A-3 8 10.46 33.440 25.656 3 2 2 9 9 9 9 9 8 10.46 10.46 33.440 25.65 232.5 0.01 8
1 3 054.0 056.0 19-4903CR-HY-060-0930-05400560-0010A-7 10 10.46 33.437 25.654 7 2 3 9 9 9 9 9 10 10.46 10.46 33.437 25.65 232.8 0.02 10
1 4 054.0 056.0 19-4903CR-HY-060-0930-05400560-0019A-3 19 10.45 33.420 25.643 3 2 2 9 9 9 9 9 19 10.45 10.45 33.420 25.64 234.1 0.04 19
1 5 054.0 056.0 19-4903CR-HY-060-0930-05400560-0020A-7 20 10.45 33.421 25.643 7 2 3 9 9 9 9 9 20 10.45 10.45 33.421 25.64 234.0 0.04 20
1 6 054.0 056.0 19-4903CR-HY-060-0930-05400560-0030A-7 30 10.45 33.431 25.651 7 2 3 9 9 9 9 9 30 10.45 10.45 33.431 25.65 233.5 0.07 30

Eliminacion de los outliers

Para proceder a eliminar los datos es necesario poder estandarizar los datos a fin de encontrar los valores atipicos fuera de una distribucion normal.

estandar <- (base3$R_Depth - mean(base3$R_Depth))/sd(base3$R_Depth) 
indice_outlier <- which(abs(estandar)>3)

base3 <- base3[-indice_outlier,]

Luego es necesario ver las correlaciones enntre las variables antes de analizarlas:

matrix_cor <- base3 %>% filter(!is.na(T_prec), !is.na(S_prec), !is.na(NH3q), !is.na(C14A1q), !is.na(C14A2q), !is.na(DarkAq), !is.na(MeanAq), !is.na(R_SIGMA), !is.na(R_SVA), !is.na(R_DYNHT)) %>% 
  select(Cst_Cnt,Btl_Cnt, Depthm,RecInd,T_prec, S_prec, NH3q, C14A1q,C14A2q, DarkAq,MeanAq,R_Depth,R_TEMP,R_POTEMP,R_SALINITY,R_SIGMA,R_SVA,R_DYNHT,R_PRES) %>% cor()
whiteblack <- c("white", "black")
corrplot(matrix_cor, order = "hclust", addrect = 5, col = whiteblack, bg = "gold2")

Primer modelo sugerido

library(caret)
## Warning: package 'caret' was built under R version 4.0.5
fit1 <- lm(R_SALINITY~R_Depth,data=base3)
stargazer(fit1, type= "text")
## 
## ===================================================
##                           Dependent variable:      
##                     -------------------------------
##                               R_SALINITY           
## ---------------------------------------------------
## R_Depth                        0.001***            
##                                (0.00000)           
##                                                    
## Constant                       33.558***           
##                                 (0.001)            
##                                                    
## ---------------------------------------------------
## Observations                    806,781            
## R2                               0.423             
## Adjusted R2                      0.423             
## Residual Std. Error       0.348 (df = 806779)      
## F Statistic         591,367.000*** (df = 1; 806779)
## ===================================================
## Note:                   *p<0.1; **p<0.05; ***p<0.01
MSE1 <- mean(fit1$residuals^2)
RMSE1 <- sqrt(MSE1)
MAE1 <- mean(abs(fit1$residuals))

Segundo modelo sugerido

fit2 <- lm(R_SALINITY~R_TEMP,data = base3)
stargazer(fit2,type = "text")
## 
## ===================================================
##                           Dependent variable:      
##                     -------------------------------
##                               R_SALINITY           
## ---------------------------------------------------
## R_TEMP                         -0.053***           
##                                (0.0001)            
##                                                    
## Constant                       34.416***           
##                                 (0.001)            
##                                                    
## ---------------------------------------------------
## Observations                    803,534            
## R2                               0.233             
## Adjusted R2                      0.233             
## Residual Std. Error       0.401 (df = 803532)      
## F Statistic         243,732.200*** (df = 1; 803532)
## ===================================================
## Note:                   *p<0.1; **p<0.05; ***p<0.01
MSE2 <- mean(fit2$residuals^2)
RMSE2 <- sqrt(MSE2)
MAE2 <- mean(abs(fit2$residuals))

Tercer modelo sugerido

fit3<- lm(R_SALINITY~R_TEMP+R_Depth,data = base3)
stargazer(fit3,type = "text")
## 
## ===================================================
##                           Dependent variable:      
##                     -------------------------------
##                               R_SALINITY           
## ---------------------------------------------------
## R_TEMP                         0.005***            
##                                (0.0001)            
##                                                    
## R_Depth                        0.001***            
##                                (0.00000)           
##                                                    
## Constant                       33.484***           
##                                 (0.002)            
##                                                    
## ---------------------------------------------------
## Observations                    803,534            
## R2                               0.424             
## Adjusted R2                      0.424             
## Residual Std. Error       0.347 (df = 803531)      
## F Statistic         296,143.300*** (df = 2; 803531)
## ===================================================
## Note:                   *p<0.1; **p<0.05; ***p<0.01
MSE3 <- mean(fit3$residuals^2)
RMSE3 <- sqrt(MSE3)
MAE3 <- mean(abs(fit3$residuals))

Verificacion del modelo

MSET <- c(MSE1,MSE2,MSE3)
RMSET <- c(RMSE1,RMSE2,RMSE3)
MAET <- c(MAE1,MAE2,MAE3)

MSET  <- as.data.frame(MSET)
RMSET <- as.data.frame(RMSET)
MAET  <-as.data.frame(MAET)

comparacion <- cbind(MSET, RMSET, MAET)


row.names(comparacion) <- c("Modelo 1","Modelo 2","Modelo 3")
comparacion
##               MSET     RMSET      MAET
## Modelo 1 0.1209058 0.3477151 0.2465590
## Modelo 2 0.1606247 0.4007801 0.2814501
## Modelo 3 0.1205145 0.3471520 0.2492113
g22 <- comparacion %>% ggplot(aes(row.names(comparacion),MSET))+geom_bar(stat = "identity") + labs(title = "Modelo: MSE de los modelos")
g23 <- comparacion %>% ggplot(aes(row.names(comparacion),MAET))+geom_bar(stat = "identity")+ labs(title = "Modelo : MAE de los modelos")
g24 <- comparacion %>% ggplot(aes(row.names(comparacion),RMSET))+geom_bar(stat = "identity")+ labs(title = "Modelo : RMSE de los modelos")

grid.arrange(g22,g23,g24, nrow=1)

De lo siguiente se puede observar que el mejor modelo es el Modelo 3, que tiene el menor MSET de 0.120 y el menor RMSET de 0.347 y el segundo mejor MAE de 0.249; Modelo de R_SALINITY = R_TEMP + R_Depth.

Pregunta

Considere el archivo Reactiva_Peru_Lista_de_empresas_al_30102020.xlsx

el cual muestra la información relacionada al programa de ga- rantías Reactiva Perú. El Programa de Garantías del Gobierno

Nacional “Reactiva Perú”, creado mediante Decreto Legisla- tivo 1455, y modificado mediante Decreto Legislativo 1457, es

un programa sin precedentes en nuestro país, que tiene como objetivo dar una respuesta rápida y efectiva a las necesidades de liquidez que enfrentan las empresas ante el impacto del COVID-19. Así, el Programa busca asegurar la continuidad en la cadena

de pagos, otorgando garantías a las micro, pequeñas, me- dianas y grandes empresas a fin de que puedan acceder a

créditos de capital de trabajo, y puedan cumplir de esta mane- ra con sus obligaciones de corto plazo con sus trabajadores y

proveedores de bienes y servicios. El Gobierno Nacional, a través del Ministerio de Economía y Finanzas, garantiza los créditos colocados por las Empresas del Sistema Financiero (ESF). El programa se inició con S/30

000 millones en garantías, posteriormente, mediante el De- creto Legislativo 1485 se amplió el monto de las garantías en

S/30,000 millones adicionales, llegando a S/60 000 millones, equivalentes al 8 Mediante el Decreto Supremo 124-2020-EF se modificó el Programa “Reactiva Perú” con el objetivo de ampliar el monto máximo de los créditos a otorgar y flexibilizar las condiciones priorizando el acceso de las microempresas. Realice un estudio descriptivo univariado y bivariado de las variables: a) SECTOR ECONÓMICO b) NOMBRE DE ENTIDAD OTORGANTE DEL CRÉDITO c) MONTO PRÉSTAMO (S/) d) MONTO COBERTURADO (S/) e) DEPARTAMENTO

Por lo que el primer paso es cargar el archivo:

setwd("~/Preg4")
base4 <- read_excel("Reactiva_Peru_Lista_de_empresas_al_30102020.xlsx", skip = 2, col_names = TRUE)
## New names:
## * `` -> ...1
kable(head(base4), format= "pipe")
…1 RAZÓN SOCIAL RUC/DNI SECTOR ECONÓMICO NOMBRE DE ENTIDAD OTORGANTE DEL CRÉDITO NOMBRE DE 2DA. ENTIDAD OTORGANTE DEL CRÉDITO* MONTO PRÉSTAMO (S/) MONTO COBERTURADO (S/) DEPARTAMENTO
1