EXAMEN_BÁSICO_R
Maria Alejandra Molina Berbeo
2/3/2021
##EXámen básico de R data science ###Pregunta 1 Leer datos
Estructura de los datos
str(data)## 'data.frame': 6400 obs. of 7 variables:
## $ edad : int 55 56 28 24 25 45 42 35 46 34 ...
## $ estado.civil: Factor w/ 2 levels "Casado","Sin casar": 1 2 1 1 2 1 2 2 2 1 ...
## $ ingreso : int 72 153 28 26 23 76 40 57 24 89 ...
## $ educacion : Factor w/ 5 levels "1 No completó el bachillerato",..: 1 1 3 4 2 3 3 2 1 3 ...
## $ satlab : Factor w/ 5 levels "1 Muy insatisfecho",..: 5 4 3 1 2 2 2 1 5 4 ...
## $ genero : Factor w/ 2 levels "Hombre","Mujer": 2 1 2 1 1 1 1 2 2 1 ...
## $ familia : int 4 1 3 3 2 2 1 1 2 6 ...- Presente una tabla de distribución de frecuencias para el número de integrantes de la familia. Construya una gráfica adecuada. (2.0 puntos)
a=table(data$familia)
barplot(a)
(b) Presente la tabla de distribución de frecuencias (por defecto) para el ingreso y las gráficas respectivas para las frecuencias acumuladas y sin acumular. Interprete sus resultados. (2.0 puntos
#Tabla de distribución
b=table(data$ingreso)
View(b)
#Gráfico de frecuencias sin acumular
barplot(b)#La variable ingreso de la encuesta tiene valores más frencuentes hacia los valores cercanos al 29. Es decir que la mayoría de las personas tiene ingresos bajos, ingresos mayores a los 100, son poco rencuentes dentro de los encuestados.
#Frecuancias absolutas acumuladas
faa=cumsum(data$ingreso)
#Gráfico de frencuencias absolutas acumuladas
plot(faa)
###Pregunta 2 Cargar paquetes
library(Rcpp)
library(mice) ##
## Attaching package: 'mice'## The following object is masked from 'package:stats':
##
## filter## The following objects are masked from 'package:base':
##
## cbind, rbindCargar data y ver estructura de datos
data(boys)
str(boys)## 'data.frame': 748 obs. of 9 variables:
## $ age: num 0.035 0.038 0.057 0.06 0.062 0.068 0.068 0.071 0.071 0.073 ...
## $ hgt: num 50.1 53.5 50 54.5 57.5 55.5 52.5 53 55.1 54.5 ...
## $ wgt: num 3.65 3.37 3.14 4.27 5.03 ...
## $ bmi: num 14.5 11.8 12.6 14.4 15.2 ...
## $ hc : num 33.7 35 35.2 36.7 37.3 37 34.9 35.8 36.8 38 ...
## $ gen: Ord.factor w/ 5 levels "G1"<"G2"<"G3"<..: NA NA NA NA NA NA NA NA NA NA ...
## $ phb: Ord.factor w/ 6 levels "P1"<"P2"<"P3"<..: NA NA NA NA NA NA NA NA NA NA ...
## $ tv : int NA NA NA NA NA NA NA NA NA NA ...
## $ reg: Factor w/ 5 levels "north","east",..: 4 4 4 4 4 4 4 3 3 2 ...- ¿Cuántas filas con valores perdidos hay en el conjunto de datos? ¿Qué porcentaje de todos los valores es? (1.0 punto)
na_columnas=is.na(boys)#Existen 1622 datos perdidos
dim(boys)## [1] 748 9na_porcentaje=(sum(na_columnas)/(748*9))*100# Representa el 24% de los datos- ¿Cuántos atributos (columnas) hay sin ningún dato perdido?? (1.0 punto)
sapply(boys, function(x) sum(is.na(x)))## age hgt wgt bmi hc gen phb tv reg
## 0 20 4 21 46 503 503 522 3#Hay una columna con 0 valores perdidos, esta corresponde a la columana de la edad- ¿ES POSIBLE IDENTIFICAR ALGÚN patrón de datos perdidos? (por ejemplo, la pérdida de información de alguna variable parece estar asociada a otra) (1.0 puntos)
library(VIM)## Loading required package: colorspace## Loading required package: grid## Loading required package: data.table## VIM is ready to use.
## Since version 4.0.0 the GUI is in its own package VIMGUI.
##
## Please use the package to use the new (and old) GUI.## Suggestions and bug-reports can be submitted at: https://github.com/alexkowa/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleepvf=aggr(boys,numbers = T) #Observando el gráfico se puede decir que hay un patron de pérdida de información, es decir que la périda de información entre las variables gen, pbh y tv parece estar asociada, esta combinación de variables representa el 58% de pérdida de información de todos los datos.
vf##
## Missings in variables:
## Variable Count
## hgt 20
## wgt 4
## bmi 21
## hc 46
## gen 503
## phb 503
## tv 522
## reg 3summary(vf)##
## Missings per variable:
## Variable Count
## age 0
## hgt 20
## wgt 4
## bmi 21
## hc 46
## gen 503
## phb 503
## tv 522
## reg 3
##
## Missings in combinations of variables:
## Combinations Count Percent
## 0:0:0:0:0:0:0:0:0 223 29.8128342
## 0:0:0:0:0:0:0:1:0 19 2.5401070
## 0:0:0:0:0:0:1:0:0 1 0.1336898
## 0:0:0:0:0:1:0:1:0 1 0.1336898
## 0:0:0:0:0:1:1:1:0 437 58.4224599
## 0:0:0:0:0:1:1:1:1 3 0.4010695
## 0:0:0:0:1:1:1:1:0 43 5.7486631
## 0:0:1:1:0:1:1:1:0 1 0.1336898
## 0:1:0:1:0:1:1:1:0 16 2.1390374
## 0:1:0:1:1:1:1:1:0 1 0.1336898
## 0:1:1:1:0:0:0:0:0 1 0.1336898
## 0:1:1:1:1:0:0:0:0 1 0.1336898
## 0:1:1:1:1:1:1:1:0 1 0.1336898###Pregunta 3 El conjunto de datos smbsimdf1 de la librería smbinning. Un conjunto de datos simulado donde la variable respuesta o clase esfgood, que representa el estado binario de default(0) y no default (1). El conjunto de datos tiene 2500 instancias y 22 columnas con 500 default.
library(smbinning)## Loading required package: sqldf## Loading required package: gsubfn## Loading required package: proto## Loading required package: RSQLite## Loading required package: partykit## Loading required package: libcoin## Loading required package: mvtnorm## Loading required package: Formuladata(smbsimdf1)
str(smbsimdf1) ## 'data.frame': 2500 obs. of 22 variables:
## $ fgood : num 1 1 1 1 1 1 1 1 1 1 ...
## $ cbs1 : num 60.1 45.6 30.9 62.4 54.4 ...
## $ cbs2 : num NA 66.7 66.9 49.1 41.2 ...
## $ cbinq : Factor w/ 3 levels "00","01","02": 3 3 3 3 1 1 2 3 2 1 ...
## $ cbline : int 2 2 2 3 1 0 1 0 1 2 ...
## $ cbterm : Factor w/ 3 levels "00","01","02": 1 3 1 2 1 1 1 2 1 1 ...
## $ cblineut: num 47.5 52.4 35.9 41.9 44.2 ...
## $ cbtob : int 5 4 5 6 5 7 7 6 4 3 ...
## $ cbdpd : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 2 1 1 1 1 ...
## $ cbnew : Factor w/ 2 levels "No","Yes": 1 1 2 1 1 2 1 1 1 1 ...
## $ pmt : Factor w/ 3 levels "M","A","P": 1 2 1 3 3 2 1 2 1 1 ...
## $ tob : int 2 1 2 4 4 4 0 4 4 1 ...
## $ dpd : Factor w/ 3 levels "00No","01Lo",..: 1 3 3 1 1 2 1 2 1 1 ...
## $ dep : num 10481 10182 9645 13703 18720 ...
## $ dc : int 20 17 23 31 26 31 26 13 21 21 ...
## $ od : Factor w/ 3 levels "00","01","02": 2 2 1 2 3 1 2 2 1 2 ...
## $ home : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 1 1 2 1 1 ...
## $ inc : Factor w/ 10 levels "W01","W02","W03",..: 6 10 5 NA 8 9 NA 9 6 6 ...
## $ dd : Factor w/ 3 levels "00","01","02": 1 1 1 1 2 1 1 2 2 1 ...
## $ online : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 1 2 2 ...
## $ rnd : num 0.466 0.92 0.338 0.765 0.586 ...
## $ period : Date, format: "2018-03-31" "2018-05-31" ...library(arules)## Loading required package: Matrix##
## Attaching package: 'arules'## The following objects are masked from 'package:base':
##
## abbreviate, writelibrary(Fahrmeir)
smbsimdf_2 = na.omit(smbsimdf1)
sd(smbsimdf1$cbs1)## [1] NAscott_c =nclass.scott(smbsimdf_2$cbs1)#23 intervalos
cbs1_scott = discretize(smbsimdf_2$cbs1, #data
method = "interval",#metodo de discretizacion
breaks = scott_c)#valor de k o el rango de cada intervalo
#Presentar intervalos
#Presentar frecuencias absolutas
scott_fa=table(cbs1_scott)#Intervalos
View(scott_fa)
barplot(scott_fa)
- Método ChiMerge.
library(discretization)
cbs1_chim = chiM(data =smbsimdf_2[,c("cbs1","fgood")],
alpha = 0.05) #alpha para chi cuadrado
#presentar intervalos
cbs1_chim$cutp## [[1]]
## [1] 19.245 21.670 22.035 23.980 24.185 26.035 26.325 26.695 27.570 28.960
## [11] 29.190 32.150 33.590 34.000 34.090 34.760 34.810 34.850 34.900 35.040
## [21] 35.280 35.505 36.465 36.740 36.785 37.475 37.695 38.620 38.765 39.810
## [31] 40.030 40.195 40.250 40.605 41.335 41.805 41.880 42.105 42.220 44.125
## [41] 45.240 45.410 46.645 46.755 46.855 46.975 46.990 47.005 47.155 47.655
## [51] 47.770 47.870 48.175 48.185 48.275 48.420 49.480 49.535 50.295 50.375
## [61] 51.105 51.250 51.695 51.775 52.100 52.270 52.645 52.695 53.540 53.555
## [71] 53.600 54.075 54.415 54.485 55.305 55.345 55.420 55.450 55.625 55.635
## [81] 55.950 55.975 56.285 56.525 56.810 56.825 57.260 57.290 57.410 57.470
## [91] 57.975 58.095 58.280 58.315 58.550 58.590 58.660 58.705 58.840 58.865
## [101] 59.320 59.360 59.465 59.505 59.990 60.015 60.185 60.195 61.205 61.215
## [111] 61.860 61.895 62.050 62.075 62.380 62.395 62.425 62.455 63.270 63.320
## [121] 63.885 63.925 64.320 64.340 64.425 64.445 64.520 64.545 64.655 64.720
## [131] 65.350 65.380 66.075 66.155 68.430 68.475 68.660 68.690 69.675 69.825
## [141] 70.055 70.195 70.675 70.770 71.695 71.745 73.205 73.225 75.980 76.245- Por entropía.
cbs1_entropia = mdlp(smbsimdf_2[,c("cbs1","fgood")])
#Presentar intervalos
cbs1_entropia$cutp## [[1]]
## [1] 51.775 59.505#Disitribucion de frecuencias absolutas
entropia_fa =table(cbs1_entropia$Disc.dat[,1])
barplot(entropia_fa)
##PREGUNTA 4
El objetivo de esta pregunta es aplicar el Análisis de Componentes Principales (PCA) en compresión de imágenes. Para realizar este ejercicio requiere trabajar con la foto en blanco y negro del actor mexicano Pedro Infante con nombre de archivo pedro.png
- Lea la imagen en R y guárdelo en un objeto de tipo matriz. Ayuda en R: library(png) y library(grid); help(readPNG)
library(png)
library(grid)
foto = readPNG("D:/Curso_R_Social_data/data_examen/pedro.png")
foto2=as.data.frame(foto)
#foto2=na.omit(foto2)- Aplique el PCA a la matriz de datos obtenida de la imagen importada con columnas centradas en las medias. Con estos resultados, ¿cuál es la variabilidad explicada por la compresión que se obtendría?
library(psych)
library(mvnormtest)
library(ade4)
pc=prcomp(x=foto2,
scale = T,
center = F,
tol=0)
pc_var<-pc$sdev^2
pve<-pc_var/sum(pc_var)#variabilidad
var_exp_comp1= pc_var[1]/sum(pc_var)
var_exp_comp2= pc_var[2]/sum(pc_var)
var_exp_total= var_exp_comp1+var_exp_comp2
round(var_exp_total,2)##El componente principal 1 y 2 capturan el 83% de la varianza total de los datos## [1] 0.83- Reconstruya la imagen original sobre la base de los 20 primeros componentes (y las medias de las columnas de la matriz de datos originales) Guarde la imagen comprimida en el archivo con nombre fotoreducida.png. Adjunte la imagen original y la comprimida junto con la solución de esta pregunta. (2.0 puntos)
plot(pc)
n=20
resultado <- pc$x[,1:n] %*% t(pc$rotation[,1:n])
writePNG(resultado,'D:/Curso_R_Social_data/data_examen/pedro_2.jpg')###PREGUNTA 5 La presente aplicación captura datos socioeconómicos a nivel distrital para la realización de un ejemplo de reducción de dimensiones haciendo uso del análisis de componentes principales.
library(foreign)
data_2 =as.data.frame(read.spss("D:/Curso_R_Social_data/data_examen/AusentismoPres2011.sav")) ## re-encoding from UTF-8data_2=data_2[,c(11,12,13,15,16)]
#Indagar si hay valores nulos en la base
which(is.na(data_2))#Existen tres valores de NA## [1] 441 5940 7773#Imputación de valores por media
library(VIM)
data_2 = initialise(data_2,method = "median")
which(is.na(data_2))# Ya no hay datos faltantes## integer(0)Análisis explortorio
library(stats)
library(ade4)
library(psych)
library(mvnormtest)
#Correlación entre las variables
corr.test(data_2)#Según la correlación de las variables, la variable de IDH y la proporción de hogares sin medios tienen una correlación alta con un R=-78% y están inversamente correlacionadas. Las variables de proporción de hogares sin medios y analfabetismo tienen una correlación inversa con un R=-56%.La variable de proporción de hogares sin medios y porcentaje de hogares con 2 o más necesidades básicas incubiertas tienen una correlación directa con un R=42%. Finalmente el IDH y analfabetismo tienen una correlación directa con un R=85%.## Call:corr.test(x = data_2)
## Correlation matrix
## porc_hogares_sin_medios IDH alfabetismo
## porc_hogares_sin_medios 1.00 -0.78 -0.56
## IDH -0.78 1.00 0.85
## alfabetismo -0.56 0.85 1.00
## porc_2_NBI 0.42 -0.40 -0.23
## GINI -0.18 0.11 0.06
## porc_2_NBI GINI
## porc_hogares_sin_medios 0.42 -0.18
## IDH -0.40 0.11
## alfabetismo -0.23 0.06
## porc_2_NBI 1.00 -0.09
## GINI -0.09 1.00
## Sample Size
## [1] 1833
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## porc_hogares_sin_medios IDH alfabetismo porc_2_NBI
## porc_hogares_sin_medios 0 0 0.00 0
## IDH 0 0 0.00 0
## alfabetismo 0 0 0.00 0
## porc_2_NBI 0 0 0.00 0
## GINI 0 0 0.01 0
## GINI
## porc_hogares_sin_medios 0.00
## IDH 0.00
## alfabetismo 0.01
## porc_2_NBI 0.00
## GINI 0.00
##
## To see confidence intervals of the correlations, print with the short=FALSE optioncortest.bartlett(data_2,
n=dim(data_2)[1])#Según la prueba de esfericidad los datos están correlacioados.## R was not square, finding R from data## $chisq
## [1] 4740.944
##
## $p.value
## [1] 0
##
## $df
## [1] 10mshapiro.test(t(data_2))#El p valor es menor al alpha de 0.05, por lo tanto los datos no provienen de una distribución normal##
## Shapiro-Wilk normality test
##
## data: Z
## W = 0.93345, p-value < 2.2e-16#Hacer el pca
pc2=prcomp(x=data_2,
scale = T,
center = T,
tol=0)
pc2_var =round(pc2$sdev^2,1)#Teniendo en cuenta la prueba de Kaiser, el número de componentes a trabajr es 2.
plot(pc2)
var_exp_comp1= pc2_var[1]/sum(pc2_var)
var_exp_comp2= pc2_var[2]/sum(pc2_var)
var_exp_total= var_exp_comp1+var_exp_comp2
round(var_exp_total,2)## [1] 0.74#El componente principal 1 y 2 capturan el 74% de la varianza total de los datos