Laboratorio 2
2024-03-07
Bloque 1
Problema 1:
Importe la base de datos tarjetacredit.csv. Determine la correspondiente tabla de proba- bilidades (marginales y conjuntas) considerando la poblaci ́on en la que cada individuo es clasificado seǵun los criterios que aparecen a continuaci ́on. Grafique y elabore conclusiones (m ́ınimo 3 por cada ́ıtem):
g ́enero (F ́o M) y tipo de tarjeta (Azul, Plata, Oro, Platino).
actividad de la cuenta (cerrada ́o activa) y estado civil (casado. soltero, divorciado, desconocido) del cliente.
tipo de tarjeta (Azul, Plata, Oro, Platino) y perfil educativo del titular de la tarjeta (escuela secundaria, colegio, graduado universitario, doctorado, posgraduado, sin educaci ́on).
actividad del cliente con respecto a la cuenta (activa o cerrada) y el g ́enero (F ́o M)
tarjetas<-read.csv("C:/Users/sarar/Downloads/tarjetacredit.csv")#A
prob_1a<-data.frame(tarjetas$Gender,tarjetas$Card_Category)
tabla_1a<-table(prob_1a);tabla_1a## tarjetas.Card_Category
## tarjetas.Gender Blue Gold Platinum Silver
## F 5101 38 9 210
## M 4335 78 11 345addmargins(tabla_1a)## tarjetas.Card_Category
## tarjetas.Gender Blue Gold Platinum Silver Sum
## F 5101 38 9 210 5358
## M 4335 78 11 345 4769
## Sum 9436 116 20 555 10127tabla_1a_2<-proportions(tabla_1a);tabla_1a_2## tarjetas.Card_Category
## tarjetas.Gender Blue Gold Platinum Silver
## F 0.5037029723 0.0037523452 0.0008887133 0.0207366446
## M 0.4280635924 0.0077021823 0.0010862052 0.0340673447addmargins(tabla_1a_2)## tarjetas.Card_Category
## tarjetas.Gender Blue Gold Platinum Silver
## F 0.5037029723 0.0037523452 0.0008887133 0.0207366446
## M 0.4280635924 0.0077021823 0.0010862052 0.0340673447
## Sum 0.9317665646 0.0114545275 0.0019749185 0.0548039893
## tarjetas.Card_Category
## tarjetas.Gender Sum
## F 0.5290806754
## M 0.4709193246
## Sum 1.0000000000barplot(tabla_1a[,1],main="Tarjeta Blue por sexo",col="lightblue")
#B
prob_1b<-data.frame(tarjetas$Attrition_Flag,tarjetas$Marital_Status)
tabla_1b<-table(prob_1b);tabla_1b## tarjetas.Marital_Status
## tarjetas.Attrition_Flag Divorced Married Single Unknown
## Attrited Customer 121 709 668 129
## Existing Customer 627 3978 3275 620addmargins(tabla_1b)## tarjetas.Marital_Status
## tarjetas.Attrition_Flag Divorced Married Single Unknown Sum
## Attrited Customer 121 709 668 129 1627
## Existing Customer 627 3978 3275 620 8500
## Sum 748 4687 3943 749 10127tabla_1b_2<-proportions(tabla_1b);tabla_1b_2## tarjetas.Marital_Status
## tarjetas.Attrition_Flag Divorced Married Single Unknown
## Attrited Customer 0.01194826 0.07001086 0.06596228 0.01273822
## Existing Customer 0.06191370 0.39281130 0.32339291 0.06122247addmargins(tabla_1b_2)## tarjetas.Marital_Status
## tarjetas.Attrition_Flag Divorced Married Single Unknown Sum
## Attrited Customer 0.01194826 0.07001086 0.06596228 0.01273822 0.16065962
## Existing Customer 0.06191370 0.39281130 0.32339291 0.06122247 0.83934038
## Sum 0.07386195 0.46282216 0.38935519 0.07396070 1.00000000barplot(tabla_1b[,1],main="Estado de clientes divorciados",col="lightblue")
#C
prob_1c<-data.frame(tarjetas$Card_Category,tarjetas$Education_Level)
tabla_1c<-table(prob_1c);tabla_1c## tarjetas.Education_Level
## tarjetas.Card_Category College Doctorate Graduate High School Post-Graduate
## Blue 940 422 2899 1888 476
## Gold 15 5 36 26 5
## Platinum 0 2 8 1 3
## Silver 58 22 185 98 32
## tarjetas.Education_Level
## tarjetas.Card_Category Uneducated Unknown
## Blue 1391 1420
## Gold 11 18
## Platinum 3 3
## Silver 82 78addmargins(tabla_1c)## tarjetas.Education_Level
## tarjetas.Card_Category College Doctorate Graduate High School Post-Graduate
## Blue 940 422 2899 1888 476
## Gold 15 5 36 26 5
## Platinum 0 2 8 1 3
## Silver 58 22 185 98 32
## Sum 1013 451 3128 2013 516
## tarjetas.Education_Level
## tarjetas.Card_Category Uneducated Unknown Sum
## Blue 1391 1420 9436
## Gold 11 18 116
## Platinum 3 3 20
## Silver 82 78 555
## Sum 1487 1519 10127tabla_1c_2<-proportions(tabla_1c);tabla_1c_2## tarjetas.Education_Level
## tarjetas.Card_Category College Doctorate Graduate High School
## Blue 9.282117e-02 4.167078e-02 2.862644e-01 1.864323e-01
## Gold 1.481189e-03 4.937296e-04 3.554853e-03 2.567394e-03
## Platinum 0.000000e+00 1.974919e-04 7.899674e-04 9.874593e-05
## Silver 5.727264e-03 2.172410e-03 1.826800e-02 9.677101e-03
## tarjetas.Education_Level
## tarjetas.Card_Category Post-Graduate Uneducated Unknown
## Blue 4.700306e-02 1.373556e-01 1.402192e-01
## Gold 4.937296e-04 1.086205e-03 1.777427e-03
## Platinum 2.962378e-04 2.962378e-04 2.962378e-04
## Silver 3.159870e-03 8.097166e-03 7.702182e-03addmargins(tabla_1c_2)## tarjetas.Education_Level
## tarjetas.Card_Category College Doctorate Graduate High School
## Blue 9.282117e-02 4.167078e-02 2.862644e-01 1.864323e-01
## Gold 1.481189e-03 4.937296e-04 3.554853e-03 2.567394e-03
## Platinum 0.000000e+00 1.974919e-04 7.899674e-04 9.874593e-05
## Silver 5.727264e-03 2.172410e-03 1.826800e-02 9.677101e-03
## Sum 1.000296e-01 4.453441e-02 3.088773e-01 1.987756e-01
## tarjetas.Education_Level
## tarjetas.Card_Category Post-Graduate Uneducated Unknown Sum
## Blue 4.700306e-02 1.373556e-01 1.402192e-01 9.317666e-01
## Gold 4.937296e-04 1.086205e-03 1.777427e-03 1.145453e-02
## Platinum 2.962378e-04 2.962378e-04 2.962378e-04 1.974919e-03
## Silver 3.159870e-03 8.097166e-03 7.702182e-03 5.480399e-02
## Sum 5.095290e-02 1.468352e-01 1.499951e-01 1.000000e+00barplot(tabla_1c[,1],main="tarjetas de estudiantes en College",col="lightblue")
#D
prob_1d<-data.frame(tarjetas$Attrition_Flag,tarjetas$Gender)
tabla_1d<-table(prob_1d);tabla_1d## tarjetas.Gender
## tarjetas.Attrition_Flag F M
## Attrited Customer 930 697
## Existing Customer 4428 4072addmargins(tabla_1d)## tarjetas.Gender
## tarjetas.Attrition_Flag F M Sum
## Attrited Customer 930 697 1627
## Existing Customer 4428 4072 8500
## Sum 5358 4769 10127tabla_1d_2<-proportions(tabla_1d);tabla_1d_2## tarjetas.Gender
## tarjetas.Attrition_Flag F M
## Attrited Customer 0.09183371 0.06882591
## Existing Customer 0.43724696 0.40209341addmargins(tabla_1d_2)## tarjetas.Gender
## tarjetas.Attrition_Flag F M Sum
## Attrited Customer 0.09183371 0.06882591 0.16065962
## Existing Customer 0.43724696 0.40209341 0.83934038
## Sum 0.52908068 0.47091932 1.00000000barplot(tabla_1d[,1],main="Estado de cuenta de mujeres",col="lightblue")
Conclusiones: - Hay más hombres que mujeres que tienen
la tarjeta blue. - La mayoria de clientes divorciados siguen haciendo
uso de su tarjeta con dicho banco. - La mayoria de estudiantes de
universidad hacen uso de la tarjeta blue, despues le sigue la silver,
despues gold y la menos frecuente es la platinum. - De las 5000 mujeres
aprox que cuentan con la tarjeta blue, 4000 hacen uso de ellas y 1000 se
retiraron del servicio o no la usan.
Problema 2:
Teniendo en cuenta la informaci ́on de la tabla d. realizada en el punto anterior, complete: El gerente del banco recolect ́o datos sobre . . . . . . de sus clientes. De los . . . . . . hombres, . . . . . . tienen tarjetas de cr ́edito activas. . . . . . . de los hombres tienen la cuenta cerrada (inactiva), mientras que . . . . . . de las mujeres tienen la cuenta inactiva. El gerente del banco desea determinar la probabilidad de que un cliente seleccionado al azar sea: - una mujer con tarjeta de cr ́edito (cuenta) activa. - una mujer con tarjeta de cr ́edito inactiva. - un hombre sin tarjeta activa. - un hombre con tarjeta activa.
#una mujer con tarjeta de cŕedito (cuenta) activa.
print(tabla_1d_2[2,1])## [1] 0.437247#una mujer con tarjeta de cŕedito inactiva.
print(tabla_1d_2[1,1])## [1] 0.09183371#un hombre sin tarjeta activa.
print(tabla_1d_2[1,2])## [1] 0.06882591#un hombre con tarjeta activa
print(tabla_1d_2[2,2])## [1] 0.4020934Bloque 2
Problema 3:
Realice la tabla de contingencia y encuentre la probabilidad de que una persona seleccionada al azar:
- Tenga 40 a ̃nos ́o mas y tarjeta de cr ́edito azul.
- Tenga menos de 40 a ̃nos.
- Con tarjeta de cr ́edito plata dado que tiene 40 a ̃nos ́o m ́as.
- Sea menor de 40 a ̃nos si tiene tarjeta tipo oro.
- Con tarjeta oro o azul dado que es una persona menor de 40 a ̃nos.
- Dado que es una persona de 40 a ̃nos ́o m ́as, no tenga tarjeta platino.
tarjetas$Grupo_Edad<-ifelse(tarjetas$Customer_Age<40,"menos de 40 años","40 años o más")
tabla_3a<-table(tarjetas$Card_Category,tarjetas$Grupo_Edad);tabla_3a##
## 40 años o más menos de 40 años
## Blue 7520 1916
## Gold 95 21
## Platinum 19 1
## Silver 457 98addmargins(tabla_3a)##
## 40 años o más menos de 40 años Sum
## Blue 7520 1916 9436
## Gold 95 21 116
## Platinum 19 1 20
## Silver 457 98 555
## Sum 8091 2036 10127tabla_3a_prob<-proportions(tabla_3a);tabla_3a_prob##
## 40 años o más menos de 40 años
## Blue 7.425694e-01 1.891972e-01
## Gold 9.380863e-03 2.073664e-03
## Platinum 1.876173e-03 9.874593e-05
## Silver 4.512689e-02 9.677101e-03addmargins(tabla_3a_prob)##
## 40 años o más menos de 40 años Sum
## Blue 7.425694e-01 1.891972e-01 9.317666e-01
## Gold 9.380863e-03 2.073664e-03 1.145453e-02
## Platinum 1.876173e-03 9.874593e-05 1.974919e-03
## Silver 4.512689e-02 9.677101e-03 5.480399e-02
## Sum 7.989533e-01 2.010467e-01 1.000000e+00Problema 4:
Encuentre las probabilidades marginales y conjuntas para:
*insertar tabla
¿Qu ́e se puede inferir en cuanto a los ingresos de los clientes del banco y su estado civil? Realice gr ́aficos y analice frecuencias porcentuales de la tabla para fundamentar su respuesta
tabla_4a<-table(tarjetas$Marital_Status,tarjetas$Income_Category);tabla_4a##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K Unknown
## Divorced 52 138 108 103 254 93
## Married 354 816 661 735 1628 493
## Single 274 704 531 561 1429 444
## Unknown 47 132 102 136 250 82addmargins(tabla_4a)##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K Unknown
## Divorced 52 138 108 103 254 93
## Married 354 816 661 735 1628 493
## Single 274 704 531 561 1429 444
## Unknown 47 132 102 136 250 82
## Sum 727 1790 1402 1535 3561 1112
##
## Sum
## Divorced 748
## Married 4687
## Single 3943
## Unknown 749
## Sum 10127tabla_4a_1<-proportions(tabla_4a)
addmargins(tabla_4a_1)##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K
## Divorced 0.005134788 0.013626938 0.010664560 0.010170830 0.025081465
## Married 0.034956058 0.080576676 0.065271058 0.072578256 0.160758369
## Single 0.027056384 0.069517132 0.052434087 0.055396465 0.141107929
## Unknown 0.004641059 0.013034462 0.010072085 0.013429446 0.024686482
## Sum 0.071788289 0.176755209 0.138441789 0.151574998 0.351634245
##
## Unknown Sum
## Divorced 0.009183371 0.073861953
## Married 0.048681742 0.462822159
## Single 0.043843191 0.389355189
## Unknown 0.008097166 0.073960699
## Sum 0.109805471 1.000000000for (i in 4) {barplot(tabla_4a[i,],col="lightblue", main="Numero de personas por cada nivel de ingresos",xlab="Nivel de ingresos", ylab="# personas")}
barplot(tabla_4a[1,],col="lightblue", main="Divorciados por cada nivel de ingreso", xlab="Nivel de ingresos", ylab="# divorciados")
barplot(tabla_4a[2,],col="lightblue", main="Casados por cada nivel de ingreso", xlab="Nivel de ingresos", ylab="# casados")
barplot(tabla_4a[3,],col="lightblue", main="Solteros por cada nivel de ingresos", xlab="Nivel de ingresos", ylab="# solteros")
barplot(tabla_4a[4,],col="lightblue", main="Desconocidos por cada nivel de ingresos", xlab="Nivel de ingresos", ylab="# desconocidos")
Analisis: Podemos observar que la distribución de la
grafica es la misma para todas, lo unico que varian son los valores del
eje y, o sea la cantidad de personas que hay en cada rango de
ingresos.
Problema 5:
Elabore la tabla de contingencia para los ingresos de los clientes y el perfil educativo del mismo. Encuentre la probabilidad de que un representante seleccionado al azar: - Tenga posgrado. - Tenga ingresos entre $60K-$80K dado que es graduado universitario. - Sea doctor si tiene de ingresos m ́as de $ 120K. - Dado que es de ecuela secundaria, no tenga ingresos entre $80.000 y $ 120.000 d ́olares. - Si se sabe que el cliente tiene menos de 120.000 d ́olares de ingresos anuales, provenga de un cliente con escuela secundaria.
tabla_5a<-table(tarjetas$Education_Level,tarjetas$Income_Category);tabla_5a##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K
## College 70 183 132 175 345
## Doctorate 37 70 59 57 158
## Graduate 204 553 422 478 1139
## High School 147 355 307 308 671
## Post-Graduate 30 111 77 81 170
## Uneducated 119 249 195 217 522
## Unknown 120 269 210 219 556
##
## Unknown
## College 108
## Doctorate 70
## Graduate 332
## High School 225
## Post-Graduate 47
## Uneducated 185
## Unknown 145addmargins(tabla_5a)##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K
## College 70 183 132 175 345
## Doctorate 37 70 59 57 158
## Graduate 204 553 422 478 1139
## High School 147 355 307 308 671
## Post-Graduate 30 111 77 81 170
## Uneducated 119 249 195 217 522
## Unknown 120 269 210 219 556
## Sum 727 1790 1402 1535 3561
##
## Unknown Sum
## College 108 1013
## Doctorate 70 451
## Graduate 332 3128
## High School 225 2013
## Post-Graduate 47 516
## Uneducated 185 1487
## Unknown 145 1519
## Sum 1112 10127tabla_5a_prob<-proportions(tabla_5a)
addmargins(tabla_5a_prob)##
## $120K + $40K - $60K $60K - $80K $80K - $120K Less than $40K
## College 0.006912215 0.018070505 0.013034462 0.017280537 0.034067345
## Doctorate 0.003653599 0.006912215 0.005826010 0.005628518 0.015601856
## Graduate 0.020144169 0.054606497 0.041670781 0.047200553 0.112471611
## High School 0.014515651 0.035054804 0.030315000 0.030413745 0.066258517
## Post-Graduate 0.002962378 0.010960798 0.007603436 0.007998420 0.016786808
## Uneducated 0.011750765 0.024587736 0.019255456 0.021427866 0.051545374
## Unknown 0.011849511 0.026562654 0.020736645 0.021625358 0.054902735
## Sum 0.071788289 0.176755209 0.138441789 0.151574998 0.351634245
##
## Unknown Sum
## College 0.010664560 0.100029624
## Doctorate 0.006912215 0.044534413
## Graduate 0.032783648 0.308877259
## High School 0.022217834 0.198775551
## Post-Graduate 0.004641059 0.050952898
## Uneducated 0.018267996 0.146835193
## Unknown 0.014318159 0.149995063
## Sum 0.109805471 1.000000000Bloque 3
Problema 6:
Para este bloque podemos usar el teorema de probabilidad total y de probabilidad condicional
P(F): Probabilidad de que fume
P(H): Probabilidad de que sea hombre
P(M): Probabilidad de que sea mujer
P(H) = 0.15
P(M) = 0.85
P(F|H) = 0.7
P(F|M) = 0.3
- Hallar la probabilidad de que fume p(F)
\[P(F) = P(H \cap F) + P(M \cap F)\]
\[P(A|B) = \frac{P(A \cap B)}{P(B)}\]
\[P(F) = P(H) P(H|F) + P(M) P(M|F)\]
\[P(F) = (0.15)(0.7) + (0.85)(0.3)\]
\[P(F) = 0.275\]
Problema 7:
E: Cumple con las especificaciones
P(B1) = 0.6
P(B2) = 0.25
P(B3) = 0.15
P(E|B1) = 0.9
P(E|B2) = 0.85
P(E|B3) = 0.6
P(E) = ?
P(B2|E) = ?
- Encontrar la probabilidad de que cumpla con las especificaciones
\[P(E) = P(B1 \cap E) + P(B2 \cap E) + P(B3 \cap E)\]
\[P(E) = P(B1)P(E|B1) + P(B2)P(E|B2) + P(B3)P(E|B3)\]
\[P(E) = (0.6)(0.9) + (0.25)(0.85) + (0.15)(0.6)\]
\[P(E) = 0.8425\]
- Encontrar P(B2|E)
\[P(B2|E) = \frac{P(B2 \cap E)}{P(E)}\]
\[P(B2|E) = \frac{P(E|B2)P(B2)}{P(E)}\]
\[P(B2|E) = \frac{(0.85)(0.25)}{(0.8425)}\]
\[P(B2|E) = 0.2522\]
Problema 8:
s: estudios superiores
m: estudios medios
p: estudios primarios
n: no tiene estudios
d: desempleado
P(s) = 0.07
P(m) = 0.2
P(p) = 0.6
P(n) = 0.13
P(d|s) = 0.1
P(d|m) = 0.35
P(d|p) = 0.18
P(d|n) = 0.37
- Probabilidad de estar desempleado P(d)
\[P(d) = P(d \cap s) + P(d \cap m) + P(d \cap p) + P(d \cap n)\]
\[P(d) = P(d|s)P(s) + P(d|m)P(m) + P(d|p)P(p) + P(d|n)P(n)\]
\[P(d) = (0.1)(0.07) + (0.35)(0.2) + (0.18)(0.6) + (0.37)(0.13)\]
\[P(d) = 0.2331\]
- Probabilidad de tener estudios superiores sabiendo que está desempleado p(s|d)
\[P(s|d) = \frac{P(s \cap d)}{P(d)}\]
\[P(s|d) = \frac{P(d|s)P(s)}{P(d)}\]
\[P(s|d) = \frac{(0.1)(0.07)}{(0.2331)}\]
\[P(s|d) = 0.030\]