Actividad 3
Emilio Perfecto Martínez Arévalo
7/11/2021
EJERCICIO 1:
Procedemos a descargar la base de datos y mostrar algunas las caracteristicas de la base de datos. - 14 columnas - 356 filas
library(readxl)
datosRendimientos <- read_excel("C:/Users/permi/Desktop/CIDE/Primer semestre/R/datosRendimientos.xlsx")
glimpse(datosRendimientos)## Rows: 356
## Columns: 14
## $ No <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, ~
## $ Marca <chr> "Acura", "Acura", "Acura", "Acura",~
## $ `MAKE MODEL` <chr> "ILX", "RLX", "RLX HYBRID", "TLX", ~
## $ CLASS <chr> "C", "M", "M", "C", "C", "T", "I", ~
## $ `ENGINE SIZE (L)` <dbl> 2.4, 3.5, 3.5, 2.4, 3.5, 1.8, 5.9, ~
## $ CYLINDERS <dbl> 4, 6, 6, 4, 6, 4, 12, 12, 12, 8, 8,~
## $ TRANSMISSION <chr> "AM8", "AS6", "AM7", "AM8", "AS9", ~
## $ `FUEL TYPE` <chr> "Z", "Z", "Z", "Z", "Z", "Z", "Z", ~
## $ `CONSUMPTION CITY (L/100 KM)` <dbl> 9.3, 11.9, 8.0, 9.6, 11.2, 9.7, 18.~
## $ `CONSUMPTION HIGHWAY (L/100 KM)` <dbl> 6.6, 7.7, 7.5, 6.6, 7.5, 6.9, 12.6,~
## $ `CONSUMPTION COMBINED (L/100 KM)` <dbl> 8.1, 10.0, 7.7, 8.3, 9.6, 8.4, 15.6~
## $ `$ PER YEAR` <dbl> 2009, 2480, 1910, 2058, 2381, 2083,~
## $ `CO2 EMISSIONS (g/km)` <dbl> 189, 235, 180, 196, 226, 197, 365, ~
## $ `CO2 RATING` <dbl> 7, 5, 7, 7, 5, 7, 2, 3, 3, 3, 2, 3,~1. Como primer punto comprender las caracterIsticas de tabla de datos, es decir: dimension de la tabla, entender el significado tecnico de las variables o columnas (no se requiere que reporte algo en este inciso).
2. Verifique si hay valores perdidos en los registros en cada una de sus variables.
#Por medio de la funcion is.na buscamos los valores perdidos de cada variables, si hay, las sumamos y las asiganmos a una variable.
Na_No<- sum(is.na(datosRendimientos$No))
Na_Marca<- sum(is.na(datosRendimientos$Marca))
Na_Make_model<- sum(is.na(datosRendimientos$`MAKE MODEL`))
Na_Class<- sum(is.na(datosRendimientos$CLASS))
Na_Engine_size<- sum(is.na(datosRendimientos$`ENGINE SIZE (L)`))
Na_CYL<- sum(is.na(datosRendimientos$CYLINDERS))
Na_TRANS<- sum(is.na(datosRendimientos$TRANSMISSION))
Na_Fuel<- sum(is.na(datosRendimientos$`FUEL TYPE`))
Na_Consum_C<- sum(is.na(datosRendimientos$`CONSUMPTION CITY (L/100 KM)`))
Na_Consum_H<- sum(is.na(datosRendimientos$`CONSUMPTION HIGHWAY (L/100 KM)`))
Na_Consum_comb<- sum(is.na(datosRendimientos$`CONSUMPTION COMBINED (L/100 KM)`))
Na_co2<- sum(is.na(datosRendimientos$`CO2 EMISSIONS (g/km)`))
Na_co2_ra<- sum(is.na(datosRendimientos$`CO2 RATING`))
Na_Money<- sum(is.na(datosRendimientos$`$ PER YEAR`))
#Creamos una tabla que despliegue el total de valores perdidos por cada variable
Missing_Values<- data.frame(Na_No,Na_Marca,Na_Make_model,Na_Class,Na_Engine_size,Na_CYL,Na_TRANS,Na_Fuel,Na_Consum_C,Na_Consum_H,Na_Consum_comb,Na_co2,Na_co2_ra,Na_Money)
rownames(Missing_Values)<-c(" Total Missing Values")
colnames(Missing_Values)<-c("No","Marca","Mark M","Class","Eng Size","Cylinders","Transimission","Fuel Type","Consumptions C","Consumption H","Consumption Comb","Co2","C02 _R","$")
knitr::kable(Missing_Values, "pipe")| No | Marca | Mark M | Class | Eng Size | Cylinders | Transimission | Fuel Type | Consumptions C | Consumption H | Consumption Comb | Co2 | C02 _R | $ | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Total Missing Values | 0 | 0 | 9 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 10 |
3. A las columnas de la tabla asignele el tipo de variable que le corresponde: si es numérico, categórico, fecha, etc. Después, verifique en el caso de las variables númericas, al realizar esta coerción, no hayan aumentado los valores de los NA´s. Recuerde esto último sucede porque es probable que algunos valores númericos presentaton errores al momento de capturarlos. Descarte del estudio los casos donde se haya presentado dicha problemática (mencione cuales serían, si fuera el caso).
# En este caso cambio a factor las variables que pueden usarse mejor como factor ya que están identificadas los valores y se repiten.
datosRendimientos$`MAKE MODEL`<- as.factor(datosRendimientos$`MAKE MODEL`)
datosRendimientos$Marca<- as.factor(datosRendimientos$Marca)
datosRendimientos$CLASS<- as.factor(datosRendimientos$CLASS)
datosRendimientos$`ENGINE SIZE (L)`<- as.factor(datosRendimientos$`ENGINE SIZE (L)`)
datosRendimientos$CYLINDERS<- as.factor(datosRendimientos$CYLINDERS)
datosRendimientos$TRANSMISSION<- as.factor(datosRendimientos$TRANSMISSION)
datosRendimientos$`FUEL TYPE`<- as.factor(datosRendimientos$`FUEL TYPE`)
datosRendimientos$`CO2 RATING`<- as.factor(datosRendimientos$`CO2 RATING`)4. A los valores perdidos del inciso 2) asignele el valor igual a cero, si fuera el caso de haber encontrado valores perdidos.
datosRendimientos$`MAKE MODEL`[is.na(datosRendimientos$`MAKE MODEL`)]<-"0"
datosRendimientos$CLASS[is.na(datosRendimientos$CLASS)]<-"0"
datosRendimientos$`ENGINE SIZE (L)`[is.na(datosRendimientos$`ENGINE SIZE (L)`)]<-"0"
datosRendimientos$CYLINDERS[is.na(datosRendimientos$CYLINDERS)]<-0
datosRendimientos$TRANSMISSION[is.na(datosRendimientos$TRANSMISSION)]<-"0"
datosRendimientos$`FUEL TYPE`[is.na(datosRendimientos$`FUEL TYPE`)]<-"0"
datosRendimientos$`CONSUMPTION CITY (L/100 KM)`[is.na(datosRendimientos$`CONSUMPTION CITY (L/100 KM)`)]<-0
datosRendimientos$`CONSUMPTION HIGHWAY (L/100 KM)`[is.na(datosRendimientos$`CONSUMPTION HIGHWAY (L/100 KM)`)]<-0
datosRendimientos$`CONSUMPTION COMBINED (L/100 KM)`[is.na(datosRendimientos$`CONSUMPTION COMBINED (L/100 KM)`)]<-0
datosRendimientos$`CO2 EMISSIONS (g/km)`[is.na(datosRendimientos$`CO2 EMISSIONS (g/km)`)]<-0
datosRendimientos$`CO2 RATING`[is.na(datosRendimientos$`CO2 RATING`)]<-0
datosRendimientos$`$ PER YEAR`[is.na(datosRendimientos$`$ PER YEAR`)]<-0
#Procedemos a verificar que ya no haya Valores perdidos.
sum(is.na(datosRendimientos))## [1] 215. Verifique que no haya valores repetidos (si hay, eliminar uno de los repetidos).
- Mi lógica me dice que si hay valores repetidos como la marca o modelo, pero no sirve de nada eliminarlas. Procedo a verificar si hay filas completas repetidas.
#Usamos la función duplicated por fila
nrow(datosRendimientos[duplicated(datosRendimientos), ])## [1] 0- No las hay.
6. Considere que Fernanda Esquinca es una mujer que esta proxima a comprar un automovil. Usted que es amiga de Fernanda y tiene conocimiento de esta base de datos. ¿Cuál automovil le recomendaría como el mejor para ella? Considere que Fernanda es una mujer que tiene 28 años de edad, soltera, trabaja como gerente de un super mercado; ademas, ella vive en Rincón de Romos y viaja diariamente a la ciudad de Aguascalientes. Proporcione medidad estadisticas para fundamentar su respuestas.
- Dado que se transporta ella sola, le recomendaria primero un coche seguro y espacioso, por ello filtraré la base de datos solo con vehiculos de clase Mid-size(M).
carros1<-datosRendimientos %>%
select(`MAKE MODEL`,CLASS,`ENGINE SIZE (L)`,CYLINDERS,TRANSMISSION,`FUEL TYPE`,`CONSUMPTION COMBINED (L/100 KM)`,`$ PER YEAR`,) %>% filter(str_detect(CLASS, "M"))- Depués le recomendaria un coche con un cilindraje medio, pensando que necesita potencia para transportarse a la ciudad de Aguascalientes pero tampoco quiere un super deportivo.
carros2 <-carros1 %>% filter(str_detect(as.character(CYLINDERS) , "4"))- Para que maneje más comoda le recomendaría un coche con transmisión automática de 5 velocidades
carros3<-carros2 %>% filter(str_detect(TRANSMISSION, "A"))- De igual forma, pienso que un coche de gasolina regular no le daría problemas.
carros4<-carros3 %>% filter(str_detect(`FUEL TYPE`, "X"))- Por ultimo, de los que sobran le recomendaría el que tenga el menor gasto por año.
carros5<-carros4 %>% filter(`$ PER YEAR` == min(`$ PER YEAR`, na.rm = T))
carros5$`MAKE MODEL`## [1] FUSION HYBRID
## 236 Levels: 300 300 (MDS) 300 AWD 300 AWD FFV ... XTS Vsport AWDFinalmente el ganador es un Fusion Hybrid.
EJERCICIO 2:
Para la tabla de datos datosAct.xlsx elabore una funcion que le permita etiquetar de forma adecuada la variable sexo. Emplear un bucle for para llevarlo a cabo.
#Procedenmos a imnportar la base de datos
library(readxl)
datosAct <- read_excel("C:/Users/permi/Desktop/CIDE/Primer semestre/R/datosAct.xlsx")
#Cambiamos los valores de la variable sexo a minusculas
datosAct$sexo <- tolower(datosAct$sexo)
#Creamos un vector de NA´s donde se almacenará el nuevo etiquetado
sexo2<-rep(NA,40)
#Función
for (i in 1:40){
if(datosAct$sexo[i] == "hombre"|datosAct$sexo[i] == "h"|datosAct$sexo[i] == "masculino"){sexo2[i]<-"masculino"}else{sexo2[i]<-"femenino"}
}
#Asignamos el vector donde se almacenó el nuevo etiquetado a la columna sexo de la base de datos
datosAct$sexo <- as.factor(sexo2)
#Comprobamos que haya funcionado.
summary(datosAct$sexo)## femenino masculino
## 19 21EJERCICIO 3:
Utilizando la información y contexto del problema de ingresos brindado el día 21-octubre-2021 en la sesión de Laboratorio, y utilizando la base de datos datosAct, elabore una función que le permita estimar el ingreso de las personas bajo estudio.
#Procedemos a crear la tabla de estimación de salarios por ocupación.
#Cambiamos el nombre de la ocupación porque estan mal escritos
Area<-c("POLITICA","BIOLOGIA","ARQUITECTURA","INGENIERIA","DERECHO","HUMANIDADES","ARTES","EDUACION","SALUD")
Ingr_prom<-c(85000,13812,13549,12283,12500,10365,9768,9540,8500)
Est_ingr<-data.frame(Area,Ingr_prom)
colnames(Est_ingr)<-c("Area","Ingreso Promedio $")
knitr::kable(Est_ingr, "pipe")| Area | Ingreso Promedio $ |
|---|---|
| POLITICA | 85000 |
| BIOLOGIA | 13812 |
| ARQUITECTURA | 13549 |
| INGENIERIA | 12283 |
| DERECHO | 12500 |
| HUMANIDADES | 10365 |
| ARTES | 9768 |
| EDUACION | 9540 |
| SALUD | 8500 |
Con la siguiente proposición Estudios comfirman que las mujeres obreras padecen de desigualdad en del 10% con respecto a los hombres
#Procedemos a cambiar el nombre del empleo de la base de datos "datosAct"en función del area de la tabla anterior.
#Cambiamos los valores de la variable sexo a minusculas
datosAct$empleo <- tolower(datosAct$empleo)
#Creamos un vector de NA´s donde se almacenará el nuevo etiquetado
sexo3<-rep(NA,40)
#Función
for (i in 1:40){
if(datosAct$empleo[i]=="politico"){sexo3[i]<-"POLITICO"}
if(datosAct$empleo[i]=="abogado"){sexo3[i]<-"ABOGADO"}
if(datosAct$empleo[i]=="mtro"){sexo3[i]<-"EDUCACION"}
if(datosAct$empleo[i]=="enfermeria"){sexo3[i]<-"SALUD"}
if(datosAct$empleo[i]=="obrero"){sexo3[i]<-"OBRERO"}
}
#cambiamos la columna de empleo con el vector dónde vienen los empleos escritos de una mejor forma.
datosAct$empleo<-sexo3
#Creamos una función para cambiar el ingreso en función del sexo y el empleo
ingreso2<-rep(NA,40)
for (i in 1:40){
if(datosAct$empleo[i]=="SALUD"){ingreso2[i]<-8500}
if(datosAct$empleo[i]=="POLITICO"){ingreso2[i]<-85000}
if(datosAct$empleo[i]=="ABOGADO"){ingreso2[i]<-12500}
if(datosAct$empleo[i]=="EDUCACION"){ingreso2[i]<-9540}
if(datosAct$empleo[i]=="OBRERO"){ingreso2[i]<-12283}
}
datosAct$ingreso<-ingreso2EJERCICIO 4:
Estimar los valores perdidos de la variable peso a partir de la variable altura. Utilizar el metodo de Regresion Lineal simple por minimos cuadrados con X = altura.
#Verficamos que no haya valores perdidos cambiandolos a 0 de las dos columnas que usaremos
datosAct[is.na(datosAct)]<-0
#Procedemos a graficar la variable altura y la variable peso
plot(datosAct$altura, datosAct$peso)
#Con la función lm hacemos una regresión donde la variable altura es X y la variable peso es Y
Peso_regression <- lm(peso ~ altura, data = datosAct)
#Con summary vemos los estadisticos de la regresión
summary(Peso_regression)##
## Call:
## lm(formula = peso ~ altura, data = datosAct)
##
## Residuals:
## Min 1Q Median 3Q Max
## -79.078 -0.867 4.111 8.605 15.754
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -26.0613 45.5951 -0.572 0.5710
## altura 0.5593 0.2623 2.132 0.0395 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 18.08 on 38 degrees of freedom
## Multiple R-squared: 0.1068, Adjusted R-squared: 0.08334
## F-statistic: 4.546 on 1 and 38 DF, p-value: 0.03953#graficamos la linea que mas se ajusta a los datos
abline(Peso_regression, col="blue")
#Buscamos dónde estan los valores perdidos en la columna peso
which(is.na(datosAct$peso))## integer(0)#Mostramos sus correspondientes valores de altura
datosAct[33,6]## # A tibble: 1 x 1
## altura
## <dbl>
## 1 164.datosAct[38,6]## # A tibble: 1 x 1
## altura
## <dbl>
## 1 188#Con la función predict, estimamos el peso para esas alturas respectivaente
predict(Peso_regression, data.frame(altura = c(164.5)))## 1
## 65.93543predict(Peso_regression, data.frame(altura = c(188.0)))## 1
## 79.07782#Asignamos a los NAS sus valores estimados
datosAct[33,7] <- predict(Peso_regression, data.frame(altura = c(164.5)))
datosAct[38,7] <- predict(Peso_regression, data.frame(altura = c(188.0)))
knitr::kable(datosAct, "pipe")| encuestador | sexo | empleo | ingreso | edad | altura | peso |
|---|---|---|---|---|---|---|
| arturo | masculino | SALUD | 8500 | 51 | 150.5 | 64.00000 |
| arturo | masculino | OBRERO | 12283 | 33 | 155.7 | 62.00000 |
| arturo | masculino | EDUCACION | 9540 | 47 | 170.8 | 76.00000 |
| arturo | masculino | OBRERO | 12283 | 38 | 166.0 | 67.00000 |
| arturo | masculino | ABOGADO | 12500 | 46 | 192.5 | 90.00000 |
| arturo | femenino | EDUCACION | 9540 | 47 | 171.7 | 80.00000 |
| arturo | femenino | OBRERO | 12283 | 55 | 164.8 | 75.00000 |
| arturo | femenino | SALUD | 8500 | 40 | 173.0 | 65.00000 |
| arturo | masculino | POLITICO | 85000 | 57 | 179.8 | 83.00000 |
| arturo | femenino | ABOGADO | 12500 | 0 | 166.3 | 68.00000 |
| jessica | femenino | EDUCACION | 9540 | 56 | 168.5 | 62.00000 |
| jessica | masculino | OBRERO | 12283 | 47 | 175.0 | 79.00000 |
| jessica | masculino | EDUCACION | 9540 | 36 | 155.8 | 65.00000 |
| jessica | masculino | EDUCACION | 9540 | 51 | 188.0 | 88.00000 |
| jessica | femenino | EDUCACION | 9540 | 41 | 188.3 | 74.00000 |
| jessica | masculino | ABOGADO | 12500 | 26 | 160.0 | 63.00000 |
| jessica | femenino | OBRERO | 12283 | 52 | 179.4 | 86.00000 |
| jessica | femenino | ABOGADO | 12500 | 55 | 176.4 | 81.00000 |
| jessica | masculino | SALUD | 8500 | 42 | 180.2 | 88.00000 |
| jessica | femenino | ABOGADO | 12500 | 40 | 188.3 | 95.00000 |
| susy | femenino | ABOGADO | 12500 | 52 | 165.2 | 68.00000 |
| susy | masculino | OBRERO | 12283 | 62 | 166.0 | 76.00000 |
| susy | masculino | OBRERO | 12283 | 49 | 166.0 | 70.00000 |
| susy | masculino | SALUD | 8500 | 49 | 168.4 | 63.00000 |
| susy | masculino | OBRERO | 12283 | 58 | 186.3 | 83.00000 |
| susy | femenino | OBRERO | 12283 | 64 | 176.3 | 70.00000 |
| susy | femenino | OBRERO | 12283 | 49 | 184.3 | 75.00000 |
| susy | femenino | OBRERO | 12283 | 39 | 173.6 | 80.00000 |
| susy | femenino | POLITICO | 85000 | 70 | 166.0 | 66.00000 |
| susy | femenino | ABOGADO | 12500 | 44 | 181.3 | 76.00000 |
| pedro | masculino | OBRERO | 12283 | 47 | 160.4 | 68.00000 |
| pedro | masculino | EDUCACION | 9540 | 40 | 183.3 | 76.00000 |
| pedro | femenino | SALUD | 8500 | 34 | 164.5 | 65.93543 |
| pedro | masculino | SALUD | 8500 | 44 | 178.4 | 78.00000 |
| pedro | masculino | SALUD | 8500 | 49 | 191.7 | 80.00000 |
| pedro | masculino | OBRERO | 12283 | 33 | 168.0 | 73.00000 |
| pedro | femenino | OBRERO | 12283 | 45 | 155.9 | 54.30000 |
| pedro | femenino | EDUCACION | 9540 | 49 | 188.0 | 79.07782 |
| pedro | femenino | OBRERO | 12283 | 46 | 186.0 | 88.00000 |
| pedro | masculino | OBRERO | 12283 | 80 | 178.6 | 83.00000 |
EJERCICIO 5:
Sea X una variable aleatoria Binomial (n,p) y Y una variable Binomial condicionada en X; esto es (Y|X=x) tiene una distribución Binomial (X+1,q).
1. Hacer la funcion masa de probabilidad conjunta X,Y cuando n=5, p=0.5 y q=0.5.
\[P_{Y|X}(y|x)=\frac{P(x,y)}{P_{X}(x)}\] \[P(x,y)=P_{Y|X}(y|x)P_{X}(x)\] \[P(x,y)=[\binom{x+1}{y}q^y(1-q)^{x+1-y}][\binom{n}{x}p^x(1-p)^{n-x}]\]
#Definimos las variables
q <- 0.5
p <- 0.5
n <- 5
#Creamos la matriz donde se almacerará la probabilidad.
matriz_1<-matrix(NA, nrow = n+2, ncol = n+1)
for (k in 1:7){
for(j in 1:6){
matriz_1[k,j]<- dbinom((k-1),j,q)* dbinom((j-1),n,p)
}
}
colnames(matriz_1)<-c(0:5)
row.names(matriz_1)<-c(0:6)
knitr::kable(matriz_1, "pipe", caption = "Función de probabilidad conjunta.")| 0 | 1 | 2 | 3 | 4 | 5 | |
|---|---|---|---|---|---|---|
| 0 | 0.015625 | 0.0390625 | 0.0390625 | 0.0195312 | 0.0048828 | 0.0004883 |
| 1 | 0.015625 | 0.0781250 | 0.1171875 | 0.0781250 | 0.0244141 | 0.0029297 |
| 2 | 0.000000 | 0.0390625 | 0.1171875 | 0.1171875 | 0.0488281 | 0.0073242 |
| 3 | 0.000000 | 0.0000000 | 0.0390625 | 0.0781250 | 0.0488281 | 0.0097656 |
| 4 | 0.000000 | 0.0000000 | 0.0000000 | 0.0195312 | 0.0244141 | 0.0073242 |
| 5 | 0.000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0048828 | 0.0029297 |
| 6 | 0.000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0004883 |
2. Proporcione la funcion masa de probabilidad para Y. \[P_{Y}(y)= \sum p(x,y)=\sum[\binom{x+1}{y}q^y(1-q)^{x+1-y}][\binom{n}{x}p^x(1-p)^{n-x}]\]
y<-c(0:n)
vec<-rep(NA, n+2)
for (i in 1:7){
vec[i]<-sum(dbinom(k-1,y+1,q)*(dbinom(y,n,p)))
}
vec<-data.frame("y"=0:6,"fmp de y"=vec)
knitr::kable(vec, "pipe", caption = "Función de masa de probabilidad para Y")| y | fmp.de.y |
|---|---|
| 0 | 0.0004883 |
| 1 | 0.0004883 |
| 2 | 0.0004883 |
| 3 | 0.0004883 |
| 4 | 0.0004883 |
| 5 | 0.0004883 |
| 6 | 0.0004883 |