ACTIVIDAD 3

ÍNDICE

EJERCICIO 1
EJERCICIO 2
EJERCICIO 3
EJERCICIO 4
EJERCICIO 5

EJERCICIO 1

Para la realización de este primer ejercicio es necesario consultar la base dedatos datosRendimientos.xlsx. Este conjunto de datos corresponde a una muestra que contiene 356 observaciones de automóviles seleccionados del Fuel Consumption Guide 2016 publicado por Transport Canada. Las variables de la base de datos son las siguientes:

No. (número de indentificación)
Marca
Mark Model
Class
Engine Size (L)
Cylinders
Transmission
Fuel Type
Consumption City (L/100 km)
Consumption Highway (L/ 100 km)
Consumption Combined (L/100 km)
Cost Per Year
CO2 Emissions (g/km)

Como primer punto comprender las características de tabla de datos, es decir: dimensión de la tabla, entender el significado técnico de las variables o columnas (no se requiere que reporte algo en este inciso).

(10%) Verifique si hay valores perdidos en los registros en cada una de sus variables.

NAs <- cbind(
   lapply(
     lapply(data, is.na)
     , sum)
   )
colnames(NAs) <- ("NA´s")
NAs

##                                  NA´s
## No                               0   
## Marca                            0   
## MAKE MODEL                       9   
## CLASS                            2   
## ENGINE SIZE (L)                  2   
## CYLINDERS                        2   
## TRANSMISSION                     2   
## FUEL TYPE                        2   
## CONSUMPTION  CITY (L/100 KM)     2   
## CONSUMPTION  HIGHWAY (L/100 KM)  2   
## CONSUMPTION  COMBINED (L/100 KM) 2   
## $ PER YEAR                       10  
## CO2 EMISSIONS (g/km)             2   
## CO2 RATING                       2

Es posible observar que existen valores perdidos (NAs) en las variables de la 2 a 14. Estas variables tienen diversa cantidad de valores perdidos desde 2 a 10 observaciones sin registro.

(10%) 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 cuáles serían, si fuera el caso).

lapply(data, class) #vemos la clase de cada variable

## $No
## [1] "numeric"
## 
## $Marca
## [1] "character"
## 
## $`MAKE MODEL`
## [1] "character"
## 
## $CLASS
## [1] "character"
## 
## $`ENGINE SIZE (L)`
## [1] "numeric"
## 
## $CYLINDERS
## [1] "numeric"
## 
## $TRANSMISSION
## [1] "character"
## 
## $`FUEL TYPE`
## [1] "character"
## 
## $`CONSUMPTION  CITY (L/100 KM)`
## [1] "numeric"
## 
## $`CONSUMPTION  HIGHWAY (L/100 KM)`
## [1] "numeric"
## 
## $`CONSUMPTION  COMBINED (L/100 KM)`
## [1] "numeric"
## 
## $`$ PER YEAR`
## [1] "numeric"
## 
## $`CO2 EMISSIONS (g/km)`
## [1] "numeric"
## 
## $`CO2 RATING`
## [1] "numeric"

#Aquí observamos que las únicas que mercen cambio son las variables "factor"
v_fact <-c("Marca", "CLASS", "TRANSMISSION", "FUEL TYPE" )  #seleccionamios las variables que son factor
data[v_fact] <- lapply (data[v_fact], as.factor) #cambiamos las variables a factor
lapply(data, class) #revisamos el cambio

## $No
## [1] "numeric"
## 
## $Marca
## [1] "factor"
## 
## $`MAKE MODEL`
## [1] "character"
## 
## $CLASS
## [1] "factor"
## 
## $`ENGINE SIZE (L)`
## [1] "numeric"
## 
## $CYLINDERS
## [1] "numeric"
## 
## $TRANSMISSION
## [1] "factor"
## 
## $`FUEL TYPE`
## [1] "factor"
## 
## $`CONSUMPTION  CITY (L/100 KM)`
## [1] "numeric"
## 
## $`CONSUMPTION  HIGHWAY (L/100 KM)`
## [1] "numeric"
## 
## $`CONSUMPTION  COMBINED (L/100 KM)`
## [1] "numeric"
## 
## $`$ PER YEAR`
## [1] "numeric"
## 
## $`CO2 EMISSIONS (g/km)`
## [1] "numeric"
## 
## $`CO2 RATING`
## [1] "numeric"

#contamos de nuevo NAs
NAs_2 <- cbind(lapply(lapply(data, is.na), sum))
colnames(NAs_2) <- ("NA´s_2")

#comparamos los Nas ante sy después del cambio a factor
print(cbind(NAs, NAs_2))

##                                  NA´s NA´s_2
## No                               0    0     
## Marca                            0    0     
## MAKE MODEL                       9    9     
## CLASS                            2    2     
## ENGINE SIZE (L)                  2    2     
## CYLINDERS                        2    2     
## TRANSMISSION                     2    2     
## FUEL TYPE                        2    2     
## CONSUMPTION  CITY (L/100 KM)     2    2     
## CONSUMPTION  HIGHWAY (L/100 KM)  2    2     
## CONSUMPTION  COMBINED (L/100 KM) 2    2     
## $ PER YEAR                       10   10    
## CO2 EMISSIONS (g/km)             2    2     
## CO2 RATING                       2    2

Podemos observar que no aumentaron el número de observaciones perdidas (NAs) en las variables en las que se les cambió el tipo de variable.

Ahora se cambiarán los valores perdidos (Nas) a 0

#regresamos las variables factor a character
v_fact <-c("Marca", "CLASS", "TRANSMISSION", "FUEL TYPE" )  #seleccionamios las variables que son factor
data[v_fact] <- lapply (data[v_fact], as.character) #cambiamos las variables a character

#remplazamos por NAs por cero, se searpan por catgeoría de las variables

data[,2:4][is.na(data[, 2:4])] <- "0"
data[,5:6][is.na(data[, 5:6])] <- 0
data[,7:8][is.na(data[, 7:8])] <- "0"
data[,9:14][is.na(data[, 9:14])] <- 0

#regresamos variables a factor
data[v_fact] <- lapply (data[v_fact], as.factor)

#contamos de nuevo NAs
NAs_3 <- cbind(lapply(lapply(data, is.na), sum))
colnames(NAs_3) <- ("NA´s_3")

#comparamos los Nas ante sy después del cambio a factor
print(cbind(NAs, NAs_2, NAs_3))

##                                  NA´s NA´s_2 NA´s_3
## No                               0    0      0     
## Marca                            0    0      0     
## MAKE MODEL                       9    9      0     
## CLASS                            2    2      0     
## ENGINE SIZE (L)                  2    2      0     
## CYLINDERS                        2    2      0     
## TRANSMISSION                     2    2      0     
## FUEL TYPE                        2    2      0     
## CONSUMPTION  CITY (L/100 KM)     2    2      0     
## CONSUMPTION  HIGHWAY (L/100 KM)  2    2      0     
## CONSUMPTION  COMBINED (L/100 KM) 2    2      0     
## $ PER YEAR                       10   10     0     
## CO2 EMISSIONS (g/km)             2    2      0     
## CO2 RATING                       2    2      0

Así, podemos verificar que se remplazaron todos los Nas

(5%) Verifique que no haya valores repetidos (si hay, eliminar uno de los repetidos).

#genero función de verificación de reptidos
repetidos <- function(x){
duplicados <- duplicated(x) #identifica las variables repetidas con valor boleano
x <-  which (duplicados == "TRUE") #identifica las pocisiones de duplicated= TRUE
if (any(x)== "FALSE"){"No hay repetidos"} else {"Sí hay repetidos"} #Nos indica si hay reptidos
}

#activamos función para la base actual
repetidos(data)

## [1] "No hay repetidos"

Tenemos que no hay ningúna observación repetida, para todas las variables de la base de datos. Por lo tanto, no existen repeteciones que eliminar.

(20%) Considere que Fernanda Esquinca es una mujer que está próxima a comprar un automóvil. Usted que es amiga de Fernanda y tiene conocimiento de esta base de datos ¿Cuál automóvil 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; además, ella vive en Rincón de Romos y viaja diariamente a la ciudad de Aguascalientes. Proporcione medidas estadísticas para fundamentar su propuesta.

#observamos princiapels características
#ordenamos el costo anual como primer caraterística a observar para buscar el carro con menor costo anual
data <- data[order (data$'$ PER YEAR'),] 
mean(data$`$ PER YEAR`) # buscamos el promedio del gasto anual para observar los que esten menor a la media

## [1] 2381.264

# exlcuimos las observaciones con datos perdidos (0) 
#hacemos un summary para dos variables principales: Gasto por año y Consumo combinado
summary(data$`$ PER YEAR` [data$`$ PER YEAR` != 0])

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1199    2034    2430    2450    2802    4266

summary(data$`CONSUMPTION  COMBINED (L/100 KM)` [data$`CONSUMPTION  COMBINED (L/100 KM)` != 0])

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    5.50    8.70   10.25   10.41   12.05   17.20

#concluímos que el mejor carro para Fernanda es que tenga el menor gasto anual y el mejor rendimeinto combinado
carro_fernanda <- subset(data, data$`$ PER YEAR` == 1199 | data$`CONSUMPTION  COMBINED (L/100 KM)` == 5.50)
print(paste0 ("El mejor carro Fernanda ", carro_fernanda$Marca," " ,carro_fernanda$`MAKE MODEL`))

## [1] "El mejor carro Fernanda DODGE FUSION HYBRID"

El Dodge Fusion hybrid tiene el menor gasto consumo por año en combustible que es de $1,199, esto lo pudimos observar quitando los carros que no tenian información (NA = 0). También es el auto que tiene menor consumo combinado por litro, que es de 5.50 (l/100 km). Este es el gasto en el que se toma en cuenta el rendimiento 45% carretera y 55% en ciudad, lo que acomoda perfecatmente a las necesidades de Fernanda. Este auto auto tiene un tamaño Medio,utiliza combustible regular y la transmisión es variable, lo que se acomoda al estilo de vida de Fernanda.

EJERCICIO 2

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

datos <- read_xlsx("/Users/cristinaalvarez/Desktop/bases/datosAct.xlsx")
#table(datos$sexo)
length <- length(datos$sexo)
sexo<- toupper(datos$sexo)
etiqueta_sexo<-rep(NA,length)
for (k in 1:length){
if(sexo[k]== "MUJER"| sexo[k]=="M"| sexo[k]== "FEMENINO"){etiqueta_sexo[k]<-"FEMENINO"}else{etiqueta_sexo[k]<-"MASCULINO"}}

#table(etiqueta_sexo)

datos$etiqueta_sexo<- etiqueta_sexo

datos[, c(2,8)]

## # A tibble: 40 x 2
##    sexo   etiqueta_sexo
##    <chr>  <chr>        
##  1 hombre MASCULINO    
##  2 hombre MASCULINO    
##  3 hombre MASCULINO    
##  4 hombre MASCULINO    
##  5 hombre MASCULINO    
##  6 mujer  FEMENINO     
##  7 mujer  FEMENINO     
##  8 mujer  FEMENINO     
##  9 hombre MASCULINO    
## 10 mujer  FEMENINO     
## # … with 30 more rows

Es posible observar que después de la transformación la categoría de sexo quedó como “MASCULINO” y “FEMENINO”. Se registro en otro columna para poder hacer la comparación y verificar, visualmente, que la clasificación fuera la correcta.

EJERCICIO 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.

Con base en el estudio del García (2021) del Centro de Investigación en Política Pública IMCO, se establece que la brecha de género impacta en un 13% el salario percibido. Lo que quiere decir que “por cada 100 pesos que recibe un hombre en promedio por su trabajo al mes, una mujer recibe 87” García (2021).

En este sentido, se tomó como salario base los datos proporcionados en la actividad de laboratorio el 21/10/2021 para despúes diferenciarlos con base en el sexo del sujeto encuestado.

#mostramos los datos de la base que se va a emparejar con los salrios base
salarios <- read_xlsx("/Users/cristinaalvarez/Desktop/bases/Salarios.xlsx")
salarios

## # A tibble: 10 x 2
##    empleo      salario_base
##    <chr>              <dbl>
##  1 POLITICO           85000
##  2 BIOLOGICAS         13549
##  3 ARQUITECTO         13549
##  4 INGENIERO          12283
##  5 ABOGADO            12500
##  6 HUMANIDADES        10365
##  7 ARTES               9768
##  8 MTRO                9540
##  9 ENFERMERIA          8500
## 10 OBRERO              4590

datos$empleo <- toupper(datos$empleo) #empleo a mayúsculas para homgenizar y porder emparejar
#table (datos$empleo) revisamos si los registros son homégenos
length <- length(datos$empleo) #establecemos el largo de la base en esta columna
info <-merge(datos,salarios,by.x="empleo",
                   by.y="empleo",all.x=FALSE,sort = FALSE) #hacemos el merge de los salarios base
ingreso <- rep(NA, length) # establcemnos vector fictisio para guardar nuevos datos
#establecemos función de cambio de salario penalizando por el género
for (k in 1:length) {
  if (info$etiqueta_sexo[k] == "FEMENINO") {info$ingreso[k] <- (info$salario_base[k]*.87)} else {info$ingreso[k] <- (info$salario_base[k])}}
#observamos cambio 
info[1:15,c(1,4,8)]

##        empleo ingreso etiqueta_sexo
## 1  ENFERMERIA  8500.0     MASCULINO
## 2  ENFERMERIA  8500.0     MASCULINO
## 3  ENFERMERIA  7395.0      FEMENINO
## 4  ENFERMERIA  7395.0      FEMENINO
## 5  ENFERMERIA  8500.0     MASCULINO
## 6  ENFERMERIA  8500.0     MASCULINO
## 7  ENFERMERIA  8500.0     MASCULINO
## 8      OBRERO  4590.0     MASCULINO
## 9      OBRERO  4590.0     MASCULINO
## 10     OBRERO  4590.0     MASCULINO
## 11     OBRERO  3993.3      FEMENINO
## 12     OBRERO  4590.0     MASCULINO
## 13     OBRERO  4590.0     MASCULINO
## 14     OBRERO  3993.3      FEMENINO
## 15     OBRERO  4590.0     MASCULINO

Como resultado tenemos el salario percibido en promedio por profesión o empleo penalizado por la brecha de género estimada por el estudio referido.

EJERCICIO 4

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.$

El método más común para la determinación de la aproximación estadísticamente óptima con un conjunto de parámetros dado un grupo de datos, es el método conocido como Mínimos Cuadrados (por sus siglas en inglés, LS), y fue propuesto hace aproximadamente dos siglos por Carl Friedrich Gauss. Así, en el caso más simple de la regresión lineal $(y = b_{0} + b_{1} = X)$, se busca minimizar la suma de cuadrados en el vector de residuales e. Esta función objetivo de mínimos cuadrados puede ser escrita en su forma compacta de la siguiente manera:

\[\begin{equation} \begin{split} \bf{f(b)} = e^{T}e \\ & = (y-Xb^{T})(y - Xb)\\ & = y^{T}y -2y^{T}Xb+bX^{T}Xb\\ \end{split} \end{equation}\]

Calculando las derivadas parciales respecto a los parámetros b, e igualando dicha derivada a 0, se obtiene el vector de estimaciones puntuales de los parámetros β (o b):

\[ b= (X^TX) ^{-1}X^T y\] Utilizando los datos de la bse de datos , se obtiene el vector de estimaciones puntuales para los parámetros b y su intercepto, cuando X = altura.

info[,7][is.na(info[, 7])] <- 0 #Quito NAs
info_base <-info #Guardo base

info <- as.data.frame(info[, 6:7])
info$intercept <- 1
info <- data.matrix(info)
x <- info[, c(1,3)]
y <- as.matrix(info[,2])
x_t <- t(x)
a <- (x_t%*%x)
a_inv <-solve(a)
c <- a_inv%*%x_t
b<- c%*%y


b<-as.data.frame(b)
colnames(b)<- "coeficientes"
b

##           coeficientes
## altura       0.5592507
## intercept  -26.0613185

Aquí podemos observar la estimación del coeficiente $\beta$ y su intercepto

En seguida realizamos la función para cambiar los valores perdidos por las estimaciones con respecto a la regresión lineal

length <- length(info_base$peso)
for (k in 1:length) {
  if (info_base$peso[k] == 0) {info_base$peso[k] <- (b[2,]+ (info_base$altura[k]*b[1,]))} else {info_base$peso[k] <- (info_base$peso[k])}}

info_base[1:20, 6:7]

##    altura     peso
## 1   150.5 64.00000
## 2   180.2 88.00000
## 3   164.5 65.93543
## 4   173.0 65.00000
## 5   191.7 80.00000
## 6   168.4 63.00000
## 7   178.4 78.00000
## 8   155.7 62.00000
## 9   166.0 67.00000
## 10  166.0 70.00000
## 11  173.6 80.00000
## 12  175.0 79.00000
## 13  160.4 68.00000
## 14  184.3 75.00000
## 15  168.0 73.00000
## 16  164.8 75.00000
## 17  176.3 70.00000
## 18  166.0 76.00000
## 19  178.6 83.00000
## 20  155.9 54.30000

observamos que efictavemente fueron remplazados los datos faltantes, y que las estimaciones son coherentes.

#cantidad de Nas en la variable de interés "peso"

NAs_peso <- cbind(lapply(lapply(info_base, is.na), sum))
NAs_peso[7,]

## $peso
## [1] 0

Por último podemos observar que no hay más valores faltantes (Nas) en la variable de interes: peso

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)$.

Hacer la función masa de probabilidad conjunto X, Y cuando n = 5, p = 0.5 y q = 0.5.
Proporcione la función masa de probabilidad para Y .

Primeramente, deber de emplear sus conocimientos de estadística para encontrar la manera para definir la $P (Y \cap X )$

\[P(Y \cap X) = {P(Y \cap X)}\cdot \frac{P(X)}{P(X)} = \bf{P(X)\cdot P(Y|X)}\]

library(knitr)
library(kableExtra)
n<- 4 # establezco n-1

#establecemos valores de x
for(k in 0:n){ assign(paste0('x', k), rep(k ,times=(k+2)))}
x <- append(x0, c(x1,x2,x3,x4, n+1))
as.vector(x)

##  [1] 0 0 1 1 1 2 2 2 2 3 3 3 3 3 4 4 4 4 4 4 5

#establecemos valores de n(y)
for(k in 0:n){ assign(paste0('n', k), rep(k+1 ,times=(k+2)))}
n_y <- append(n0, c(n1,n2,n3,n4, 6))
as.vector(n_y)

##  [1] 1 1 2 2 2 3 3 3 3 4 4 4 4 4 5 5 5 5 5 5 6

#establecemos valores de y
for(k in 0:n){ assign(paste0('y', k), rep(0:5 ,length.out=(k+2)))}
y <- append(y0, c(y1,y2,y3,y4, 0))
as.vector(y)

##  [1] 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0 1 2 3 4 5 0

#establecemos calumna para rellenar con valores
l <- 0
for (k in 0:n){ l[k+1] <- k+2}
r <- rep(NA, sum(l)+1 )

#formamos data frame con todos los valores
c<- data.frame(x,n_y,y,r)

#función de asignación de probabilidad conjunta
for (k in 1:length(r)){
c$r[k] <- round((dbinom(x=c$x[k], size=5 , prob=0.5)*dbinom(x=c$y[k], size=c$n_y[k] , prob=0.5)), 6)}

colnames(c) <- c("X", "N(Y)", "Y","P(X)P(Y|X)")

c<-knitr::kable(c, row.names = F, full_width = FALSE, align = "rccc")
kable_classic(c, "hover", full_width = FALSE, position = "center", font_size = 16, column_spec(c, 2,  width="10em"))

X	N(Y)	Y	P(X)P(Y\|X)
0	1	0	0.015625
0	1	1	0.015625
1	2	0	0.039062
1	2	1	0.078125
1	2	2	0.039062
2	3	0	0.039062
2	3	1	0.117188
2	3	2	0.117188
2	3	3	0.039062
3	4	0	0.019531
3	4	1	0.078125
3	4	2	0.117187
3	4	3	0.078125
3	4	4	0.019531
4	5	0	0.004883
4	5	1	0.024414
4	5	2	0.048828
4	5	3	0.048828
4	5	4	0.024414
4	5	5	0.004883
5	6	0	0.000488

función masa de probabilidad para Y

c<- data.frame(x,n_y,y,r)

#función de asignación de probabilidad
for (k in 1:length(r)){
c$r[k] <- round((dbinom(x=c$x[k], size=5 , prob=0.5)*dbinom(x=c$y[k], size=c$n_y[k] , prob=0.5)), 6)}
#sumatoria de las probabilidades para obtener la marginal de Y
d <- aggregate(r~y, data=c, sum)

d<-knitr::kable(d, row.names = F, full_width = FALSE, align = "rccc", col.names = c("Y", "P(Y)"))
kable_classic(d, "hover", full_width = FALSE, position = "center", font_size = 16, column_spec(d, 2,  width="10em"))

Y	P(Y)
0	0.118651
1	0.313477
2	0.322265
3	0.166015
4	0.043945
5	0.004883