En el siguiente docuemnto se realiza un estudio estadistico de una base de datos relacionada con los clientes de una entidad financiera que solicitan un credito. A partir de tablas y gráficos adecuados se visualizará el comportamiento de las diferentes variables enontradas en los datos, luego, las herramientas de la estadística descriptiva nos indicarán valores que describen los diferentes comportamientos de las variables, gracias a estos valores se podra hacer un análisis más profundo de los datos trabajados.
Para comenzar, se instala la librería “datos” y se carga la base de datos “datos_credito”, la cual es un data.frame con 14 filas y 4454 columnas de datos asociados a créditos de consumo.
Se crea una semilla aleatoriamente con los últimos dígitos de los documentos de identidad de los integrantes del grupo.
La muestra se visualizará como una tabla denominada muestra2 y consta de unos datos asociados a 14 variables entre cuantitativas y cualitativas.
Refiere a la relación que ha tenido un cliente con los pagos del credito dado.
#Frecuencia absoluta
fabs_Estado <- table(muestra2$Estado)
#Frecuencia absoluta acumulada
fabs_acumEstado <- cumsum(fabs_Estado)
#Frecuencia relativa
frel_Estado <- fabs_Estado/length(muestra2$Estado)
#Frecuencia relativa (%)
frel_EstadoP <- (fabs_Estado/length(muestra2$Estado))*100
#Frecuencia relativa acumulada
frel_acumEstado <- cumsum(frel_Estado)
#Frecuencia relativa acumulada (%)
frel_acum_EstadoP <- cumsum(frel_EstadoP)
#Se crea una variable que combine en una columna a los datos calculados previamente
datos_Estado <- cbind(fabs_Estado,fabs_acumEstado,frel_Estado,frel_EstadoP,frel_acumEstado,frel_acum_EstadoP)
#Se construye la tabla de frecuencia para la variable "Estado":
titulos1 <- c("Frecuencia Absoluta","Frequencia Absoluta Acumulada","Frecuencia Relativa","(%)","Frecuencia Relativa Acumulada","(%)")
library(kableExtra)
tabla1_freqEstado <- kable(datos_Estado, caption = "Tabla de Frecuencia: Estado del crédito", format = "markdown", col.names = titulos1, align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_freqEstado| Frecuencia Absoluta | Frequencia Absoluta Acumulada | Frecuencia Relativa | (%) | Frecuencia Relativa Acumulada | (%) | |
|---|---|---|---|---|---|---|
| malo | 19 | 19 | 0.19 | 19 | 0.19 | 19 |
| bueno | 81 | 100 | 0.81 | 81 | 1.00 | 100 |
Con la anterior tabla de frecuencias se pueden identificar patrones y resumir datos del estado del crédito de la muestra evaluada. Esto se puede ver mejor en el siguiente diagrama de torta:
etiquetaEst <- paste(frel_EstadoP,"%",sep=" ")
colores_rosados <- c("#FF1493", "#FFC0CB")
pie(frel_EstadoP,labels = etiquetaEst, clockwise = TRUE, col = colores_rosados, main = "Estado del crédito", cex = 0.8, border = "white", radius = 0.8, font.main = 1, init.angle = 90)
legend("topright",c("Bueno", "Malo"),cex=0.9,fill=colores_rosados, border = "white")De acuerdo con esto, se puede afirmar que sólo el 19 % de la muestra estudiada, está al día con los pagos y cumple con los términos y condiciones acordados de un crédito bancario.
Esta variable indica cual es el estado civil al momento de pedir el credito.
#Frecuencia absoluta
fabs_EstCivil <- table(muestra2$EstadoCivil)
#Frecuencia absoluta acumulada
fabs_acumEstCivil <- cumsum(fabs_EstCivil)
#Frecuencia relativa
frel_EstCivil <- fabs_EstCivil/length(muestra2$EstadoCivil)
#Frecuencia relativa (%)
frel_EstCivilP <- (fabs_EstCivil/length(muestra2$EstadoCivil))*100
#Frecuencia relativa acumulada
frel_acumEstCivil <- cumsum(frel_EstCivil)
#Frecuencia relativa acumulada (%)
frel_acum_EstCivilP <- cumsum(frel_EstCivilP)
#Se crea una variable que combine en una columna a los datos calculados previamente
datos_EstCivil <- cbind(fabs_EstCivil,fabs_acumEstCivil,frel_EstCivil,frel_EstCivilP,frel_acumEstCivil,frel_acum_EstCivilP)
#Se construye la tabla de frecuencia para la variable "Estado Civil":
titulos2 <- c("Frecuencia Absoluta","Frequencia Absoluta Acumulada","Frecuencia Relativa","(%)","Frecuencia Relativa Acumulada","(%)")
tabla2_freqEstCivil <- kable(datos_EstCivil, caption = "Tabla de Frecuencia: Estado civil", format = "markdown", col.names = titulos2, align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla2_freqEstCivil| Frecuencia Absoluta | Frequencia Absoluta Acumulada | Frecuencia Relativa | (%) | Frecuencia Relativa Acumulada | (%) | |
|---|---|---|---|---|---|---|
| divorciado | 0 | 0 | 0.00 | 0 | 0.00 | 0 |
| casado | 68 | 68 | 0.68 | 68 | 0.68 | 68 |
| separado | 3 | 71 | 0.03 | 3 | 0.71 | 71 |
| soltero | 28 | 99 | 0.28 | 28 | 0.99 | 99 |
| viudo | 1 | 100 | 0.01 | 1 | 1.00 | 100 |
Con lo anterior, se realizó un histograma para comparar visualmente la frecuencia o proporción de las diferentes categorías en la variable:
library(ggplot2)
ggplot(data = muestra2, aes(x = EstadoCivil, fill = EstadoCivil)) + geom_bar(show.legend = FALSE) +
geom_bar() +
labs(
title = "Estado Civil",
x = "Estado Civil",
y = "Frecuencia"
) +
theme_minimal() + # Estilo minimalista
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
scale_fill_manual(values = c("#FF1493", "#FFC0CB", "#8B475D", "#B03060", "#FF69B4")) + theme(legend.title = element_blank())Indica el tipo de trabajo de cada uno de los clientes
#frecuencia absoluta
fabs_trabajo<-table(muestra2$Trabajo)
#Frecuencia absoluta acumulada
fabs_acum_trabajo<-cumsum(fabs_trabajo)
#Frecuencia relativa
frel_trabajo<-fabs_trabajo/length(muestra2$Trabajo)
#fecuencia relativa porcentaje
frel_trabajo_p<-(fabs_trabajo/length(muestra2$Trabajo))*100
#Frecuencia relativa acumulada
frel_acum_trabajo<-cumsum(frel_trabajo)
#Frecuencia relativa acumulada en porcentaje
frel_acum_trabajo_p<-cumsum(frel_trabajo_p)
#Se crea una variable que combine en una columna a los datos calculados previamente
datos_Trabajo <- cbind(fabs_trabajo,fabs_acum_trabajo,frel_trabajo,frel_trabajo_p,frel_acum_trabajo,frel_acum_trabajo_p)
#Se construye la tabla de frecuencia para la variable "Estado":
titulos11 <- c("Frecuencia Absoluta","Frequencia Absoluta Acumulada","Frecuencia Relativa","(%)","Frecuencia Relativa Acumulada","(%)")
tabla1_freqTrabajo <- kable(datos_Trabajo, caption = "Tabla de Frecuencia: Estado del crédito", format = "markdown", col.names = titulos11, align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_freqTrabajo| Frecuencia Absoluta | Frequencia Absoluta Acumulada | Frecuencia Relativa | (%) | Frecuencia Relativa Acumulada | (%) | |
|---|---|---|---|---|---|---|
| fijo | 65 | 65 | 0.65 | 65 | 0.65 | 65 |
| freelance | 23 | 88 | 0.23 | 23 | 0.88 | 88 |
| otros | 2 | 90 | 0.02 | 2 | 0.90 | 90 |
| tiempo parcial | 10 | 100 | 0.10 | 10 | 1.00 | 100 |
Con la anterior tabla de frecuencias tenemos una visión clara de la distribución de tipos de trabajo y cómo se comparan entre sí en términos de frecuencia y proporción.
plot(x=muestra2$Trabajo, main="Histograma tipo de trabajo",
xlab= "Tipo de Trabajo", ylab="Frecuencia",
col = c("#7FFFD4","#7FFFD4", "#76EEC6", "#458B74"),
border="black",
xlim=c(0,5),
ylim=c(0,70),
axes=TRUE)pie3D(frel_trabajo_p,main="Diagrama de torta",
col = hcl.colors(length(frel_trabajo_p),"viridis"),
labels = paste0(frel_trabajo_p,"%"),
labelcol = "red",
border = "black",
explode = 0.04,
labelcex = 0.8)
legend(x="topright", legend=c("Fijo","Freelance","Otro","Tiempo parcial"),fill = hcl.colors(length(frel_trabajo_p),"viridis"),title="Trabajo",border="white",box.col = "white",cex = 0.6)Del anterior diagrama podemos observar que el la mayoria de personas cuentan con un trabajo fijo, seguido de personas que trabajan freelance, personas que trabajan por tiempo parcial y personas con otro tipo de trabajo
# TABLA DE FRECUENCIAS PARA TIPO DE VIVIENDA
#Frecuencia absoluta
fabs_Vivienda <- table(muestra2$Vivienda)
#Frecuencia absoluta acumulada
fabs_acumVivienda <- cumsum(fabs_Vivienda)
#Frecuencia relativa
frel_Vivienda <- fabs_Vivienda/length(muestra2$Vivienda)
#Frecuencia relativa (%)
frel_ViviendaP <- (fabs_Vivienda/length(muestra2$Vivienda))*100
#Frecuencia relativa acumulada
frel_acumVivienda <- cumsum(frel_Vivienda)
#Frecuencia relativa acumulada (%)
frel_acum_ViviendaP <- cumsum(frel_ViviendaP)
datos_Vivienda <- cbind(fabs_Vivienda,fabs_acumVivienda,frel_Vivienda,
frel_ViviendaP,frel_acumVivienda,frel_acum_ViviendaP)
titulos1 <- c("F. Absoluta","F. Abs. Acu.","F. Rel.","(%)",
"F. Rel. Acu.","(%)")
library(kableExtra)
tabla1_freqVivienda <- kable(datos_Vivienda,
caption = "Tabla de Frecuencia: Tipo de Vivienda",
format = "markdown", col.names = titulos1,
align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_freqVivienda| F. Absoluta | F. Abs. Acu. | F. Rel. | (%) | F. Rel. Acu. | (%) | |
|---|---|---|---|---|---|---|
| ignorar | 0 | 0 | 0.00 | 0 | 0.00 | 0 |
| otra | 4 | 4 | 0.04 | 4 | 0.04 | 4 |
| propietario | 50 | 54 | 0.50 | 50 | 0.54 | 54 |
| padres | 23 | 77 | 0.23 | 23 | 0.77 | 77 |
| privado | 3 | 80 | 0.03 | 3 | 0.80 | 80 |
| alquila | 20 | 100 | 0.20 | 20 | 1.00 | 100 |
# HISTOGRAMA TIPO DE VIVIENDA // cambiar colores
library(paletteer)
library(ggplot2)
ggplot(data = muestra2, aes(x = Vivienda, fill = Vivienda)) +
geom_bar(show.legend = FALSE) +
geom_bar() +
labs(
title = "Tipo de vivienda",
x = "Vivienda",
y = "Frecuencia"
) +
theme_minimal() + # Estilo minimalista
scale_fill_manual(values = paletteer_c("ggthemes::Red-Gold", 5)) +
theme(legend.title = element_blank())En el análisis de la variable “Tipo de Vivienda”, se observa que la mayoría de las personas encuestadas son propietarias de sus viviendas, representando el 54% de la muestra. Le siguen aquellos que viven con sus padres, con un 23% de las observaciones. En contraste, un pequeño porcentaje de la muestra, aproximadamente el 3%, alquila su vivienda, mientras que una categoría denominada “otra” comprende el 4% de las observaciones. Es importante notar que el 20% de los encuestados no proporciona información sobre su tipo de vivienda, marcando esta variable como “ignorar”.
# DIAGRAMA CIRCULAR TIPO DE VIVIENDA // cambiar colores
library(paletteer)
etiquetaVivienda <- paste(frel_ViviendaP[-1],"%",sep="")
colores_rojos <- paletteer_c("ggthemes::Red-Gold", 5)
pie(frel_ViviendaP[-1],labels = etiquetaVivienda, clockwise = TRUE,
col = colores_rojos, main = "Tipo de vivienda", cex = 1,
border = "white", radius = 1, font.main = 1, init.angle = 0)
legend("topright",c("Otra", "Propietario", "Padres", "Privado", "Alquila"),
cex=0.5,fill=colores_rojos, border = "white")Este análisis resulta relevante para comprender la composición de la muestra en términos de la situación de vivienda de los encuestados, lo que puede influir en la toma de decisiones informadas relacionadas con el análisis de créditos bancarios.
Los registros refieren a los datos almacenados con anterioridad por la entidad bancaria de algún cliente.
# Tabla de frecuencias
#Frecuencia absoluta
fabs_Registros <- table(muestra2$Registros)
#Frecuencia absoluta acumulada
fabs_acumRegistros <- cumsum(fabs_Registros)
#Frecuencia relativa
frel_Registros <- fabs_Registros/length(muestra2$Registros)
#Frecuencia relativa (%)
frel_RegistrosP <- (fabs_Registros/length(muestra2$Registros))*100
#Frecuencia relativa acumulada
frel_acumRegistros <- cumsum(frel_Registros)
#Frecuencia relativa acumulada (%)
frel_acum_RegistrosP <- cumsum(frel_RegistrosP)
#Se crea una variable que combine en una columna a los datos calculados previamente
datos_Registros <- cbind(fabs_Registros,fabs_acumRegistros,frel_Registros,frel_RegistrosP,frel_acumRegistros,frel_acum_RegistrosP)
#Se construye la tabla de frecuencia para la variable "Estado":
titulos1 <- c("Frecuencia Absoluta","Frequencia Absoluta Acumulada","Frecuencia Relativa","(%)","Frecuencia Relativa Acumulada","(%)")
library(kableExtra)
tabla1_freqRegistros <- kable(datos_Registros, caption = "Tabla de Frecuencia: Existencia de Registros previos", format = "markdown", col.names = titulos1, align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_freqRegistros| Frecuencia Absoluta | Frequencia Absoluta Acumulada | Frecuencia Relativa | (%) | Frecuencia Relativa Acumulada | (%) | |
|---|---|---|---|---|---|---|
| no | 85 | 85 | 0.85 | 85 | 0.85 | 85 |
| sí | 15 | 100 | 0.15 | 15 | 1.00 | 100 |
reg <- muestra2 %>%
group_by(Registros) %>% # Variable to be transformed
count() %>%
ungroup() %>%
mutate(perc = `n` / sum(`n`)) %>%
arrange(perc) %>%
mutate(labels = scales::percent(perc))
ggplot(reg, aes(x = "", y = perc, fill = Registros)) +
geom_col() +
geom_bar(stat = "identity", color = "grey95",
lwd = 0.5, show.legend = FALSE)+
geom_text(aes(label = labels),
position = position_stack(vjust = 0.5)) +
scale_fill_manual(values = c("#FFE4C4","#54FF9F"))+
labs(title = "Gráfico de torta para registros")+
coord_polar(theta = "y") +
theme_void()Como se puede observar solo el 15% de la muestra presenta un registro previo, ante la entidad encargada. Eso nos indica que, en su mayoria las personas estan pidiendo por primera vez un credito o es la primera vez que piden credito con esta entidad. De aquí podemos deducir que las politicas para atraer nuevos clientas de la empresa funcionan bastante bien.
library(descriptr)
# Calcular media, mediana y moda
mediaEdad <- mean(muestra2$Edad)
medianaEdad <- median(muestra2$Edad)
modaEdad <- ds_mode(muestra2$Edad)
# Se construye la tabla de medidas de tendencia central para la variable "Edad":
t_centEdad <- data.frame(Media = mediaEdad, Mediana = medianaEdad, Moda = modaEdad)
tabla3_tcentEdad <- kable(t_centEdad, caption = "Medidas de tendencia central: Edad del cliente", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentEdad| Media | Mediana | Moda |
|---|---|---|
| 35.13 | 35 | 41 |
A continuación, se realiza un análisis más detallado de las edades, explorando su distribución a través de gráficos. Estos gráficos proporcionan una representación visual de cómo se distribuyen las edades en el conjunto de datos y ayudarán a identificar valores atípicos:
library(dplyr)
sumstatz <- data.frame(
t_centEdad = c("Media", "Mediana", "Moda"),
value = c(mediaEdad, medianaEdad, modaEdad)
)
ggEdad <- ggplot(muestra2, aes(x = Edad)) +
geom_histogram(color = "black", fill = "white", binwidth = 10) +
labs(
title = "Medidas de tendencia central: Edad del cliente",
x = "Edad del cliente",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centEdad, color = t_centEdad), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "#FF1493", "Mediana" = "#FFC0CB", "Moda" = "#B03060")) + theme(legend.title = element_blank())
ggEdad + coord_cartesian(xlim = c(0, 80), ylim = c(0, 50))# Medidas de dispersión
rangoEdad <- range(muestra2$Edad)
rangoEdad1 <- paste("[", rangoEdad[1], " - ", rangoEdad[2], "]", sep = "")
varEdad <- var(muestra2$Edad)
desvestEdad <- sd(muestra2$Edad)
coefvarEdad <- desvestEdad/mean(muestra2$Edad)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispEdad <- data.frame(Rango = rangoEdad1, Varianza = varEdad, 'Desviación estándar' = desvestEdad, 'Coeficiente de variación' = coefvarEdad)
titulos3 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla4_tdispEdad <- kable(t_dispEdad, caption = "Medidas de dispersión: Edad del cliente", format = "markdown", col.names = titulos3, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla4_tdispEdad| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [18 - 66] | 99.63 | 9.98 | 0.28 |
El análisis de medidas de dispersión revela que las edades en la muestra tienen un rango de 18 - 66 años, lo que indica una variabilidad en las edades de los clientes. La varianza y la desviación estándar muestran cuánto se desvían las edades individuales de la edad promedio; con el valor de 99.63 se muestra que los valores en ese conjunto están bastante dispersos o alejados de la media. Por otro lado, el coeficiente de variación nos indica que la dispersión relativa en las edades es del 0.28 % en relación con la edad promedio. En el siguiente gráfico de dispersión se puede observar mucho mejor la dispersión de las edades en la muestra:
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Edad)) +
geom_point(col = "#FF1493") +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(size = 0.5, color = "black")) +
labs(title = "Gráfico de dispersión", subtitle = "Edad del cliente", y = "Edad ", x= "Cliente")# Cálculo de cuartiles
Q1Edad <- quantile(muestra2$Edad,0.25,type = 6)
Q2Edad <- quantile(muestra2$Edad,0.50,type = 6)
Q3Edad <- quantile(muestra2$Edad,0.75,type = 6)
# Construcción de la tabla
t_cuantilEdad <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Edad, Q2Edad, Q3Edad)
)
print(t_cuantilEdad)## Cuartil Valor
## 25% Q1 26.25
## 50% Q2 35.00
## 75% Q3 41.00
Los tres cuartiles son medidas de posición que dividen un conjunto de datos en partes iguales o proporcionan información sobre la distribución de los datos en relación con la mediana. Son útiles para identificar valores atípicos, entender la variabilidad en los datos y obtener una visión general de cómo se distribuyen las observaciones en un conjunto de datos numéricos, esto se puede observar mucho mejor en el siguiente diagrama:
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilEdad = c("Q1", "Q2", "Q3"),
value = c(Q1Edad, Q2Edad, Q3Edad)
)
ggEdadQ <- ggplot(muestra2, aes(x = Edad)) +
geom_histogram(color = "black", fill = "white", binwidth = 10) +
labs(
title = "Cuartiles: Edad del cliente",
x = "Edad del cliente",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilEdad, color = t_cuantilEdad), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "#FF1493", "Q2" = "#FFC0CB", "Q3" = "#B03060")) + theme(legend.title = element_blank())
ggEdadQ + coord_cartesian(xlim = c(0, 80), ylim = c(0, 50))En el siguiente boxplot se observa sólo 1 dato atípico, que corresponde a un solicitante mayor a 60 años. Sin embargo, los datos tienen tendencia hacia valores medios; aunque la mediana sea cercana a la media, esta se encuentra por debajo de ella.
La curtosis es una medida estadística que se utilizará para describir la forma de la distribución del conjunto de datos de esta variable y evaluar qué tan concentrados o dispersos están los valores alrededor de la media. En otras palabras, la curtosis indica la “colas” o extremos de la distribución de datos y cómo se comparan con una distribución normal (campana de Gauss). Para observar esto, se realiza una gráfica que muestre la densidad de la frecuencia del conjunto de datos:
library(paletteer)
library(ggthemes)
#### Histograma: Edad
# Construcción gráfica
sumstati <- data.frame(MediaEdad_curt = c("Media"), value = c(mediaEdad))
ggplot(muestra2, aes(x = muestra2$Edad)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "gray89") +
geom_density(lwd = 1, linetype = 2, color = "#FF1493", fill = "#FFC0CB", alpha = 0.25) +
labs(title = "Histograma: Edad del cliente", x = "Edad", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaEdad_curt), linewidth = 1) +
theme(legend.title = element_blank())library(moments)
curtEdad <- kurtosis(muestra2$Edad)
print(paste("La curtosis de los datos de la edad es:", round(curtEdad, 2)))## [1] "La curtosis de los datos de la edad es: 3.15"
Este valor obtenido indica que la distribución de datos tiene una curtosis positiva, es decir que la distribución es leptocúrtica. Esto significa que la distribución tiene colas más pesadas y picos más agudos en comparación con una distribución normal. En otras palabras, los valores tienden a estar más concentrados alrededor de la media.
asimEdad <- skewness(muestra2$Edad)
print(paste("La asimetría de los datos de la edad es:", round(asimEdad, 2)))## [1] "La asimetría de los datos de la edad es: 0.62"
Por otro lado, la asimetría es una medida estadística que describe la inclinación o desviación de la distribución de datos con respecto a la distribución normal. Indica si la cola de la distribución se inclina hacia la izquierda (asimetría negativa) o hacia la derecha (asimetría positiva) en relación con la media. En este caso, se observa que para la variable Edad, la distribución presenta una simetría positiva.
# Calcular media, mediana y moda
mediaGastos <- mean(muestra2$Gastos)
medianaGastos <- median(muestra2$Gastos)
modaGastos <- ds_mode(muestra2$Gastos)
# Se construye la tabla de medidas de tendencia central para la variable "Edad":
t_centGastos <- data.frame(Media = mediaGastos, Mediana = medianaGastos, Moda = modaGastos)
tabla5_tcentGastos <- kable(t_centGastos, caption = "Medidas de tendencia central: Cantidad de gastos", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla5_tcentGastos| Media | Mediana | Moda |
|---|---|---|
| 54.32 | 45 | 35 |
A continuación, se realiza un análisis más detallado de los gastos, explorando su distribución a través de gráficos:
sumstatz <- data.frame(
t_centGastos = c("Media", "Mediana", "Moda"),
value = c(mediaGastos, medianaGastos, modaGastos)
)
ggGastos <- ggplot(muestra2, aes(x = Gastos)) +
geom_histogram(color = "black", fill = "white", binwidth = 10) +
labs(
title = "Medidas de tendencia central: Cantidad de gastos",
x = "Gastos",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centGastos, color = t_centGastos), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "#FF1493", "Mediana" = "#FFC0CB", "Moda" = "#B03060")) + theme(legend.title = element_blank())
ggGastos + scale_x_continuous(limits = NULL) + scale_y_continuous(limits = NULL)# Medidas de dispersión
rangoGastos <- range(muestra2$Gastos)
rangoGastos1 <- paste("[", rangoGastos[1], " - ", rangoGastos[2], "]", sep = "")
varGastos <- var(muestra2$Gastos)
desvestGastos <- sd(muestra2$Gastos)
coefvarGastos <- desvestGastos/mean(muestra2$Gastos)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispGastos <- data.frame(Rango = rangoGastos1, Varianza = varGastos, 'Desviación estándar' = desvestGastos, 'Coeficiente de variación' = coefvarGastos)
titulos4 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla5_tdispGastos <- kable(t_dispGastos, caption = "Medidas de dispersión: Gastos", format = "markdown", col.names = titulos4, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla5_tdispGastos| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [35 - 120] | 347.55 | 18.64 | 0.34 |
Como se calculó, los gastos oscilan entre 35 y 120, este rango amplio sugiere una variabilidad significativa en los gastos de los solicitantes, lo que significa que algunos tienen gastos bajos mientras que otros tienen gastos bastante altos. En este caso, una varianza de 347.55 sugiere que los datos están relativamente dispersos, lo que concuerda con la observación anterior del rango amplio. Por su parte, la variabilidad en los gastos es del 34% con respecto a la media. Esto sugiere que, en relación con la media, los gastos varían moderadamente. En el siguiente gráfico de dispersión se puede observar mucho mejor la dispersión de esta variable en la muestra:
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Gastos)) +
geom_point(col = "#FF1493") +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(size = 0.5, color = "black")) +
labs(title = "Gráfico de dispersión", subtitle = "Gastos", y = "Edad ", x= "Cantidad de gastos")# Cálculo de cuartiles
Q1Gastos <- quantile(muestra2$Gastos,0.25,type = 6)
Q2Gastos <- quantile(muestra2$Gastos,0.50,type = 6)
Q3Gastos <- quantile(muestra2$Gastos,0.75,type = 6)
# Construcción de la tabla
t_cuantilGastos <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Gastos, Q2Gastos, Q3Gastos)
)
print(t_cuantilGastos)## Cuartil Valor
## 25% Q1 35.0
## 50% Q2 45.0
## 75% Q3 66.5
Lo anterior se puede observar mucho mejor en el siguiente diagrama:
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilGastos = c("Q1", "Q2", "Q3"),
value = c(Q1Gastos, Q2Gastos, Q3Gastos)
)
ggGastosQ <- ggplot(muestra2, aes(x = Gastos)) +
geom_histogram(color = "black", fill = "white", binwidth = 10) +
labs(
title = "Cuartiles: Gastos",
x = "Cantidad del gasto",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilGastos, color = t_cuantilGastos), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "#FF1493", "Q2" = "#FFC0CB", "Q3" = "#B03060")) + theme(legend.title = element_blank())
ggGastosQ + scale_x_continuous(limits = NULL) + scale_y_continuous(limits = NULL)En el siguiente boxplot se observa sólo 1 dato atípico, que corresponde a un solicitante que presenta gastos mayores a 110. Sin embargo, los datos tienen tendencia hacia valores bajos; aunque la mediana sea cercana a la media, esta se encuentra por debajo de ella.
# Construcción gráfica
sumstati <- data.frame(MediaGastos_curt = c("Media"), value = c(mediaGastos))
ggplot(muestra2, aes(x = muestra2$Gastos)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "gray89") +
geom_density(lwd = 1, linetype = 2, color = "#FF1493", fill = "#FFC0CB", alpha = 0.25) +
labs(title = "Histograma: Gastos", x = "Cantidad de gastos", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaGastos_curt), linewidth = 1) +
theme(legend.title = element_blank())curtGastos <- kurtosis(muestra2$Gastos)
print(paste("La curtosis de los datos de los gastos es:", round(curtGastos, 2)))## [1] "La curtosis de los datos de los gastos es: 3.71"
Este valor obtenido indica que los datos de los gastos tienen curtosis positiva, es decir que la distribución es leptocúrtica; los valores tienden a estar más concentrados alrededor de la media.
asimGastos <- skewness(muestra2$Gastos)
print(paste("La asimetría de los datos de los gastos es:", round(asimGastos, 2)))## [1] "La asimetría de los datos de los gastos es: 0.96"
Por otro lado, un valor de asimetría positiva, como 0.96, indica que la mayoría de los valores de este conjunto de datos están concentrados en el lado izquierdo de la distribución, cerca de la media, pero hay algunos valores muy altos en el lado derecho que hacen que la cola derecha sea más larga.
# TABLA DE FRECUENCIAS PARA ANTIGUEDAD
# Obtener el valor mínimo y máximo de la variable Antiguedad
min_antiguedad <- min(muestra2$Antiguedad)
max_antiguedad <- max(muestra2$Antiguedad)
num_int <- 1+3.33*log10(length(muestra2$Antiguedad));
num_int <- round(num_int);
ancho_intervalo <- (max_antiguedad - min_antiguedad) / num_int
# Para 8 intervalos
# Extraer los datos de la columna Antiguedad de muestra2
datos_antiguedad <- muestra2$Antiguedad
# Definir los límites de los intervalos de manera fija para 9 intervalos, de esta manera se mantiene el ancho de intervalo obtenido anteriormente
limites_intervalos <- c(0, 3, 6, 9, 12, 15, 18, 21, 24, 27) # Agregamos el límite superior 27
# Crear los intervalos y agrupar los datos con límites cerrados en el lado izquierdo
intervalos <- cut(datos_antiguedad, breaks = limites_intervalos, right = FALSE)
# Calcular las frecuencias de cada intervalo
fabs_Antiguedad <- table(intervalos)
fabs_acumAntiguedad <- cumsum(fabs_Antiguedad)
frel_Antiguedad <- fabs_Antiguedad / length(datos_antiguedad)
frel_AntiguedadP <- (fabs_Antiguedad / length(datos_antiguedad)) * 100
frel_acumAntiguedad <- cumsum(frel_Antiguedad)
frel_acum_AntiguedadP <- cumsum(frel_AntiguedadP)
# Crear la tabla de datos
datos_Antiguedad <- cbind(fabs_Antiguedad, fabs_acumAntiguedad, frel_Antiguedad,
frel_AntiguedadP, frel_acumAntiguedad, frel_acum_AntiguedadP)
# Definir los títulos de las columnas
titulos1 <- c("F. Absoluta", "F. Abs. Acu.", "F. Rel.", "(%)",
"F. Rel. Acu.", "(%)")
# Crear la tabla utilizando la librería kableExtra
library(kableExtra)
tabla1_freqAntiguedad <- kable(datos_Antiguedad,
caption = "Tabla de Frecuencia: Antigüedad",
format = "markdown", col.names = titulos1,
align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE)
# Mostrar la tabla
tabla1_freqAntiguedad| F. Absoluta | F. Abs. Acu. | F. Rel. | (%) | F. Rel. Acu. | (%) | |
|---|---|---|---|---|---|---|
| [0,3) | 35 | 35 | 0.35 | 35 | 0.35 | 35 |
| [3,6) | 26 | 61 | 0.26 | 26 | 0.61 | 61 |
| [6,9) | 12 | 73 | 0.12 | 12 | 0.73 | 73 |
| [9,12) | 2 | 75 | 0.02 | 2 | 0.75 | 75 |
| [12,15) | 12 | 87 | 0.12 | 12 | 0.87 | 87 |
| [15,18) | 4 | 91 | 0.04 | 4 | 0.91 | 91 |
| [18,21) | 5 | 96 | 0.05 | 5 | 0.96 | 96 |
| [21,24) | 3 | 99 | 0.03 | 3 | 0.99 | 99 |
| [24,27) | 1 | 100 | 0.01 | 1 | 1.00 | 100 |
La variable “Antigüedad Laboral” se refiere al tiempo en años que las personas encuestadas han trabajado en sus empleos actuales. Para determinar los intervalos en los que se agruparon los datos, se utilizó una fórmula bajo la regla de Sturges, que sugiere que el número de intervalos adecuados para un histograma debe ser aproximadamente igual a 1 + 3.33 * log10(n), donde ‘n’ es el tamaño de la muestra. En este caso, se obtuvo un resultado de 8 intervalos, aunque debido a la presencia de 25 valores diferentes, se optó por utilizar 9 intervalos, cada uno de tamaño 3 años.
La variable “Antigüedad Laboral” se refiere al tiempo en años que las personas encuestadas han trabajado en sus empleos actuales. Este aspecto es fundamental para evaluar la estabilidad financiera de los solicitantes de crédito, ya que una mayor antigüedad laboral tiende a ser percibida como un indicador de estabilidad y compromiso laboral.
Esta información es crucial para las instituciones bancarias al evaluar la solvencia crediticia de los solicitantes. Aquellos con una antigüedad laboral significativa pueden ser considerados como prestatarios más confiables, ya que su estabilidad en el empleo suele estar relacionada con la capacidad para cumplir con las obligaciones financieras. Por lo tanto, una larga antigüedad laboral puede influir positivamente en la decisión de otorgar créditos, ya que proporciona un indicio de la capacidad de un individuo para mantener ingresos constantes y, en consecuencia, pagar sus deudas de manera oportuna.
En resumen, la antigüedad laboral es un factor importante que influye en la buena vida crediticia de los solicitantes y genera confianza en las instituciones financieras al evaluar la solvencia de los clientes potenciales.
# MEDIDAS DE TENDENCIA CENTRAL
library(descriptr)
# Calcular media, mediana y moda
mediaAntiguedad <- mean(muestra2$Antiguedad)
medianaAntiguedad <- median(muestra2$Antiguedad)
modaAntiguedad <- ds_mode(muestra2$Antiguedad)
# Se construye la tabla de medidas de tendencia central para la variable "Antiguedad":
t_centAntiguedad <- data.frame(Media = mediaAntiguedad, Mediana = medianaAntiguedad, Moda = modaAntiguedad)
tabla3_tcentAntiguedad <- kable(t_centAntiguedad, caption = "Medidas de tendencia central: Antiguedad laboral del cliente", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentAntiguedad| Media | Mediana | Moda |
|---|---|---|
| 6.39 | 3 | 3 |
Las medidas de tendencia central nos proporcionan información valiosa sobre la antigüedad laboral de los clientes en este análisis. En primer lugar, la media aritmética, que es de aproximadamente 6.39 años, sugiere que, en promedio, las personas pueden llegar a permanecer en sus empleos actuales alrededor de 6 años. Esto podría indicar una estabilidad laboral relativamente sólida en la muestra. Sin embargo, es importante prestar atención a la mediana y la moda, ya que proporcionan una perspectiva más detallada. La mediana, que es 3 años, nos dice que la mitad de los encuestados tiene una antigüedad laboral de 3 años o menos en sus empleos actuales. Esto indica que existe una concentración de personas con un período relativamente corto de permanencia en sus trabajos.
Además, la moda, que también es 3 años, resalta que la antigüedad laboral más común en la muestra es de 3 años o menos, lo que subraya aún más que la mayoría de los encuestados no tienen una antigüedad laboral considerable.
library(dplyr)
sumstatz <- data.frame(
t_centAntiguedad = c("Media", "Mediana", "Moda"),
value = c(mediaAntiguedad, medianaAntiguedad, modaAntiguedad)
)
ggAntiguedad <- ggplot(muestra2, aes(x = Antiguedad)) +
geom_histogram(color = "black", fill =paletteer_c("ggthemes::Green-Gold", 9), binwidth = 3) +
labs(
title = "Medidas de tendencia central: Antiguedad del cliente",
x = "Antiguedad del cliente",
y = "Frecuencia"
) +
theme_minimal() +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centAntiguedad, color = t_centAntiguedad), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "#BF4F22", "Mediana" = "#EFB27E", "Moda" = "#7FAFD2")) + theme(legend.title = element_blank())
ggAntiguedad + coord_cartesian(xlim = c(-1, 25), ylim = c(0, 40))En resumen, aunque la media sugiere una antigüedad laboral promedio de 6.39 años, la mediana y la moda indican que la gran mayoría de los encuestados tienen una antigüedad laboral corta en comparación, lo que puede tener implicaciones importantes en la evaluación de la estabilidad financiera y la confiabilidad crediticia de los solicitantes.
# DATOS DE DISPERSIÓN ANTIGÜEDAD
# Medidas de dispersión
rangoAntiguedad <- range(muestra2$Antiguedad)
rangoAntiguedad1 <- paste("[", rangoAntiguedad[1], " - ", rangoAntiguedad[2], "]", sep = "")
varAntiguedad <- var(muestra2$Antiguedad)
desvestAntiguedad <- sd(muestra2$Antiguedad)
coefvarAntiguedad <- desvestAntiguedad/mean(muestra2$Antiguedad)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispAntiguedad <- data.frame(Rango = rangoAntiguedad1, Varianza = varAntiguedad, 'Desviación estándar' = desvestAntiguedad, 'Coeficiente de variación' = coefvarAntiguedad)
titulos3 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla4_tdispAntiguedad <- kable(t_dispAntiguedad, caption = "Medidas de dispersión: Antiguedad del cliente", format = "markdown", col.names = titulos3, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla4_tdispAntiguedad| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [0 - 24] | 40.38 | 6.35 | 0.99 |
Ciertamente, al analizar las medidas de dispersión para la variable “Antigüedad Laboral”, podemos obtener una perspectiva más clara de la tendencia en la muestra:
El rango, que abarca desde 0 hasta 24 años, nos muestra la amplitud total de la antigüedad laboral en la muestra. Esto significa que las personas en la encuesta tienen una antigüedad laboral que va desde recién comenzada (0 años) hasta un máximo de 24 años en sus empleos actuales.
La varianza, que es de 40.38, es una medida que indica cuánto se dispersan los datos con respecto a la media. En este caso, una varianza relativamente alta sugiere una dispersión significativa en la antigüedad laboral de los encuestados. Esto concuerda con la observación de que la mayoría de las personas no permanecen en sus trabajos durante períodos prolongados, lo que genera una dispersión en los datos.
La desviación estándar, que es de 6.35 años, proporciona una medida de cuánto se alejan los valores individuales de la media. Una desviación estándar más alta indica una mayor dispersión de datos con respecto a la media. En este caso, una desviación estándar significativamente diferente de cero respalda la idea de que las personas tienden a tener una antigüedad laboral variada en la muestra.
El coeficiente de variación, que es de 0.99 (aproximadamente 99%), mide la relación entre la desviación estándar y la media, expresada como porcentaje. Un coeficiente de variación más alto indica una mayor variabilidad en relación con la media. En este contexto, el coeficiente de variación refuerza la idea de que existe una notable variación en la antigüedad laboral de los encuestados, en consonancia con la concentración de datos en el primer intervalo (0-3 años) y la disminución significativa en los intervalos subsiguientes.
# GRFICO DE DISPERSIÓN
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Antiguedad)) +
geom_point(col = "#4E9D53") +
theme_minimal() +
labs(title = "Gráfico de dispersión", subtitle = "Antiguedad laboral del cliente", y = "Antiguedad ", x= "Cliente")En resumen, las medidas de dispersión revelan una tendencia notable en la muestra, donde la mayoría de las personas tienen una antigüedad laboral relativamente corta en sus empleos actuales. La varianza y la desviación estándar indican una dispersión significativa de datos en relación con la media, y el coeficiente de variación refuerza esta idea al destacar la variabilidad en la antigüedad laboral de los encuestados. La concentración de datos en el primer intervalo y la disminución subsiguiente sugieren que es poco común encontrar a personas que hayan permanecido en sus empleos durante décadas.
# MEDIDAS DE POSICIÓN
# Cálculo de cuartiles
Q1Antiguedad <- quantile(muestra2$Antiguedad,0.25,type = 6)
Q2Antiguedad <- quantile(muestra2$Antiguedad,0.50,type = 6)
Q3Antiguedad <- quantile(muestra2$Antiguedad,0.75,type = 6)
# Construcción de la tabla
t_cuantilAntiguedad <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Antiguedad, Q2Antiguedad, Q3Antiguedad)
)
print(t_cuantilAntiguedad)## Cuartil Valor
## 25% Q1 2.0
## 50% Q2 3.0
## 75% Q3 11.5
Q1 (Cuartil 1): El primer cuartil, representado por Q1, tiene un valor de 2.0 años, lo que indica que el 25% de los encuestados tienen una antigüedad laboral de 2 años o menos en sus empleos actuales.
Q2 (Cuartil 2): El segundo cuartil, también conocido como la mediana, tiene un valor de 3.0 años, resaltando la tendencia hacia una corta vida laboral en las empresas, donde el 50% de los encuestados tienen una antigüedad laboral de 3 años o menos.
Q3 (Cuartil 3): El tercer cuartil, representado por Q3, tiene un valor de 11.5 años. Esto indica que el 25% de los encuestados lleva más de una década trabajando en el mismo lugar, lo cual puede considerarse como un indicador positivo para su vida crediticia. #### Histograma
# MEDIDAS DE POSICIÓN EN HISTOGRAMA ANTIGUEDAD
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilAntiguedad = c("Q1", "Q2", "Q3"),
value = c(Q1Antiguedad, Q2Antiguedad, Q3Antiguedad)
)
ggAntiguedad <- ggplot(muestra2, aes(x = Antiguedad)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Classic Blue", 9), binwidth = 3) +
labs(
title = "Cuartiles: Antiguedad laboral del cliente",
x = "Antiguedad laboral",
y = "Frecuencia"
) +
theme_minimal() +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilAntiguedad, color = t_cuantilAntiguedad), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "#D4C95F", "Q2" = "#4E9D53", "Q3" = "#EAC34B")) + theme(legend.title = element_blank())
ggAntiguedad + coord_cartesian(xlim = c(-1, 25), ylim = c(0, 35))En resumen, los datos revelan una variedad en la antigüedad laboral de los encuestados, con una tendencia hacia la rotación laboral en la mayoría de los casos. Sin embargo, un segmento minoritario muestra una sólida estabilidad laboral a lo largo del tiempo. Estos hallazgos pueden ser de interés para la toma de decisiones en el ámbito crediticio y ofrecen una visión equilibrada de la diversidad en la trayectoria laboral de la muestra.
# DIAGRAMA DE CAJA ANTIGÜEDAD
boxplot(muestra2$Antiguedad, col = "#6E9F6D", ylab = "Antigüedad",
main = "Boxplot: Antigüedad laboral")
stripchart(muestra2$Edad,
method = "jitter",
pch = 19,
col = '#1F7835',
vertical = TRUE,
add = TRUE)El diagrama de caja muestra una mediana en 3 años, lo que indica que el 50% de los encuestados tienen una antigüedad laboral de 3 años o menos, resaltando la tendencia hacia una corta vida laboral en las empresas en la mayoría de los casos.
Sin embargo, es importante destacar la presencia de valores atípicos que se extienden más allá de los límites de la caja. Estos valores atípicos representan observaciones inusuales donde algunas personas tienen una antigüedad laboral considerablemente mayor que la mayoría, lo que indica una pequeña proporción de individuos con una estabilidad laboral excepcionalmente larga en sus empleos actuales.
En resumen, el diagrama de caja enfatiza la variabilidad en la antigüedad laboral, destacando tanto la mayoría con corta antigüedad como un grupo minoritario con una estabilidad laboral excepcional, representada por los datos atípicos. Estos hallazgos proporcionan una visión más completa de la distribución de la variable en la muestra.
# Construcción gráfica
sumstati <- data.frame(MediaAntiguedad_curt = c("Media"), value = c(mediaAntiguedad))
ggplot(muestra2, aes(x = muestra2$Antiguedad)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "gray89") +
geom_density(lwd = 1, linetype = 2, color = "#EA6D20", fill = "#FECEA3", alpha = 0.25) +
labs(title = "Histograma: Antiguedad", x = "Cantidad de Antiguedad", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaAntiguedad_curt), linewidth = 1) +
theme(legend.title = element_blank())curtAntiguedad <- ds_kurtosis(muestra2$Antiguedad)
print(paste("La curtosis de los datos de los Antiguedad es:", round(curtAntiguedad, 2)))## [1] "La curtosis de los datos de los Antiguedad es: 0.16"
Un valor de curtosis de 0.16 indica que los datos de antigüedad laboral son leptocúrticos, lo que significa que la distribución de los datos es más puntiaguda o aguda que la distribución normal. En otras palabras, hay una concentración de datos alrededor de la mediana y las colas de la distribución son relativamente delgadas en comparación con una distribución normal.
En un contexto práctico, esto sugiere que la mayoría de las personas en la muestra tienen una antigüedad laboral relativamente similar, lo que está en línea con lo que hemos observado previamente: una tendencia hacia una corta vida laboral con un grupo minoritario que muestra una estabilidad laboral significativa. La curtosis de 0.16 simplemente cuantifica esta observación al indicar que la distribución es puntiaguda en lugar de achatada o aplanada como en una distribución normal.
asimAntiguedad <- ds_skewness(muestra2$Antiguedad)
print(paste("La asimetría de los datos de los Antiguedad es:", round(asimAntiguedad, 2)))## [1] "La asimetría de los datos de los Antiguedad es: 1.11"
El valor de asimetría de 1.11 indica que los datos de antigüedad laboral están sesgados positivamente, lo que significa que la mayoría de las personas en la muestra tienen una antigüedad laboral relativamente corta, mientras que un grupo más pequeño muestra una antigüedad laboral considerablemente mayor, lo que provoca que la distribución se incline hacia la derecha.
La variable “Plazo” representa los meses de plazo a los que se fijan los créditos. Para analizar esta variable, se utilizó la regla de Sturges, que resultó en 8 intervalos, cada uno con un tamaño de 6 meses, lo que permite una segmentación adecuada de los datos a lo largo de medio año de plazo.
La tabla de frecuencia proporciona información relevante sobre los plazos de los créditos:
# TABLA DE FRECUENCIAS PARA LOS PLAZOS
# Calcular el número de intervalos
min_plazo <- min(muestra2$Plazo)
max_plazo <- max(muestra2$Plazo)
num_int <- 1 + 3.33 * log10(length(muestra2$Plazo))
num_int <- round(num_int)
ancho_intervalo <- (max_plazo - min_plazo) / num_int
# Definir los límites de los intervalos
limites_intervalos_plazo <- seq(min_plazo, max_plazo, by = ancho_intervalo)
limites_intervalos_plazo <- c(limites_intervalos_plazo, max_plazo + ancho_intervalo)
# Crear los intervalos y agrupar los datos
intervalos_plazo <- cut(muestra2$Plazo, breaks = limites_intervalos_plazo, right = FALSE)
# Calcular las frecuencias de cada intervalo
fabs_Plazo <- table(intervalos_plazo)
fabs_acumPlazo <- cumsum(fabs_Plazo)
frel_Plazo <- fabs_Plazo / length(muestra2$Plazo)
frel_PlazoP <- (fabs_Plazo / length(muestra2$Plazo)) * 100
frel_acumPlazo <- cumsum(frel_Plazo)
frel_acum_PlazoP <- cumsum(frel_PlazoP)
# Crear la tabla de datos con los títulos actualizados
titulos2 <- c("F. Absoluta", "F. Abs. Acu.", "F. Rel.", "(%)",
"F. Rel. Acu.", "(%)")
datos_Plazo <- cbind(fabs_Plazo, fabs_acumPlazo, frel_Plazo,
frel_PlazoP, frel_acumPlazo, frel_acum_PlazoP)
# Crear la tabla utilizando la librería kableExtra
library(kableExtra)
tabla2_freqPlazo <- kable(datos_Plazo,
caption = "Tabla de Frecuencia: Plazo",
format = "markdown", col.names = titulos2,
align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE)
# Mostrar la tabla
tabla2_freqPlazo| F. Absoluta | F. Abs. Acu. | F. Rel. | (%) | F. Rel. Acu. | (%) | |
|---|---|---|---|---|---|---|
| [12,18) | 6 | 6 | 0.06 | 6 | 0.06 | 6 |
| [18,24) | 3 | 9 | 0.03 | 3 | 0.09 | 9 |
| [24,30) | 11 | 20 | 0.11 | 11 | 0.20 | 20 |
| [30,36) | 4 | 24 | 0.04 | 4 | 0.24 | 24 |
| [36,42) | 19 | 43 | 0.19 | 19 | 0.43 | 43 |
| [42,48) | 0 | 43 | 0.00 | 0 | 0.43 | 43 |
| [48,54) | 17 | 60 | 0.17 | 17 | 0.60 | 60 |
| [54,60) | 0 | 60 | 0.00 | 0 | 0.60 | 60 |
| [60,66) | 40 | 100 | 0.40 | 40 | 1.00 | 100 |
En resumen, esta tabla de frecuencia nos muestra cómo se distribuyen los plazos de los créditos en la muestra, con una concentración significativa en los intervalos de 36 a 42 meses y de 60 a 66 meses. Los datos son valiosos para comprender la duración típica de los créditos y pueden ser útiles para la toma de decisiones en el ámbito financiero.
library(descriptr)
# Calcular media, mediana y moda
mediaPlazo <- mean(muestra2$Plazo)
medianaPlazo <- median(muestra2$Plazo)
modaPlazo <- ds_mode(muestra2$Plazo)
# Se construye la tabla de medidas de tendencia central para la variable "Plazo":
t_centPlazo <- data.frame(Media = mediaPlazo, Mediana = medianaPlazo, Moda = modaPlazo)
tabla3_tcentPlazo <- kable(t_centPlazo, caption = "Medidas de tendencia central: Plazo laboral del cliente", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentPlazo| Media | Mediana | Moda |
|---|---|---|
| 44.1 | 48 | 60 |
Media (44.1 meses): La media indica que, en promedio, los plazos de crédito son de aproximadamente 44 meses, lo que refleja una duración moderada.
Mediana (48 meses): La mediana señala que la mitad de los plazos de crédito son de 48 meses o más, sugiriendo una tendencia hacia plazos más largos en la muestra.
Moda (60 meses): La moda, que es de 60 meses, indica que muchos de los créditos tienen una duración de cinco años, lo que lo sugiere como una elección popular entre los clientes.
library(dplyr)
sumstatz <- data.frame(
t_centPlazo = c("Media", "Mediana", "Moda"),
value = c(mediaPlazo, medianaPlazo, modaPlazo)
)
ggPlazo <- ggplot(muestra2, aes(x = Plazo)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 9), binwidth = 6) +
labs(
title = "Medidas de tendencia central: Plazo del cliente",
x = "Plazo del cliente",
y = "Frecuencia"
) +
theme_minimal() +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centPlazo, color = t_centPlazo), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "#004E87", "Mediana" = "#4890D1", "Moda" = "#8AB6E9")) + theme(legend.title = element_blank())
ggPlazo + coord_cartesian(xlim = c(10, 61), ylim = c(0, 40))En resumen, las medidas de tendencia central para la variable “Plazo” revelan que, aunque la media es de alrededor de 44 meses, la mediana y la moda indican una preferencia por plazos de crédito más largos, especialmente con una duración común de 60 meses. Esta elección puede estar relacionada con el deseo de los clientes de mantener cuotas mensuales más bajas, lo que hace que los pagos mensuales sean más asequibles y menos gravosos. Esta preferencia por cuotas más bajas puede ser una estrategia para manejar la liquidez o una preferencia por mantener los pagos bajos, incluso si esto significa plazos más largos y, en última instancia, mayores costos por intereses. Estos hallazgos son esenciales para la planificación financiera y la gestión de riesgos en el sector crediticio.
User
Media (44.1 meses): La media representa el valor promedio de los plazos de crédito en la muestra. En este caso, la media es de 44.1 meses. Esto sugiere que, en promedio, los plazos de los créditos tienden a ser de aproximadamente 44 meses. Esta cifra refleja una duración moderada de los créditos en la muestra.
Mediana (48 meses): La mediana es el valor que se encuentra justo en el medio de la distribución de los datos, de modo que el 50% de los plazos de crédito son iguales o mayores que este valor. En este caso, la mediana es de 48 meses, lo que indica que la mitad de los plazos de crédito son de 48 meses o más. Esto refleja una tendencia hacia plazos más largos en la muestra.
Moda (60 meses): La moda es el valor que se repite con mayor frecuencia en la distribución. En este caso, la moda es de 60 meses, lo que significa que la duración más común para los plazos de crédito en la muestra es de 60 meses. Esta alta moda sugiere que muchos de los créditos tienen una duración de cinco años, lo que puede ser una elección popular en el sector crediticio.
explicalo solo un poco más corto ChatGPT Claro, aquí tienes una versión más concisa:
Media (44.1 meses): La media indica que, en promedio, los plazos de crédito son de aproximadamente 44 meses, lo que refleja una duración moderada.
Mediana (48 meses): La mediana señala que la mitad de los plazos de crédito son de 48 meses o más, sugiriendo una tendencia hacia plazos más largos en la muestra.
Moda (60 meses): La moda, que es de 60 meses, indica que muchos de los créditos tienen una duración de cinco años, lo que sugiere una elección popular entre los clientes y una preferencia por mantener pagos mensuales más bajos, aunque implique plazos más largos y mayores costos por intereses.
# DATOS DE DISPERSIÓN Plazo
# Medidas de dispersión
rangoPlazo <- range(muestra2$Plazo)
rangoPlazo1 <- paste("[", rangoPlazo[1], " - ", rangoPlazo[2], "]", sep = "")
varPlazo <- var(muestra2$Plazo)
desvestPlazo <- sd(muestra2$Plazo)
coefvarPlazo <- desvestPlazo/mean(muestra2$Plazo)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispPlazo <- data.frame(Rango = rangoPlazo1, Varianza = varPlazo, 'Desviación estándar' = desvestPlazo, 'Coeficiente de variación' = coefvarPlazo)
titulos3 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla4_tdispPlazo <- kable(t_dispPlazo, caption = "Medidas de dispersión: Plazo del crédito", format = "markdown", col.names = titulos3, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla4_tdispPlazo| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [12 - 60] | 253.36 | 15.92 | 0.36 |
Las medidas de dispersión para la variable “Plazo del Crédito” son las siguientes:
Rango (12 - 60 meses): El rango representa la diferencia entre el valor máximo y el valor mínimo de los plazos de crédito. En este caso, el rango abarca desde 12 hasta 60 meses, lo que indica una variabilidad en los plazos de crédito que va desde plazos relativamente cortos hasta los más largos posibles.
Varianza (253.36): La varianza mide la dispersión de los datos con respecto a la media. Una varianza de 253.36 indica que los plazos de crédito varían en un rango considerable alrededor de la media de 44.1 meses, lo que sugiere una cierta heterogeneidad en los plazos.
Desviación Estándar (15.92 meses): La desviación estándar es la raíz cuadrada de la varianza y proporciona una medida de dispersión que es más fácil de interpretar. Una desviación estándar de 15.92 meses indica cuánto se desvían, en promedio, los plazos de crédito con respecto a la media de 44.1 meses.
#GRFICO DE DISPERSIÓN
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Plazo)) +
geom_point(col = "#225188") +
theme_minimal() +
labs(title = "Gráfico de dispersión", subtitle = "Plazo del crédito", y = "Plazo ", x= "Cliente")En resumen, los plazos de crédito muestran una variabilidad significativa, con plazos que van desde 12 hasta 60 meses. Sin embargo, el coeficiente de variación relativamente bajo indica que esta variabilidad no es excesivamente alta en relación con la media, lo que sugiere una cierta estabilidad en los plazos de crédito en la muestra.
# MEDIDAS DE POSICIÓN
# Cálculo de cuartiles
Q1Plazo <- quantile(muestra2$Plazo,0.25,type = 6)
Q2Plazo <- quantile(muestra2$Plazo,0.50,type = 6)
Q3Plazo <- quantile(muestra2$Plazo,0.75,type = 6)
# Construcción de la tabla
t_cuantilPlazo <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Plazo, Q2Plazo, Q3Plazo)
)
print(t_cuantilPlazo)## Cuartil Valor
## 25% Q1 36
## 50% Q2 48
## 75% Q3 60
Cuartil 1: 25% de los plazos son de 36 meses o menos, lo que refleja plazos relativamente cortos.
Cuartil 2: 50% de los plazos son de 48 meses o más, indicando una tendencia hacia plazos más largos.
Cuartil 3: 75% de los plazos son de 60 meses o menos, con un cuarto de los créditos que tienen plazos más largos. Esto refleja preferencias variadas en la duración de los créditos.
# MEDIDAS DE POSICIÓN EN HISTOGRAMA Plazo
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilPlazo = c("Q1", "Q2", "Q3"),
value = c(Q1Plazo, Q2Plazo, Q3Plazo)
)
ggPlazo <- ggplot(muestra2, aes(x = Plazo)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 9), binwidth = 6) +
labs(
title = "Cuartiles: Plazo del crédito",
x = "Plazo (meses)",
y = "Frecuencia absoluta"
) +
theme_minimal() +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilPlazo, color = t_cuantilPlazo), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "#FE9549", "Q2" = "#F16916", "Q3" = "#AF3602")) + theme(legend.title = element_blank())
ggPlazo + coord_cartesian(xlim = c(10, 61), ylim = c(0, 45))En conjunto, estos cuartiles destacan que la mayoría de los plazos de crédito en la muestra se encuentran entre 36 y 60 meses, lo que refuerza la preferencia por plazos más largos que permiten cuotas mensuales más bajas, a pesar de prolongar el tiempo de pago y, en última instancia, incurrir en mayores costos por intereses. Esta información es relevante para comprender la distribución de los plazos y su impacto en la planificación financiera de los clientes y las instituciones crediticias.
# DIAGRAMA DE CAJA Plazo
boxplot(muestra2$Plazo, col = "white", ylab = "Plazo",
main = "Boxplot: Plazo del crédito")
stripchart(muestra2$Plazo,
method = "jitter",
pch = 19,
col = '#1C65A3',
vertical = TRUE,
add = TRUE)En el diagrama de caja, el primer cuartil (Q1) se encuentra en 36 meses, el segundo cuartil (Q2) o mediana está en 48 meses, y el tercer cuartil (Q3) coincide con 60 meses. Estos valores son especialmente relevantes ya que reflejan intervalos de tiempo naturales que los clientes suelen considerar al solicitar préstamos.
En cuanto a los datos atípicos, el diagrama de caja también nos permite identificar valores que se encuentran fuera de los “bigotes” del gráfico. Si existen valores atípicos, se representarán como puntos individuales fuera de los bigotes. En este contexto, los datos atípicos podrían indicar situaciones excepcionales en las que los plazos de crédito son significativamente más cortos o más largos que la norma en la muestra.
# Construcción gráfica
sumstati <- data.frame(MediaPlazo_curt = c("Media"), value = c(mediaPlazo))
ggplot(muestra2, aes(x = muestra2$Plazo)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill =
paletteer_c("ggthemes::Gray", 30)) +
geom_density(lwd = 1, linetype = 2, color = "#1F5591", fill = "#6EB6D9", alpha = 0.25) +
labs(title = "Histograma: Plazo", x = "Cantidad de Plazo", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaPlazo_curt), linewidth = 1) +
theme(legend.title = element_blank())curtPlazo <- ds_kurtosis(muestra2$Plazo)
print(paste("La curtosis de los datos de los Plazo es:", round(curtPlazo, 2)))## [1] "La curtosis de los datos de los Plazo es: -1.03"
El valor de curtosis de -1.03 indica que la distribución de los plazos de crédito es platicúrtica, es decir, tiene colas más ligeras y aplanadas en comparación con una distribución normal (que tiene una curtosis de 0). En otras palabras, esta distribución tiende a tener menos valores extremadamente alejados de la media en comparación con una distribución normal.
asimPlazo <- ds_skewness(muestra2$Plazo)
print(paste("La asimetría de los datos de los Plazo es:", round(asimPlazo, 2)))## [1] "La asimetría de los datos de los Plazo es: -0.51"
Un valor de asimetría de -0.51 indica una ligera asimetría negativa en la distribución de los plazos de crédito. En otras palabras, la cola izquierda de la distribución (los valores más bajos) es un poco más pesada que la cola derecha (los valores más altos).
Esto refiere a la cantidad de dinero que un cliente gana en un plazo de tiempo periodicamente.
library(descriptr)
library(kableExtra)
# Calcular media, mediana y moda
mediaIngresos <- mean(na.omit(muestra2$Ingresos))
medianaIngresos <- median(na.omit(muestra2$Ingresos))
modaIngresos <- ds_mode(na.omit(muestra2$Ingresos))
# Se construye la tabla de medidas de tendencia central para la variable "Ingresos":
t_centIngresos <- data.frame(Media = mediaIngresos, Mediana = medianaIngresos, Moda = modaIngresos)
tabla3_tcentIngresos <- kable(t_centIngresos, caption = "Medidas de tendencia central: Ingresos del cliente", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentIngresos| Media | Mediana | Moda |
|---|---|---|
| 148.207 | 125 | 160 |
A continuación, se realiza un análisis más detallado de las Ingresoses, explorando su distribución a través de gráficos. Estos gráficos proporcionan una visión visual de cómo se distribuyen las Ingresoses en el conjunto de datos y ayudarán a identificar valores atípicos:
library(dplyr)
sumstatz <- data.frame(
t_centIngresos = c("Media", "Mediana", "Moda"),
value = c(mediaIngresos, medianaIngresos, modaIngresos)
)
ggIngresos <- ggplot(muestra2, aes(x = muestra2$Ingresos)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 17), binwidth = 30) +
labs(
title = "Medidas de tendencia central: Ingresos del cliente",
x = "Ingresos del cliente",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centIngresos, color = t_centIngresos), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "slateblue1", "Mediana" = "slateblue4", "Moda" = "slateblue3")) +
theme(legend.title = element_blank())
ggIngresos# Medidas de dispersión
rangoIngresos <- range(na.omit(muestra2$Ingresos))
rangoIngresos1 <- paste("[", rangoIngresos[1], " - ", rangoIngresos[2], "]", sep = "")
varIngresos <- var(na.omit(muestra2$Ingresos))
desvestIngresos <- sd(na.omit(muestra2$Ingresos))
coefvarIngresos <- desvestIngresos/mean(na.omit(muestra2$Ingresos))
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispIngresos <- data.frame(Rango = rangoIngresos1, Varianza = varIngresos, 'Desviación estándar' = desvestIngresos, 'Coeficiente de variación' = coefvarIngresos)
titulos3 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla4_tdispIngresos <- kable(t_dispIngresos, caption = "Medidas de dispersión: Ingresos del cliente", format = "markdown", col.names = titulos3, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla4_tdispIngresos| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [19 - 500] | 7927.84 | 89.04 | 0.6 |
Al analizar las medidas de dispersión, encontramos que en un rango de $19 - $500, la desviación estandar es de 89.04, lo que indica una gran disperción de los datos, como tambieén el coeficiente de variación de 0.6 indica bastante disperción de los datos repecto a la media.
Por lo que podemos analizar que los clientes que solicitan el credito son de bastantes clases economicas.
En el siguiente gráfico podemos ver con mayor claridad la distribución que mencionamos:
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Ingresos)) +
geom_point(col = "slateblue") +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(size = 0.5, color = "black")) +
labs(title = "Gráfico de dispersión", subtitle = "Ingresos del cliente", y = "Ingresos ", x= "# Cliente")Con el gráfico anterior se puede observar de que a pesar de la desviación es grande se tiende a estar mayormente entre los valores de $50 y $400.
# Cálculo de cuartiles
Q1Ingresos <- quantile(na.omit(muestra2$Ingresos),0.25,type = 6)
Q2Ingresos <- quantile(na.omit(muestra2$Ingresos),0.50,type = 6)
Q3Ingresos <- quantile(na.omit(muestra2$Ingresos),0.75,type = 6)
# Construcción de la tabla
t_cuantilIngresos <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Ingresos, Q2Ingresos, Q3Ingresos)
)
print(t_cuantilIngresos)## Cuartil Valor
## 25% Q1 90.0
## 50% Q2 125.0
## 75% Q3 177.5
Los tres cuartiles son medidas de posición que dividen un conjunto de datos en partes iguales o proporcionan información sobre la distribución de los datos en relación con la mediana. En la siguiente gráfica podemos ver como los 3 cuartiles se encuentran en el lado izquierdo de la gráfica concordando con lo visto en el diagrama de disperción.
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilIngresos = c("Q1", "Q2", "Q3"),
value = c(Q1Ingresos, Q2Ingresos, Q3Ingresos)
)
ggIngresosQ <- ggplot(muestra2, aes(x = Ingresos)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 17), binwidth = 30) +
labs(
title = "Cuartiles: Ingresos del cliente",
x = "Ingresos del cliente",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilIngresos, color = t_cuantilIngresos), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "slateblue4", "Q2" = "slateblue2", "Q3" = "slateblue1")) + theme(legend.title = element_blank())
ggIngresosQEn el siguiente boxplot se puede observar otra caracteristica importante de estos datos: a pesar de que la mayoria de clientes tiene unos ingresos entre $300 y $19, existen bastantes clientes que salen de estas cantidades, como se observa al menos exiten 4 datos atipicos.
La curtosis es una medida estadística que se utilizará para describir la distribución del conjunto de datos. Observamos ahora en el siguiente gráfico que la densidad se encuentra concentrada al rededor de $100 de manera pronunciada.
# Paquetes usados
library(paletteer)
library(ggthemes)
# Construcción gráfica
sumstati <- data.frame(MediaIngresos_curt = c("Media"), value = c(mediaIngresos))
ggplot(muestra2, aes(x = muestra2$Ingresos)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = paletteer_c("ggthemes::Gray", 17), binwidth = 30) +
geom_density(lwd = 1, linetype = 2, color = "slateblue4", fill = "slateblue2", alpha = 0.25) +
labs(title = "Histograma y Densidad: Ingresos del cliente", x = "Ingresos", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaIngresos_curt), linewidth = 1,color = "firebrick2" ) +
scale_linetype_manual(values = c("Media"="dashed"))+
scale_x_continuous(labels = label_dollar())+
theme(legend.title = element_blank())library(moments)
curtIngresos <- ds_kurtosis(na.omit(muestra2$Ingresos))
cat(paste("La curtosis de los datos de la Ingresos es", round(curtIngresos, 2)))## La curtosis de los datos de la Ingresos es 5.09
El valor de la curtosis nos va a indicar que tantos datos estan centrados respecto a la media. tal como se menciono antes el valor de 5.09 indica un distribución leptocurtica, es decir que la gráfica va a ser punteaguda en comparación con una distribución normal gaussiana. De nuevo confirmamos que la mayoría de clientes tienen ingresos cercanos a los $160.
asimIngresos <- ds_skewness(na.omit(muestra2$Ingresos))
cat(paste("La asimetría de los datos de la Ingresos es", round(asimIngresos, 2)))## La asimetría de los datos de la Ingresos es 1.97
Por otro lado, la asimetría es una medida estadística que describe la inclinación o desviación de la distribución de datos con respecto a la distribución normal. Indica si la cola de la distribución se inclina hacia la izquierda (asimetría negativa) o hacia la derecha (asimetría positiva) en relación con la media. En este caso, se observa que para la variable Ingresos, la distribución presenta una simetría positiva.
Los activos son las cantidad de bienes representada en dinero que los clientes poseen y que generan beneficios.
# Calcular media, mediana y moda
mediaActivos <- mean(muestra2$Activos)
medianaActivos <- median(muestra2$Activos)
modaActivos <- ds_mode(muestra2$Activos)
# Se construye la tabla de medidas de tendencia central para la variable "Ingresos":
t_centActivos <- data.frame(Media = mediaActivos, Mediana = medianaActivos, Moda = modaActivos)
tabla1_tcentActivos <- kable(t_centActivos, caption = "Medidas de tendencia central: Cantidad de Activos", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_tcentActivos| Media | Mediana | Moda |
|---|---|---|
| 4265 | 3000 | 0 |
Se presenta a continuación un histograma con los datos de los activos y la posición de la medidas de tendencia central:
sumstatz <- data.frame(
t_centActivos = c("Media", "Mediana", "Moda"),
value = c(mediaActivos, medianaActivos, modaActivos)
)
ggActivos <- ggplot(muestra2, aes(x = Activos)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 21), binwidth = 1500) +
labs(
title = "Medidas de tendencia central: Cantidad de Activos",
x = "Activos",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centActivos, color = t_centActivos), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "gold", "Mediana" = "gold4", "Moda" = "gold3")) + theme(legend.title = element_blank())
ggActivos + scale_x_continuous(limits = NULL) + scale_y_continuous(limits = NULL)# Medidas de dispersión
rangoActivos <- range(muestra2$Activos)
rangoActivos1 <- paste("[", rangoActivos[1], " - ", rangoActivos[2], "]", sep = "")
varActivos <- var(muestra2$Activos)
desvestActivos <- sd(muestra2$Activos)
coefvarActivos <- desvestActivos/mean(muestra2$Activos)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispActivos <- data.frame(Rango = rangoActivos1, Varianza = varActivos, 'Desviación estándar' = desvestActivos, 'Coeficiente de variación' = coefvarActivos)
titulos2 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla2_tdispActivos <- kable(t_dispActivos, caption = "Medidas de dispersión: Activos", format = "markdown", col.names = titulos2, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla2_tdispActivos| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [0 - 30000] | 32083308 | 5664.21 | 1.33 |
Como se calculó, el rango de la muestra es muy grande desde $0 hasta $30000, indicando una gran variabilidad entre los clientes, por lo que se evidencia que tanto clientes con poca como clientes con bastante generación de ganacia solicitan un prestamo crediticio a la entidad. En este caso la desviación estandar de 5664.21 sugiere una muy grande separación de los datos analizados. Por otro lado la variación de los activos respecto a la media es del 133%, indiando una variación enorme, más grande incluso de la escala prevista para la media.
Veamos el gráfico de disperción
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Activos)) +
geom_point(col = "gold") +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(size = 0.5, color = "black")) +
labs(title = "Gráfico de dispersión", subtitle = "Activos", y = "Ingresos ", x= "# Cliente")Observando la disperción notamos como efetivamente existen altas cantidades de valores lejos de la media, concordando con los valores del desviación y el coeficiente de variación.
# Cálculo de cuartiles
Q1Activos <- quantile(muestra2$Activos,0.25,type = 6)
Q2Activos <- quantile(muestra2$Activos,0.50,type = 6)
Q3Activos <- quantile(muestra2$Activos,0.75,type = 6)
# Construcción de la tabla
t_cuantilActivos <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Activos, Q2Activos, Q3Activos)
)
print(t_cuantilActivos)## Cuartil Valor
## 25% Q1 0
## 50% Q2 3000
## 75% Q3 6000
En el siguiente histograma se visualiza de manera más visual las posiciones de los cuartiles.
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilActivos = c("Q1", "Q2", "Q3"),
value = c(Q1Activos, Q2Activos, Q3Activos)
)
ggActivosQ <- ggplot(muestra2, aes(x = Activos)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 21), binwidth = 1500) +
labs(
title = "Cuartiles: Activos",
x = "Cantidad de Activos",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilActivos, color = t_cuantilActivos), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "gold", "Q2" = "gold2", "Q3" = "gold3")) + theme(legend.title = element_blank())
ggActivosQ + scale_x_continuous(limits = NULL,labels = label_dollar()) + scale_y_continuous(limits = NULL)Para el siguiente boxplot observamos 5 datos atipicos, eston datos atipicos son los que se encuentran por encima de $15000 en activos, luego, se puede observar que la concentración de los valores se encuentran desde 0 hasta 6000. Se observa que existen varios clientes con activos con un valor alrededor de $3000 y que entre estos valor y no tener activos, hay una brecha en al cuál no se encuentran casí clientes, por lo que se inferir que los clientes al invertir, invierten en al menos $3000 en activos en adelante.
# Construcción gráfica
sumstat <- data.frame(MediaActivos_curt = c("Media"), value = c(mediaActivos))
ggplot(muestra2, aes(x = muestra2$Activos)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = paletteer_c("ggthemes::Gray", 26), binwidth = 1200) +
geom_density(lwd = 1, linetype = 2, color = "gold4", fill = "gold", alpha = 0.25) +
labs(title = "Histograma: Activos", x = "Cantidad de Activos", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstat, aes(xintercept = value, linetype = MediaActivos_curt), linewidth = 1) +
scale_linetype_manual(values = c("Media" = "dashed"))+
theme(legend.title = element_blank())curtActivos <- ds_kurtosis(muestra2$Activos)
cat(paste("La curtosis de los datos de los Activos es", round(curtActivos, 2)))## La curtosis de los datos de los Activos es 6.53
El valor obtenido nos indica una distribución leptocurtica, pues como se observa en el gráfico la concentración de los datos es bastate notable.
asimActivos <- ds_skewness(muestra2$Activos)
cat(paste("La asimetría para los datos de los Activos es", round(asimActivos, 2)))## La asimetría para los datos de los Activos es 2.32
Por otro lado, un valor de asimetría positiva, como 2.32, indica que la mayoría de los valores de este conjunto de datos están concentrados en el lado izquierdo de la distribución, cerca de la media, pero hay algunos valores muy altos en el lado derecho que hacen que la cola derecha sea más larga.
La cantidad es el monto de dinero que el cliente esta pidiendo para el prestamo
# Calcular media, mediana y moda
mediaCantidad <- mean(muestra2$Cantidad)
medianaCantidad <- median(muestra2$Cantidad)
modaCantidad <- ds_mode(muestra2$Cantidad)
# Se construye la tabla de medidas de tendencia central para la variable "Cantidad":
t_centCantidad <- data.frame(Media = mediaCantidad, Mediana = medianaCantidad, Moda = modaCantidad)
tabla1_tcentCantidad <- kable(t_centCantidad, caption = "Medidas de tendencia central: Cantidad de cantidad", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla1_tcentCantidad| Media | Mediana | Moda |
|---|---|---|
| 950.83 | 1000 | 1000 |
A continuación, se realiza un análisis más detallado de los Cantidad, explorando su distribución a través de gráficos:
sumstatz <- data.frame(
t_centCantidad = c("Media", "Mediana", "Moda"),
value = c(mediaCantidad, medianaCantidad, modaCantidad)
)
ggCantidad <- ggplot(muestra2, aes(x = Cantidad)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 24), binwidth = 80) +
labs(
title = "Medidas de tendencia central: Cantidad de cantidad",
x = "Cantidad",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centCantidad, color = t_centCantidad), size = 1) +
scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
scale_color_manual(values = c("Media" = "firebrick1", "Mediana" = "firebrick2", "Moda" = "firebrick4")) + theme(legend.title = element_blank())
ggCantidad + scale_x_continuous(limits = NULL, labels = label_dollar()) + scale_y_continuous(limits = NULL)# Medidas de dispersión
rangoCantidad <- range(muestra2$Cantidad)
rangoCantidad1 <- paste("[", rangoCantidad[1], " - ", rangoCantidad[2], "]", sep = "")
varCantidad <- var(muestra2$Cantidad)
desvestCantidad <- sd(muestra2$Cantidad)
coefvarCantidad <- desvestCantidad/mean(muestra2$Cantidad)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispCantidad <- data.frame(Rango = rangoCantidad1, Varianza = varCantidad, 'Desviación estándar' = desvestCantidad, 'Coeficiente de variación' = coefvarCantidad)
titulos4 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla5_tdispCantidad <- kable(t_dispCantidad, caption = "Medidas de dispersión: Cantidad", format = "markdown", col.names = titulos4, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla5_tdispCantidad| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [100 - 1900] | 164734 | 405.87 | 0.43 |
En este caso, el rango de la cantidad del prestamo ronda alrededor de $1800, variando entre $100 y $1900, por lo que se ve que no hay prestmos mayores a $2000 y que por lo tanto rango no alcanza a ser el doble que el valor de la media y las otras medidas de tendencia. La dispersión para esta variable es de alrededor de 405.87 y con una variación entorno a la media de 43%,por lo que nos indica una variación baja, bastante cercana a valores de una distribución normal, además, estos valores indican que: por un lado los datos no se encuentran tan alejados de la media y que en su mayoria la variación es cerca de la media. Esto se evidencia en la cercanía de la media, mediana y moda.
En el siguiente gráfico de dispersión se puede observar mucho mejor la dispersión de esta variable en la muestra:
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Cantidad)) +
geom_point(col = "firebrick1") +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(size = 0.5, color = "black")) +
scale_y_continuous(labels = label_dollar())+
labs(title = "Gráfico de dispersión", subtitle = "Cantidad", y = "Ingresos ", x= " # Cliente")# Cálculo de cuartiles
Q1Cantidad <- quantile(muestra2$Cantidad,0.25,type = 6)
Q2Cantidad <- quantile(muestra2$Cantidad,0.50,type = 6)
Q3Cantidad <- quantile(muestra2$Cantidad,0.75,type = 6)
# Construcción de la tabla
t_cuantilCantidad <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Cantidad, Q2Cantidad, Q3Cantidad)
)
print(t_cuantilCantidad)## Cuartil Valor
## 25% Q1 600.0
## 50% Q2 1000.0
## 75% Q3 1207.5
En el siguiente diagrama se ilustran las posiciones de los cuartiles, teniendo como referencia el histograma de los datos.
# Construcción gráfica
sumstatz <- data.frame(
t_cuantilCantidad = c("Q1", "Q2", "Q3"),
value = c(Q1Cantidad, Q2Cantidad, Q3Cantidad)
)
ggCantidadQ <- ggplot(muestra2, aes(x = Cantidad)) +
geom_histogram(color = "black", fill = paletteer_c("ggthemes::Gray", 19), binwidth = 100) +
labs(
title = "Cuartiles: Cantidad",
x = "Cantidad del gasto",
y = "Frecuencia"
) +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilCantidad, color = t_cuantilCantidad), size = 1) +
scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
scale_color_manual(values = c("Q1" = "firebrick2", "Q2" = "firebrick3", "Q3" = "firebrick4")) + theme(legend.title = element_blank())
ggCantidadQ + scale_x_continuous(limits = NULL, labels = label_dollar()) + scale_y_continuous(limits = NULL)En el siguiente boxplot se observa sólo 1 dato atípico, que corresponde a un solicitante que presenta Cantidad mayores a 110. Sin embargo, los datos tienen tendencia hacia valores bajos; aunque la mediana sea cercana a la media, esta se encuentra por debajo de ella.
# Construcción gráfica
sumstati <- data.frame(MediaCantidad_curt = c("Media"), value = c(mediaCantidad))
ggplot(muestra2, aes(x = muestra2$Cantidad)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = paletteer_c("ggthemes::Gray", 30)) +
geom_density(lwd = 1, linetype = 2, color = "firebrick3", fill = "firebrick1", alpha = 0.25) +
labs(title = "Histograma: Cantidad", x = "Cantidad del credito", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaCantidad_curt), linewidth = 1, color="springgreen4") +
scale_x_continuous(labels = label_dollar())+
scale_linetype_manual(values = c("Media"="dashed"))+
theme(legend.title = element_blank())curtCantidad <- ds_kurtosis(muestra2$Cantidad)
cat(paste("La curtosis de los datos de la Cantidad es:", round(curtCantidad, 2)))## La curtosis de los datos de la Cantidad es: -0.47
Un valor de curtosis negativa indica que nuestra distribución de los datos tiene un curtosis del tipo plasicurtica, por lo que la mayoria de los datos estan repartidos más uniformente que concentrados en un solo punto. Esto se pudo observar en la anterior gráfica de densidad en donde no se ven valores demasiado pronunciados. Además, aquí podemos como el comportamiento general al rededor de un punto es combinación de todos lo putnos cercanos, y así una diferencia entre el contorno del histograma y el de la gráfica de densidad.
asimCantidad <- skewness(muestra2$Cantidad)
cat("La asimetría de los datos de los Cantidad es:", round(asimCantidad, 2))## La asimetría de los datos de los Cantidad es: 0.23
El valor de 0.23 para la asimetría nos indica que los datos tienen una tendencia a estar a la dercha, como se vio con la moda la cual es mayor que la media, luego el valor al ser bajo nos sugiere que esa tendencia es baja y es cercana a al media. Concordad de nuevo con la cercania de la mediana y moda.
# Calcular la media, mediana y moda de la variable "Deuda"
media_deuda <- mean(muestra2$Deuda)
mediana_deuda <- median(muestra2$Deuda)
moda_deuda <- as.numeric(names(sort(table(muestra2$Deuda), decreasing = TRUE)[1]))
# Se construye la tabla de medidas de tendencia central para la variable "Edad":
t_centDeuda <- data.frame(Media = media_deuda, Mediana = mediana_deuda, Moda = moda_deuda)
tabla3_tcentDeuda <- kable(t_centDeuda, caption = "Medidas de tendencia central: Deuda del cliente", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentDeuda| Media | Mediana | Moda |
|---|---|---|
| 250.36 | 0 | 0 |
Para obtener una comprension completa de la distribucion de la deuda y su interpretacion, a continuacion realizamos un analisis mas detallado a partir de graficos para visualizar la distribucion de los valores.
sumstatz <- data.frame(Tendencia_Central = c("Media", "Mediana", "Moda"),
value = c(mean(muestra2$Deuda), median(muestra2$Deuda), moda_deuda))
ggplot(muestra2, aes(x = Deuda)) +
geom_histogram(color = "black", fill = "white", binwidth = 1000) +
labs(title = "Medidas de Tendencia Central en la Deuda",
x = "Deuda",
y = "Frecuencia") +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = Tendencia_Central, col = Tendencia_Central), linewidth = 1)rangoEdad <- range(muestra2$Edad)
rangoEdad1 <- paste("[", rangoEdad[1], " - ", rangoEdad[2], "]", sep = "")
varEdad <- var(muestra2$Edad)
desvestEdad <- sd(muestra2$Edad)
coefvarEdad <- desvestEdad/mean(muestra2$Edad)
# Se construye una tabla para mostrar las medidas de dispersión:
rangoDeuda <- range(muestra2$Deuda)
rangoDeuda1 <- paste("[", rangoDeuda[1], " - ", rangoDeuda[2], "]", sep = "")
varDeuda <- var(muestra2$Deuda)
desvestDeuda <- sd(muestra2$Deuda)
coefvarDeuda <- desvestDeuda/mean(muestra2$Deuda)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispDeuda <- data.frame(Rango = rangoDeuda1, Varianza = varDeuda, 'Desviación estándar' = desvestDeuda, 'Coeficiente de variación' = coefvarDeuda)
titulos31 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla41_tdispDeuda <- kable(t_dispDeuda, caption = "Medidas de dispersión: Deuda del cliente", format = "markdown", col.names = titulos31, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla41_tdispDeuda| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [0 - 9000] | 1051056 | 1025.21 | 4.09 |
-El rango muestra que las deudas de los clientes varían desde 0 hasta 9000 unidades, lo que indica una amplia gama de valores. -La varianza y la desviación estándar indican que hay una dispersión considerable en las deudas de los clientes en relación con la media. -El coeficiente de variación es relativamente bajo (4.09%), lo que sugiere que la variabilidad de las deudas es moderada en relación con la media.
ggplot(muestra2, aes(x = as.numeric(rownames(muestra2)), y = Deuda)) +
geom_point(col = "#8A2BE2") +
theme_minimal() +
labs(title = "Gráfico de dispersión", subtitle = "Deuda del cliente", y = "Deuda ", x= "Cliente")A partir del grafico de dispersión podemos observar que como mencionamos anteriormente, una gran parte de los clientes efectivamente no poseen deudas. Razon por la cual la mediana y la moda son 0.
# Cálculo de cuartiles
Q1Deuda <- quantile(muestra2$Deuda,0.25,type = 6)
Q2Deuda <- quantile(muestra2$Deuda,0.50,type = 6)
Q3Deuda <- quantile(muestra2$Deuda,0.75,type = 6)
# Construcción de la tabla
t_cuantilDeuda <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Deuda, Q2Deuda, Q3Deuda)
)
print(t_cuantilDeuda)## Cuartil Valor
## 25% Q1 0
## 50% Q2 0
## 75% Q3 0
A partir de la grafica anterior concluimos que por lo menos el 75% de los clientes tienen una deuda de 0, o lo que es lo mismo no tienen deuda
ggDeudaQ <- ggplot(muestra2, aes(x = Deuda)) +
geom_histogram(color = "black", fill = "white", binwidth = 800) +
labs(
title = "Cuartiles: Deuda",
x = "Cantidad de Deuda",
y = "Frecuencia"
) +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")
) +
geom_vline(xintercept = quantile(muestra2$Deuda, c(0.25, 0.5, 0.75)), linetype = c("solid", "dashed", "dotted"), color = c("#FFB90F", "cornsilk3", "darkseagreen"), size = 1) +
scale_x_continuous(limits = NULL) +
scale_y_continuous(limits = NULL)
print(ggDeudaQ)#### Histograma Deuda
# Construcción gráfica
sumstati <- data.frame(MediaDeuda_curt = c("Media"), value = c(media_deuda))
ggplot(muestra2, aes(x = muestra2$Deuda)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "gray89") +
geom_density(lwd = 1, linetype = 2, color = "darkslategray", fill = "darkolivegreen", alpha = 0.4) +
labs(title = "Histograma: Precio del crédito", x = "Deuda", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaDeuda_curt), linewidth = 1) +
scale_x_continuous(labels = label_dollar())+
theme(legend.title = element_blank())curtDeuda <- ds_kurtosis(muestra2$Deuda)
print(paste("La curtosis de los datos de la Deuda es:", round(curtDeuda, 2)))## [1] "La curtosis de los datos de la Deuda es: 54.84"
Con una curtosis de 54.84, decimos que hay fuerte presencia de valores extremos en la distribución de la Deuda. Esto nos dice que la distribución es leptocúrtica, lo que significa que hay una mayor concentración de datos cerca de la media y valores extremos en las colas de la distribución.
# Calcular la media, mediana y moda de la variable "Precio"
media_precio <- mean(muestra2$Precio)
mediana_precio <- median(muestra2$Precio)
moda_precio <- as.numeric(names(sort(table(muestra2$Precio), decreasing = TRUE)[1]))
## Se construye la tabla de medidas de tendencia central para la variable "Edad":
t_centPrecio <- data.frame(Media = media_precio, Mediana = mediana_precio, Moda = moda_precio)
tabla3_tcentPrecio <- kable(t_centPrecio, caption = "Medidas de tendencia central: Precio del prestamo", format = "markdown", align = 'cccccc', digits = 3) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE)
tabla3_tcentPrecio| Media | Mediana | Moda |
|---|---|---|
| 1370.35 | 1355.5 | 1500 |
-La media nos muestra el promedio general del precio de los préstamos, que en este caso fue de 1370.35. -La mediana nos muestra el valor central de los precios, lo que sugiere que la distribución de precios podría ser relativamente simétrica. -La moda nos indica que 1500 es el precio más común entre los préstamos.
sumstatz <- data.frame(Tendencia_Central = c("Media", "Mediana", "Moda"),
value = c(mean(muestra2$Precio), median(muestra2$Precio), moda_precio))
ggplot(muestra2, aes(x = Precio)) +
geom_histogram(color = "black", fill = "white", binwidth = 100) +
labs(title = "Medidas de Tendencia Central en el Precio",
x = "Precio",
y = "Frecuencia") +
geom_vline(data = sumstatz, aes(xintercept = value, linetype = Tendencia_Central, col = Tendencia_Central), linewidth = 1)#Medidas de dispersion
rangoPrecio <- range(muestra2$Precio)
rangoPrecio1 <- paste("[", rangoPrecio[1], " - ", rangoPrecio[2], "]", sep = "")
varPrecio <- var(muestra2$Precio)
desvestPrecio <- sd(muestra2$Precio)
coefvarPrecio <- desvestPrecio/mean(muestra2$Precio)
# Se construye una tabla para mostrar las medidas de dispersión:
t_dispPrecio <- data.frame(Rango = rangoPrecio1, Varianza = varPrecio, 'Desviación estándar' = desvestPrecio, 'Coeficiente de variación' = coefvarPrecio)
titulos311 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")
tabla411_tdispPrecio <- kable(t_dispPrecio, caption = "Medidas de dispersión: Precio del prestamo", format = "markdown", col.names = titulos311, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) %>%
column_spec(1, width = "10cm")
tabla411_tdispPrecio| Rango | Varianza | Desviación estándar | Coeficiente de variación |
|---|---|---|---|
| [125 - 3313] | 237349.9 | 487.19 | 0.36 |
Observamos que los precios de los prestamos van desde 125 hasta 3313 , lo que indica una amplia gama de valores. Tambien podemos decir que hay una dispersión considerable en los precios de los préstamos en relación con la media.El coeficiente de variación es relativamente bajo (0.36%), lo que sugiere que la variabilidad de los precios es baja en relación con la media.
# Cálculo de cuartiles
Q1Precio <- quantile(muestra2$Precio,0.25,type = 6)
Q2Precio <- quantile(muestra2$Precio,0.50,type = 6)
Q3Precio <- quantile(muestra2$Precio,0.75,type = 6)
# Construcción de la tabla
t_cuantilPrecio <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
Valor = c(Q1Precio, Q2Precio, Q3Precio)
)
print(t_cuantilPrecio)## Cuartil Valor
## 25% Q1 1100.25
## 50% Q2 1355.50
## 75% Q3 1603.75
Lo anterior se puede observar mucho mejor en el siguiente diagrama:
# Construcción gráfica
ggPrecioQ <- ggplot(muestra2, aes(x = Precio)) +
geom_histogram(color = "black", fill = "white", binwidth = 100) +
labs(
title = "Cuartiles: Precio",
x = "Cantidad del Precio",
y = "Frecuencia"
) +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")
) +
geom_vline(xintercept = quantile(muestra2$Precio, c(0.25, 0.5, 0.75)), linetype = c("solid", "dashed", "dotted"), color = c("purple", "purple4", "purple2"), size = 1) +
scale_x_continuous(limits = NULL) +
scale_y_continuous(limits = NULL)
print(ggPrecioQ)En el siguiente diagrama boc plot observamos algunos datos atípicos, que corresponen a los precios de credito de algunas personas que son muy menores a los del promedio, o que por el contrario son muy altos.
# Crear el boxplot
boxplot(
muestra2$Precio,
col = "white", ylab = "Precio",
main = "Boxplot: Precio del Préstamo", # Color del borde del boxplot
outline = TRUE, # Evitar outliers marcados como puntos
horizontal = TRUE # Cambiar la orientación del boxplot
)
stripchart(
muestra2$Precio, method = "jitter", pch = 19,
col = 'purple3', vertical = FALSE,add = TRUE
)
text(
x = max(muestra2$Precio) + 100, y = 1,labels = c("Precio"),
pos = 4
)# Crear un histograma de la variable "Precio"
sumstati <- data.frame(MediaPrecio_curt = c("Media"), value = c(media_precio))
ggplot(muestra2, aes(x = muestra2$Precio)) +
geom_histogram(aes(y = after_stat(density)), color = "black", fill = "gray89") +
geom_density(lwd = 1, linetype = 2, color = "purple4", fill = "purple1", alpha = 0.25) +
labs(title = "Histograma: Precio del credito", x = "Precio", y = 'Frecuencia') +
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black")) +
geom_vline(data = sumstati, aes(xintercept = value, linetype = MediaPrecio_curt), linewidth = 1) +
theme(legend.title = element_blank())# Calcular medidas de curtosis
curtPrecio <- ds_kurtosis(muestra2$Precio)
print(paste("La curtosis del Precio es:", round(curtPrecio, 2)))## [1] "La curtosis del Precio es: 2.18"
La curtosis en este caso es positiva(2.18), índica que la distribución tiene colas más pesadas y una concentración de valores más cerca de la media en comparación con una distribución normal. Esto sugiere que la distribución de los precios podría ser un poco más puntiaguda o con valores extremos más pronunciados.
# Trabajo vs. Ingreso
ggplot(data = muestra2, aes(x = Trabajo, y = Ingresos)) +
geom_bar(stat = "summary", fun = "mean", fill = "#FF69B4") +
labs(title = "Ingreso por tipo de trabajo", x = "Tipo de Trabajo", y = "Ingreso Promedio") +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black"))Con el anterior histograma, se puede estimar que las personas que tienen un trabajo freelance y un trabajo fijo son las que tienen mayores ingresos que el resto de la muestra estudiada.
ggplot(data = muestra2, aes(x = Estado, y = Precio)) +
geom_boxplot(fill = "#FFC0CB") +
labs(title = "Distribución del precio del crédito por calificación crediticia",
x = "Calificación Crediticia", y = "Precio del Crédito") +
theme_minimal() +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black"))# Crear un data frame con tus datos
df <- data.frame(Cantidad = muestra2$Cantidad, Plazo = muestra2$Plazo)
library(ggplot2)
library(ggExtra)
# Guarda el gráfico de dispersión en una variable
p <- ggplot(df, aes(x = Cantidad, y = Plazo)) +
geom_point()
# Densigrama
ggMarginal(p, type = "densigram")El análisis de dispersión realizado revela una relación significativa entre la cantidad del préstamo otorgado y el plazo del crédito. La mayoría de los puntos en el gráfico se agrupan alrededor de la diagonal de proporcionalidad. Esto sugiere que, en general, a medida que los clientes solicitan montos más elevados, también tienden a elegir plazos más largos para reembolsar el préstamo.
Un hallazgo destacado es la presencia frecuente del dato de 60 meses de plazo a lo largo de todo el eje de la cantidad del préstamo. Esto indica que, independientemente de la cantidad solicitada, el plazo de 60 meses es una opción muy popular entre los clientes. Esta preferencia constante podría estar relacionada con la comodidad que ofrece este plazo en términos de cuotas mensuales asequibles.
En resumen, este análisis de dispersión subraya la correlación positiva entre la cantidad del préstamo y el plazo del crédito, así como la preeminencia del plazo de 60 meses como una opción ampliamente elegida por los clientes, independientemente del monto del préstamo.
# Crear un data frame con tus datos
df <- data.frame(Activos = muestra2$Activos, Precio = muestra2$Precio)
# Guarda el gráfico de dispersión en una variable
p <- ggplot(df, aes(x = Activos, y = Precio)) +
geom_point()
# Densigrama
ggMarginal(p, type = "densigram")La mayoría de los datos se concentran en el rango de 0 a 10,000 en la variable “Activos”. La mayoría de personas tienen valores de “Activos” en ese rango. De manera similar, la mayoría de los datos se concentran en el rango de 15,000 a 2,000 en la variable “Precio”. Esto indica igualmente que las personas tienen precios del credito en ese rango.
# Crear un data frame con tus datos
df <- data.frame(Gastos = muestra2$Gastos, Deuda = muestra2$Deuda)
# Guarda el gráfico de dispersión en una variable
p <- ggplot(df, aes(x = Gastos, y = Deuda)) +
geom_point()
# Densigrama
ggMarginal(p, type = "densigram")Este gráfico nos proporciona una visión clara de la falta de variación en las deudas, así como una concentración de gastos en un rango específico. Esto nos indica que, en este conjunto de datos particular, la relación entre la deuda de los individuos y los precios no es pronunciada y que otros factores pueden estar influyendo en los precios o en la deuda de manera más significativa
A continuación se presenta una gráfica de densidad para las varialbes ingresos y cantidad de prestamo.
# Gráfico de Ingresos vs Cantidad
ggplot(muestra2, aes(x = Ingresos, y = Cantidad)) +
geom_density_2d_filled(bins=30)+
labs(title = "Densidad: Ingresos contra Cantidad", x = "Ingresos", y = "Cantidad del prestamo")+
theme_minimal() + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.line = element_line(size = 0.5, color = "black"))+
scale_y_continuous(labels = label_dollar())+
scale_x_continuous(labels = label_dollar())+
guides(fill = guide_colourbar(title = "#",barwidth = 0.7,
barheight = 10))Se observa en la gráfica la cantidad de clientes por cantidad de prestamo y por ingresos, así entre más claro sea el colar más cantidad de clientes comparten ingresos y cantidad del prestamo solicitado. Se pueden observar a grandes rasgos una gran población centrada en el area que comprende a los clientes que tienen al rededor de $100 de ingresos, y un prestamo de $1000, luego existe población más pequeña en el area de los clientes que ganan al rededor de $250 y pidieron u prestamo de $500. Esto indica que estos clientes son los que más recurren a solicitar prestamos, con la entidad bancaria.