Fuel consuption Guide 2016 - Transport Canada
Se carga la base de datos por medio del comando read_excel() y se guarda como un DataFrame
Se revisan las dimensiones de la BD y se despliega el contenido de todas las columnas para el primer renglón de información
dim(Transport)
## [1] 356 14
Transport[1,1:10]
## No Marca MAKE MODEL CLASS ENGINE SIZE (L) CYLINDERS TRANSMISSION FUEL TYPE
## 1 1 Acura ILX C 2.4 4 AM8 Z
## CONSUMPTION CITY (L/100 KM) CONSUMPTION HIGHWAY (L/100 KM)
## 1 9.3 6.6
Para saber si hay valores perdidos o no asignados se usará una función de base en R y ya que el resultado es TRUE con la función which se sabrá que renglón o registro contienen NA
any(is.na(Transport))
## [1] TRUE
which(is.na(Transport))
## [1] 781 819 823 836 838 844 852 868 871 1136 1250 1492 1606 1848 1962
## [16] 2204 2318 2560 2674 2916 3030 3272 3386 3628 3742 3984 4023 4027 4040 4042
## [31] 4048 4056 4072 4075 4098 4340 4454 4696 4810
La creación de una función con la condicional if, nos permite saber en que columnas se encuentran estos registros de NA ya que funciona de manera tal que si el valor resulta NA le asignará un uno y si no se asignará un cero.
veri_na<-function(x)
{
if(is.na(x)==T)
{
x<-as.numeric(1)
}
else
{
x<-as.numeric(0)
}
}
Está función se aplicará a toda la base de datos para poder crear un “resumen” que muestre la suma de unos, es decir de NAs, en cada columna
NAs<-apply(Transport,c(1,2),veri_na)
apply(NAs,2,sum)
## No Marca
## 0 0
## MAKE MODEL CLASS
## 9 2
## ENGINE SIZE (L) CYLINDERS
## 2 2
## TRANSMISSION FUEL TYPE
## 2 2
## CONSUMPTION CITY (L/100 KM) CONSUMPTION HIGHWAY (L/100 KM)
## 2 2
## CONSUMPTION COMBINED (L/100 KM) $ PER YEAR
## 2 10
## CO2 EMISSIONS (g/km) CO2 RATING
## 2 2
Notamos que en la mayoría de las columnas existen al menos 2 valores no disponibles.
3.A las columnas de la tabla asígnele el tipo de varible que le corresponde: si es numérico, categórico, fecha, etc. Después, verifique en el caso de las variables numéricas, al realizar esta coerción, no hayan aumentado los valores de los NAs. Recuerde esto último sucede porque es probable que algunos valores numéricos presentaron 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).
Se vuelve a usar la función read_excel() pero esta vez especificando el tipo de datos que contiene cada columna y se almacena en un data frame
Se aplica nuevamente la función
NAs2<-apply(Datos_Transport,c(1,2),veri_na)
apply(NAs2,2,sum)
## No Marca
## 0 0
## MAKE.MODEL CLASS
## 9 2
## ENGINE.SIZE..L. CYLINDERS
## 2 2
## TRANSMISSION FUEL.TYPE
## 2 2
## CONSUMPTION..CITY..L.100.KM. CONSUMPTION..HIGHWAY..L.100.KM.
## 2 2
## CONSUMPTION..COMBINED..L.100.KM. X..PER.YEAR
## 2 10
## CO2.EMISSIONS..g.km. CO2.RATING
## 2 2
Se realiza la comparativa entre los NAs registrados en la primera base y los NAs registrados después de asignar el tipo de valores
Comparativa<-rbind(apply(NAs,2,sum),apply(NAs2,2,sum))
rownames(Comparativa)<-c("antes","despues")
as.data.frame(Comparativa)
## No Marca MAKE MODEL CLASS ENGINE SIZE (L) CYLINDERS TRANSMISSION
## antes 0 0 9 2 2 2 2
## despues 0 0 9 2 2 2 2
## FUEL TYPE CONSUMPTION CITY (L/100 KM) CONSUMPTION HIGHWAY (L/100 KM)
## antes 2 2 2
## despues 2 2 2
## CONSUMPTION COMBINED (L/100 KM) $ PER YEAR CO2 EMISSIONS (g/km)
## antes 2 10 2
## despues 2 10 2
## CO2 RATING
## antes 2
## despues 2
Ya que a la primera base de datos no se le asigno el tipo de datos de cada columna se puede remplazar todos los NA con la siguiente función
Transport[is.na(Transport)]<-0
Para el caso de la base donde si se identifico que tipo de datos correspondia en cada columna ya que se tienen datos numéricos y de carcater se realiza un ciclo for para remplazar los NA por 0 (númerico) o por “0” (caracter)
#Transport2[is.na(Transport2)]<-0 Marca error por que el 0 es incompatible con el tipo de texto character
for (i in 1:dim(Transport)[2]) {
if(is.double(Transport[,5])){
Transport[,i][is.na(Transport[,i])]<-0
} else{
(is.character(Transport[,i]))}
Transport[,i][is.na(Transport[,i])]<-"0"
}
nrow(Transport[duplicated(Transport), ])
## [1] 0
anyDuplicated(Transport)
## [1] 0
Trayecto Ricón de los Romos a Aguascalientes
Por lo cual se tiene que buscar el menor consumo en carretera, así mismo el menor costo por año y por conveniencia que use gasolina normal
summary(Transport)
## No Marca MAKE MODEL CLASS
## Length:356 Length:356 Length:356 Length:356
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
## ENGINE SIZE (L) CYLINDERS TRANSMISSION FUEL TYPE
## Length:356 Length:356 Length:356 Length:356
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
## CONSUMPTION CITY (L/100 KM) CONSUMPTION HIGHWAY (L/100 KM)
## Length:356 Length:356
## Class :character Class :character
## Mode :character Mode :character
## CONSUMPTION COMBINED (L/100 KM) $ PER YEAR CO2 EMISSIONS (g/km)
## Length:356 Length:356 Length:356
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
## CO2 RATING
## Length:356
## Class :character
## Mode :character
#Quitar todos los registros que no tengan toda la información completa
Filtrados<-filter(Transport, CYLINDERS!=0)
Filtrados<-filter(Filtrados, `MAKE MODEL`!="0")
#Filtrar todos los que tengan un menor consumo en carretera respecto a la media
Cons_carretera<-filter(Filtrados, Filtrados$`CONSUMPTION HIGHWAY (L/100 KM)`< mean(Filtrados$`CONSUMPTION HIGHWAY (L/100 KM)`))
## Warning in mean.default(Filtrados$`CONSUMPTION HIGHWAY (L/100 KM)`): argument is
## not numeric or logical: returning NA
#Filtrar todos los que tengan un menor costo por año respecto a la media
menorcosto<-filter(Cons_carretera, Cons_carretera$`$ PER YEAR`< mean(Cons_carretera$`$ PER YEAR`))
## Warning in mean.default(Cons_carretera$`$ PER YEAR`): argument is not numeric or
## logical: returning NA
#Filtrar los que usen gasolina normal unicamente
gas<-filter(menorcosto, menorcosto$`FUEL TYPE`=="X")
#Ordenar de mayor a menor segun el consumo en carretera y mostrar los primeros 5
Decision<- gas[order(gas$`CONSUMPTION HIGHWAY (L/100 KM)`,decreasing = F),]
Decision[1:5,]
## No Marca MAKE MODEL CLASS ENGINE SIZE (L) CYLINDERS TRANSMISSION
## NA <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## NA.1 <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## NA.2 <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## NA.3 <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## NA.4 <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## FUEL TYPE CONSUMPTION CITY (L/100 KM) CONSUMPTION HIGHWAY (L/100 KM)
## NA <NA> <NA> <NA>
## NA.1 <NA> <NA> <NA>
## NA.2 <NA> <NA> <NA>
## NA.3 <NA> <NA> <NA>
## NA.4 <NA> <NA> <NA>
## CONSUMPTION COMBINED (L/100 KM) $ PER YEAR CO2 EMISSIONS (g/km)
## NA <NA> <NA> <NA>
## NA.1 <NA> <NA> <NA>
## NA.2 <NA> <NA> <NA>
## NA.3 <NA> <NA> <NA>
## NA.4 <NA> <NA> <NA>
## CO2 RATING
## NA <NA>
## NA.1 <NA>
## NA.2 <NA>
## NA.3 <NA>
## NA.4 <NA>
Por lo cual se tiene que buscar el menor consumo en carretera, así mismo el menor costo por año y por conveniencia que use gasolina normal
Para la tabla de datos datosAct.xlsx elabore una función que le permita etiquetar de forma adecuada la variable sexo. Emplear un bucle for para llevarlo a cabo. En el espacio correspondiente de la actividad 3 se encuentra disponible la tabla datosAct (20%)
## Primero identificamos los nombres de las columnas en datos_act, para deducir donde podría estar la variable de interés
datos_act<- read_excel("/Users/mac/Downloads/datosAct.xlsx")
names(datos_act)
## [1] "encuestador" "sexo" "empleo" "ingreso" "edad"
## [6] "altura" "peso"
## Identificamos cuales son las categorías únicas que existen y hay que clasificar
datos_act %>%
distinct(sexo)
## # A tibble: 8 × 1
## sexo
## <chr>
## 1 hombre
## 2 mujer
## 3 Femenino
## 4 masculino
## 5 mascuino
## 6 Masculino
## 7 H
## 8 M
## Para la modificación, definiremos como m observaciones relacionadas con mujeres y h observaciones relacionadas con hombres
for (i in 1:length(datos_act$sexo)) {
## Condiciones para mujeres
if(datos_act[i,2] == "mujer" | datos_act[i,2] == "Femenino" | datos_act[i,2] == "M"){
datos_act[i,2] = "m"
## Condiciones para hombres
} else{
datos_act[i,2] = "h"
}
}
Utilizando la informaci´on 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´on que le permita estimar el ingreso de las personas bajo estudio.
Primero, necesitamos asignarle valores a los empleos. Para ello, identificaremos cuales son los empleos, estandarizaremos las variables y utilizaremos datos de mx.talent.com para asignarles valores monetarios a los empleos acordes con el mercado laboral mexicano.
## Propón una estimación del ingreso de los encuestados.
### Para estimar el ingreso de los encuestados, primero necesitamos clasificar adecuadamente sus profesiones, y luego proponer la estimación
#### Clasificación de profesiones
datos_act %>%
distinct(empleo)
## # A tibble: 5 × 1
## empleo
## <chr>
## 1 Enfermeria
## 2 obrero
## 3 mtro
## 4 abogado
## 5 politico
for (i in 1:length(datos_act$empleo)) {
if(datos_act[i,3] == "Enfermeria"){
datos_act[i,3] = "enfermeria"
} else if(datos_act[i,3] == "mtro"){
datos_act[i,3] = "maestro"
} else{}
}
## Hacemos ciclo for para asignar valores a la variable de ingresos
## Datos de ingresos fueron extraidos de mx.talent.com
for (i in 1:length(datos_act$empleo)) {
if(datos_act[i,3] == "enfermeria"){
datos_act[i,4] = 7000
} else if(datos_act[i,3] == "obrero"){
datos_act[i,4] = 4592
} else if(datos_act[i,3] == "maestro"){
datos_act[i,4] = 7009
} else if(datos_act[i,3] == "abogado"){
datos_act[i,4] = 7426
} else {
datos_act[i,4] = 75201
}
}
Con los datos obtenidos, podría ser relevante conoce información como la media de ingresos en la población, la media por sexos, o el ingreso por empleo. Creamos una pequeña función que utilice condiciones lógicas para darnos la información definida en la línea anterior.
## Función para obtener información relevante
funcion_informacion_ingresos <- function(x){
if(x == "ingprom"){
ingprom <- datos_act %>%
summarise("ingreso promedio" = mean(ingreso))
return(ingprom)
} else if(x == "ingprom_sexo"){
ingprom_sexo <- datos_act %>%
group_by(sexo) %>%
summarise("ingreso promedio por sexo" = mean(ingreso))
return(ingprom_sexo)
} else{
ingreso_empleo <- datos_act %>%
group_by(empleo) %>%
summarise("salario por empleo" = mean(ingreso))
return(ingreso_empleo)
}
}
## Uso de la función para obtener relevantes
funcion_informacion_ingresos("ingprom")
## # A tibble: 1 × 1
## `ingreso promedio`
## <dbl>
## 1 9523.
funcion_informacion_ingresos("ingprom_sexo")
## # A tibble: 2 × 2
## sexo `ingreso promedio por sexo`
## <chr> <dbl>
## 1 h 9156.
## 2 m 9972.
funcion_informacion_ingresos("else")
## # A tibble: 5 × 2
## empleo `salario por empleo`
## <chr> <dbl>
## 1 abogado 7426
## 2 enfermeria 7000
## 3 maestro 7009
## 4 obrero 4592
## 5 politico 75201
Estimar los valores perdidos de la variable peso a partir de la variable altura. Utilizar el método de Regresión lineal simple por mínimos cuadrados (función lm) con X = altura.
Primero se tienen que cambiar los NA por ceros
datos_Act_1<- read_excel("/Users/mac/Downloads/datosAct.xlsx")
datos_Act_1[is.na(datos_Act_1)]<-0
Realizamos una gráfica para ver como se distribuye la altura con respecto del peso donde además se puede notar que existen dos registros con un peso de 0
ggplot(datos_Act_1, aes(x=altura, y=peso)) +
geom_point() + theme_light()
Se usa la función lm con los parametros de peso y altura para realizar la regresión lineal la cual se puede observar en la gráfica
mod1 <- lm(peso ~ altura, data=datos_Act_1)
mod1
##
## Call:
## lm(formula = peso ~ altura, data = datos_Act_1)
##
## Coefficients:
## (Intercept) altura
## -26.0613 0.5593
ggplot(datos_Act_1, aes(x=altura, y=peso)) +
geom_point() +
geom_smooth(method='lm', formula=y~x, se=FALSE, col='dodgerblue1') +
theme_light()
Si bien al desplegar mod1, que es la variable donde se guardó el resultado de la regresión lineal, se despliegan unicamente los coeficientes, resulta que mod1 es una lista de 12 elementos entre los cuales se encuentran los coeficientes, los residuales, los efectos y los valores ajustados o aproximados que son los que se usarán para “rellenar” los valores perdidos
mod1$fitted.values
## 1 2 3 4 5 6 7 8
## 58.10592 61.01402 69.45871 66.77430 81.59445 69.96203 66.10320 70.68906
## 9 10 11 12 13 14 15 16
## 74.49196 66.94208 68.17243 71.80756 61.06995 79.07782 79.24560 63.41880
## 17 18 19 20 21 22 23 24
## 74.26826 72.59051 74.71566 79.24560 66.32690 66.77430 66.77430 68.11651
## 25 26 27 28 29 30 31 32
## 78.12709 72.53459 77.00859 71.02461 66.77430 75.33084 63.64250 76.44934
## 33 34 35 36 37 38 39 40
## 65.93543 73.70901 81.14705 67.89281 61.12587 79.07782 77.95932 73.82086
En la base original unicaanete dos datos eran faltantes.
which(datos_Act_1$peso==0)
## [1] 33 38
Por lo que construimos un ciclo for para que unicamente se “rellenen” estos dos valores faltantes con los valores calculados
nvo_datos_Act_1<-datos_Act_1
for (i in 1:dim(nvo_datos_Act_1)[1]) {
if(nvo_datos_Act_1[i,7] == 0){
nvo_datos_Act_1[i,7] = mod1$fitted.values[[i]]
} else{
nvo_datos_Act_1[i,7]<-nvo_datos_Act_1[i,7]
}
}
ggplot(nvo_datos_Act_1, aes(x=altura, y=peso)) +
geom_point() +
geom_smooth(method='lm', formula=y~x, se=FALSE, col='dodgerblue1') +
theme_light()
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)\).
Hacer la función masa de probabilidad conjunta \(X,Y\) cuando \(n=5, p=q= .5\).
Calcular \(f_{x,y}(x,y)\) :
Si k éxitos en n realizaciones Bernoulli independientes \(k \le n\)
\(P(X = k) = \binom{n}{k} p^k (1-p)^{n-k}\)
A partir de la ley de Probabilidad Total, sabemos que:
\(P(A |B) = \frac{P (A\cap B)}{P(B)}\)
Por lo tanto, podemos obtener una probabilidad conjunta mediante los elementos que tenemos: probabilidad condicional y total.
\(P(X=x, Y=y)=P(X=x | Y=y) P(X=x)\)
\(\le x,y \le n =5\)
Primero obtenemos P (X=x)
\(P (X=0)= \binom{5}{0} (.5)^0 (.5)^{5}\)
\(P (X=1)= \binom{5}{1} (.5)^1 (.5)^{4}\)
\(P (X=2)= \binom{5}{2} (.5)^2 (.5)^{3}\)
\(P (X=3)= \binom{5}{3} (.5)^3 (.5)^{2}\)
\(P (X=4)= \binom{5}{4} (.5)^4 (.5)^{1}\)
\(P (X=5)= \binom{5}{5} (.5)^5 (.5)^{0}\)
Ahora la probabilidad condicional de P (Y | X)
\(Y|X = x \sim Bin (x+1,q)\) \(P(Y= 0 | X=0)\)
\(P( Y= y| X=0) = \binom{1}{y} (.5)^y (.5)^{1-y})\)
Y finalmente la probabilidad conjunta a partir de \(P(X=x | Y=y) P(X=x)\)
También es posible programar una función que genere los valores de la tabla previa.
# Nuevamente obtendremos (P(X=x, Y=y) mediante (P(X=x | Y=y) * P(X=x) y cada elemento de la multiplicación se obtiene a partir de la distribución binomial con sus respectivos parámetros.
funcion_conjunta <- function(x,y,n,p,q){
probax <- dbinom(x,n,p)
probaydadox <- dbinom(y,x+1,q)
conjunta <- probax * probaydadox
return(conjunta)
}
funcion_conjunta(x=0,y=0,n=5,p=0.5,q=0.5)
## [1] 0.015625
Proporcione la función de masa de probabilidad para Y.
\(X \sim Bin(n,p)\) \(Y|X= k-1, Bin(k,q)\) \(Y\sim ?\)
A partir de la Ley de la Probabilidad Total : \(P(A) = \sum P(A\cap B_i)\)
\(P(A) = \sum P(A| B_i) P(B_i)\)
\(P(Y=m) = \sum_{k=m}^n P(Y=m | X=k) P (X=k)\)
\(P(Y=m) = \sum_{k=m}^n \binom{k}{m} q^m (1-q)^{k-m} \binom{n}{k} p^k (1-q)^{n-k}\)
\(P(Y=m) = \sum_{k=m}^n \binom{n}{m} \binom{n-m}{k-m} p^k q^m (1-p)^{n-k}(1-q)^{k-m}\)
\(P(Y=m) = \binom{n}{m} (pq)^m \sum_{k=m}^n \binom{n-m}{k-m} (p(1-q))^{k-m}(1-p)^{n-k}\)
\(P(Y=m) = \binom{n}{m} (pq)^m \sum_{i=0}^{n-m} \binom{n-m}{i} (p(1-q))^{i} (1-p)^{n-m-i}\)
\
\(P(Y=m) = \binom{n}{m} (pq)^m (p(1-q)+ 1-p)^{n-m}\)
\(P(Y=m) = \binom{n}{m} (pq)^m (1-pq)^{n-m}\)
\(Y \sim Bin (n, pq)\)
## Para obtener la distribución de Y, determinamos los parámetros que hemos obtenido a partir del desarrollo previo en la siguiente función:
funcion_y <- function(y,n,p,q){
probay <- dbinom(y,n,p,q)
return(probay)
}