rm(list=ls())
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(moments)
library(ggplot2)
ruta<-"D:/Dropbox/SantoTomas/20161/Estadística Exploratoria/CorteII/Parcial II"
setwd(ruta)
load("parcial24052016.Rdata")
#Pregunta 1a
head(a)
## directorio localidad estrato sector seccion manzana
## 1 198007 12 3 7307 2 7
## 2 198017 16 3 4304 7 14
## 3 198018 16 3 4309 2 7
## 4 198085 15 3 2102 1 7
## 5 198154 14 3 4111 3 4
## 6 198156 13 4 7202 2 4
head(ing_gastos)
## directorio_hog ingreso gasto
## 1 19800701 4483333.3 4831841.1
## 2 19801701 NA 3027829.3
## 3 19801801 3030000.0 2435573.0
## 4 19808501 954166.7 887512.7
## 5 19815401 6875000.0 3439126.4
## 6 19815601 3787766.7 3334223.0
ing_gastos$directorio<-substr(x = ing_gastos$directorio_hog,start = 1,stop = 6)
head(ing_gastos)
## directorio_hog ingreso gasto directorio
## 1 19800701 4483333.3 4831841.1 198007
## 2 19801701 NA 3027829.3 198017
## 3 19801801 3030000.0 2435573.0 198018
## 4 19808501 954166.7 887512.7 198085
## 5 19815401 6875000.0 3439126.4 198154
## 6 19815601 3787766.7 3334223.0 198156
a$directorio<-as.factor(a$directorio)
ing_gastos$directorio<-as.factor(ing_gastos$directorio)
base1<-right_join(x = a,y = ing_gastos,by="directorio")
head(base1)
## directorio localidad estrato sector seccion manzana directorio_hog
## 1 198007 12 3 7307 2 7 19800701
## 2 198017 16 3 4304 7 14 19801701
## 3 198018 16 3 4309 2 7 19801801
## 4 198085 15 3 2102 1 7 19808501
## 5 198154 14 3 4111 3 4 19815401
## 6 198156 13 4 7202 2 4 19815601
## ingreso gasto
## 1 4483333.3 4831841.1
## 2 NA 3027829.3
## 3 3030000.0 2435573.0
## 4 954166.7 887512.7
## 5 6875000.0 3439126.4
## 6 3787766.7 3334223.0
conteos<-data.frame(table(base1$estrato))
names(conteos)<-c("estrato","Hogares")
ingresos<-aggregate(ingreso~estrato,data = base1,FUN = "mean",na.rm = T)
res1a<-merge(conteos,ingresos)
res1a
## estrato Hogares ingreso
## 1 1 1245 1222946
## 2 2 6000 1552403
## 3 3 6324 2658245
## 4 4 1947 5799054
## 5 5 357 7750068
## 6 6 427 10728670
## 7 9 208 2530696
#Preguta 1b
ingresos_mediana<-aggregate(ingreso~estrato,data = base1, FUN = "median",na.rm = T)
names(ingresos_mediana)<-c("estrato","ingresos_med")
ingresos_des<-aggregate(ingreso~estrato,data = base1, FUN = "sd",na.rm = T)
names(ingresos_des)<-c("estrato","ingresos_des")
res1b<-merge(ingresos_mediana,ingresos_des,by = "estrato")
res1b
## estrato ingresos_med ingresos_des
## 1 1 985000 925754.7
## 2 2 1204750 1632698.8
## 3 3 1929792 2663285.6
## 4 4 4400417 5532453.3
## 5 5 6375000 8056666.1
## 6 6 8000000 9406479.6
## 7 9 1415999 3321418.8
#Pregunta 1c
ingresos_asimetría<-aggregate(ingreso~localidad,data = base1, FUN = "skewness",na.rm = T)
names(ingresos_asimetría)<-c("Localidad","Ingresos_asimetría")
ingresos_curtosis<-aggregate(ingreso~localidad,data = base1, FUN = "kurtosis",na.rm = T)
names(ingresos_curtosis)<-c("Localidad","Ingresos_curtosis")
res1c<-merge(ingresos_asimetría,ingresos_curtosis)
res1c
## Localidad Ingresos_asimetría Ingresos_curtosis
## 1 1 6.368225 69.15728
## 2 2 3.005359 17.99861
## 3 3 3.887981 30.45372
## 4 4 3.485760 27.76611
## 5 5 4.434315 40.01362
## 6 6 4.045271 30.54543
## 7 7 9.392143 180.76374
## 8 8 2.635346 14.93785
## 9 9 2.824767 15.67554
## 10 10 4.360946 37.50408
## 11 11 3.206622 18.84679
## 12 12 3.199465 21.69750
## 13 13 3.442498 22.26609
## 14 14 8.399091 127.91802
## 15 15 4.086723 29.75308
## 16 16 3.312299 21.35199
## 17 17 5.002892 42.21365
## 18 18 8.154096 125.12455
## 19 19 3.138332 21.04298
#Pregunta 2a
head(saber2013)
## codinst nombre cod_municipio municipio
## 1 000059 CENTRO FORMATIVO DE ANTIOQUIA CEFA 05001 MEDELLIN
## 2 000075 COLEGIO SANTOS ANGELES CUSTODIOS 05001 MEDELLIN
## 3 000083 COLEGIO BARBARA MICARELLI 05001 MEDELLIN
## 4 000091 COLEGIO BETHLEMITAS 05001 MEDELLIN
## 5 000125 COLEGIO CALASANZ FEMENINO 05001 MEDELLIN
## 6 000141 COLEGIO CALASANZ 05001 MEDELLIN
## departamento calendario naturaleza jornada matematica
## 1 ANTIOQUIA F OFICIAL MAÃANA 46.82
## 2 ANTIOQUIA A OFICIAL MAÃANA 42.28
## 3 ANTIOQUIA A NO OFICIAL MAÃANA 50.89
## 4 ANTIOQUIA A NO OFICIAL MAÃANA 59.44
## 5 ANTIOQUIA A NO OFICIAL MAÃANA 46.71
## 6 ANTIOQUIA A NO OFICIAL COMPLETA U ORDINARIA 64.66
## quimica fisica biologia filosofia ingles lenguaje sociales de_matematica
## 1 46.79 46.17 47.30 44.23 46.85 51.49 47.40 9.71
## 2 45.23 42.83 43.91 41.43 44.40 48.72 43.15 8.26
## 3 50.96 47.39 48.89 45.93 51.68 51.86 47.68 9.71
## 4 57.58 50.30 54.87 52.94 71.09 56.48 53.98 9.96
## 5 47.82 43.59 45.49 43.34 55.51 49.03 47.15 11.00
## 6 57.32 56.85 54.78 50.15 68.61 57.02 54.86 10.96
## de_quimica de_fisica de_biologia de_filosofia de_ingles de_lenguaje
## 1 7.92 9.39 6.55 8.83 9.47 6.88
## 2 5.81 9.05 6.37 8.47 6.46 6.64
## 3 7.98 10.30 7.18 12.94 11.62 7.37
## 4 8.86 9.17 7.86 9.97 13.77 7.06
## 5 9.27 12.80 9.21 10.21 12.76 9.59
## 6 9.78 11.85 7.42 10.58 14.01 7.10
## de_sociales evaluados periodo estrato
## 1 7.37 1097 20132 OFICIAL Jornada: MAÃANA
## 2 6.73 47 20132 OFICIAL Jornada: MAÃANA
## 3 8.27 28 20132 NO OFICIAL Jornada: MAÃANA
## 4 9.24 86 20132 NO OFICIAL Jornada: MAÃANA
## 5 9.91 97 20132 NO OFICIAL Jornada: MAÃANA
## 6 8.43 131 20132 NO OFICIAL Jornada: COMPLETA U ORDINARIA
## cod_dpto
## 1 05
## 2 05
## 3 05
## 4 05
## 5 05
## 6 05
base2<-subset(saber2013,subset = saber2013$departamento %in% c("BOGOTÃ","ANTIOQUIA","VALLE"))
#boxplot
boxplot(base2$matematica~base2$departamento)
ggplot(base2,aes(x = departamento,y = matematica)) + geom_boxplot()
#Densidad
ggplot(base2,aes(x = matematica,colour = departamento)) + geom_density()
#Pregunta 2b
tabla2<-table(saber2013$jornada)
tabla2
##
## COMPLETA U ORDINARIA MAÃANA NOCHE
## 3839 4778 1197
## SABATINA - DOMINICAL TARDE
## 804 1566
barplot(tabla2)
ggplot(saber2013,aes(x = jornada)) + geom_bar()
# pregunta 3a
saber2013$global<-(saber2013$matematica + saber2013$quimica + saber2013$fisica +
saber2013$biologia + saber2013$filosofia + saber2013$ingles + saber2013$lenguaje +
saber2013$sociales)/8
saber2013$aprobo<-ifelse(saber2013$global>=60,"Aprobo","Reprobo")
table(saber2013$aprobo)
##
## Aprobo Reprobo
## 189 11995
table(saber2013$aprobo)/length(saber2013$aprobo)
##
## Aprobo Reprobo
## 0.01551215 0.98448785
#pregunta 3b
base3b<-saber2013[saber2013$departamento == "BOGOTÃ" & saber2013$evaluados>=10 & saber2013$naturaleza=="OFICIAL",]
table(base3b$aprobo)
##
## Aprobo Reprobo
## 1 652
table(base3b$aprobo)/length(base3b$aprobo)
##
## Aprobo Reprobo
## 0.001531394 0.998468606
#Pregunta 4
orden_base4<-proy[order(proy$P_2015,decreasing = T),]
orden_base4[1:5,]
## Source: local data frame [5 x 5]
##
## DP DPNOM DPMP MPIO P_2015
## (chr) (chr) (chr) (chr) (dbl)
## 1 11 Bogotá, DC 11001 Bogotá, DC 7878783
## 2 05 Antioquia 05001 Medellín 2464322
## 3 76 Valle del Cauca 76001 Cali 2369821
## 4 08 Atlántico 08001 Barranquilla 1218475
## 5 13 Bolívar 13001 Cartagena 1001755
#Pregunta 4a
base4a<-proy[proy$P_2015>1000000,]
base4a
## Source: local data frame [5 x 5]
##
## DP DPNOM DPMP MPIO P_2015
## (chr) (chr) (chr) (chr) (dbl)
## 1 05 Antioquia 05001 Medellín 2464322
## 2 08 Atlántico 08001 Barranquilla 1218475
## 3 11 Bogotá, DC 11001 Bogotá, DC 7878783
## 4 13 Bolívar 13001 Cartagena 1001755
## 5 76 Valle del Cauca 76001 Cali 2369821
#Pregunta 4b
base4b <- left_join(x = base4a,y = saber2013, by=c("DPMP"="cod_municipio"))
aggregate(matematica ~ MPIO,data = base4b,FUN="mean",na.rm = T)
## MPIO matematica
## 1 Barranquilla 45.16242
## 2 Bogotá, DC 47.86613
## 3 Cali 45.14020
## 4 Cartagena 44.54532
## 5 Medellín 45.03625
mean(base4b$matematica)
## [1] 46.42879
#Pregunta 4c
mean(saber2013$matematica)
## [1] 44.2036
#Pregunta 5
proy$P_2015rec<-as.numeric(proy$P_2015<100000)
proy$P_2015rec<-replace(proy$P_2015rec, 100000 <= proy$P_2015 & proy$P_2015 < 500000, 2)
proy$P_2015rec<-replace(proy$P_2015rec, proy$P_2015 >= 500000, 3)
proy$P_2015rec<-as.factor(proy$P_2015rec)
levels(proy$P_2015rec)<-c("menos 100000","entre 100000 y 500000","más de 500000")
table(proy$P_2015rec)
##
## menos 100000 entre 100000 y 500000 más de 500000
## 1060 52 10
base4c <- left_join(x = proy,y = saber2013, by=c("DPMP"="cod_municipio"))
aggregate(global ~ P_2015rec,data = base4c,FUN="mean",na.rm = T)
## P_2015rec global
## 1 menos 100000 42.26357
## 2 entre 100000 y 500000 44.12262
## 3 más de 500000 45.53228