Análisis integral avanzado

En este proyecto se pretende dar información a un negocio dedicado a la compra-venta de clientes alimentarios y que inició su andadura comercial en Abril de 2020; los últimos datos a analizar son del 05/06/2022.

1 ANALISIS DESCRIPTIVO

Se realizarán tareas de ETL, creación de nuevas variables de negocio y visualización de insights.

Vamos a realizar el proceso de ETL directamente en la BBDD de SQL Server.

1.1 Conexión a BBDD

Carga de librerias necesarias

library(tidyverse) 
library(kableExtra)
library(DBI) 
library(odbc) 
library(DT) 
library(skimr) 
library(sqldf) 
library(corrplot) 
library(dlookr) 
library(flextable) 
library(DescTools) 
library(pROC) 
library(ggforce) 
library(gt) 
library(echarts4r) 
library(car) 
library(ggdist)
library(lmtest)

Conexión a la BBDD

connect_to_db <- function(driver, server, database) {
  connection_string <- paste0("Driver={", driver, "};Server=", server,
                              ";Database=", database, ";Trusted_Connection=yes;
                              ")
  dbConnect(odbc::odbc(), .connection_string = connection_string)
}


con <- connect_to_db("ODBC Driver 17 for SQL Server", "LAPTOP-P7645H6F", 
                      "BD_SQL")

1.2 Diagnóstico y tratamiento de las tablas de la BBDD

Obtención y visualización de las tablas de la BBDD

Visualización de la informacion de las tablas de la BBDD para obtener las tablas que necesitamos

Después de visualizar las tablas, seleccionamos aquellas que van a ser objeto de análisis y comenzamos a realizar las transformaciones oportunas; para ello usaremos:

• Transformaciones iniciales usando el conector odbc para realizar manipulaciones de tablas directamente desde el servidor.

• Otras transformaciones con las librerias dplyr y sqldf.

Antes de realizar cualquier transformación, realizamos una exploración inicial para observar cualquier incidencia en los datos de cada tabla, como serían posibles valores nulos y valores atípicos:

1- Seleccionamos y almacenamos en variables aquellas tablas que serán objeto de transformaciones posteriores

empleados <- dbGetQuery(con, "SELECT * FROM RRHH.empleados" )
proveedores <- dbGetQuery(con, "SELECT * FROM Produccion.Proveedores")
categorias <- dbGetQuery(con, "SELECT * FROM Produccion.Categorias")
productos <- dbGetQuery(con, "SELECT * FROM Produccion.Productos")
clientes <- dbGetQuery(con, "SELECT * FROM Ventas.Clientes")
transportistas <- dbGetQuery(con, "SELECT * FROM Ventas.Transportistas")
pedidos <- dbGetQuery(con, "SELECT * FROM Ventas.Ordenes")
detalle_pdos <- dbGetQuery(con, "SELECT * FROM Ventas.DetalleOrden")

2- Comenzamos la fase exploratoria inicial con cada tabla, para ello haremos los mismos pasos con cada tabla, con el objetivo de ver posibles incidencias en las variables, tanto categóricas como numéricas:

TABLA ‘empleados’

• Diagnóstico variables categóricas

skim_summary <- skim(empleados)

# Filtramos las variables no numéricas

non_numeric_vars <- skim_summary %>%
  filter(skim_type != "numeric") %>%
  pull(skim_variable)

# Creamos un resumen para cada variable no numérica

resumen_no_numericas <- lapply(non_numeric_vars, function(var) {
  empleado_var <- empleados[[var]]
  skim(data.frame(empleado_var))
})

# Nombramos los resúmenes por variable

names(resumen_no_numericas) <- non_numeric_vars

# Creamos un dataframe solo con las variables no numéricas

empleados_non_numeric <- empleados[ , non_numeric_vars, drop = FALSE]

# Obtenemos el resumen para estas variables

skim_non_numeric_summary <- skim(empleados_non_numeric)

# Impresión de variables

skim_non_numeric_summary

Data summary

Name	empleados_non_numeric
Number of rows	9
Number of columns	12
_______________________
Column type frequency:
character	10
Date	2
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
apellido	0	1.00	4	9	0	9	0
nombre	0	1.00	3	8	0	8	0
titulo	0	1.00	17	24	0	4	0
titulocortesia	0	1.00	3	4	0	3	0
direccion	0	1.00	17	35	0	9	0
ciudad	0	1.00	6	8	0	5	0
region	4	0.56	2	2	0	1	0
codigopostal	0	1.00	5	5	0	9	0
pais	0	1.00	3	11	0	2	0
telefono	0	1.00	13	14	0	9	0

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
fecha_nac	0	1	1957-09-19	1986-01-27	1978-01-09	9
fecha_contrato	0	1	2020-04-01	2022-11-15	2021-10-17	8

Diagnóstico variables numéricas

# Selección de variables con la librería DlookR

# Obtenemos el análisis numérico

diagnostico <- diagnose_numeric(empleados)

# Añadimos y renombramos columnas

diagnostico_ordenado <- diagnostico %>%
  dplyr::select(variables, mean, min, Q1, median, Q3, max, zero, minus, outlier) %>%
  mutate(
    mediana_vs_media = abs(median - mean),
    pct_dif = abs(median - mean) / median * 100,
    media = mean,
    mediana = median,
    ceros = zero,
    negativos = minus,
    atipicos = outlier
  )

# Selección de columnas

diagnostico_ordenado <- diagnostico_ordenado %>% 
  dplyr::select(variables, media, min, Q1, mediana, Q3, max, ceros, negativos, atipicos, mediana_vs_media, pct_dif)

# Obtenemos el análisis de valores atípicos

diagnostico_outliers <- diagnose_outlier(empleados)

# Renombramos las columnas

diagnostico_outliers <- diagnostico_outliers %>% 
  mutate(
    num_atipicos = outliers_cnt,
    ratio_atipicos = outliers_ratio,
    media_con_atip = with_mean,
    media_sin_atip = without_mean
  )

# Seleccionamos columnas

diagnostico_outliers <- diagnostico_outliers %>% 
  dplyr::select(variables, num_atipicos, ratio_atipicos, media_con_atip, media_sin_atip)

# Unimos ambas tablas basadas en la columna `variables`

tabla_num_dlookr <- left_join(diagnostico_ordenado, diagnostico_outliers, by = "variables")

###################################


# Selección de variables con la librería Skimr

# Obtenemos el resumen completo

resumen_completo <- skim(empleados)

# Filtramos para obtener solo las variables de tipo numerico

resumen_numeric <- resumen_completo %>%
  filter(skim_type == "numeric")

# Selección de variables numericas y modificaciones

tabla_num_skim <- resumen_numeric %>% 
  dplyr::select(skim_variable, n_missing, numeric.hist) %>% 
  mutate(variables = skim_variable,
         nulos = n_missing
         )
# Selección final

tabla_num_skim <- tabla_num_skim %>% 
  dplyr::select(variables, nulos, numeric.hist)

# Union de tablas; de la libreria dlookr con la de la libreria skimr

tabla_final_num <- tabla_num_dlookr %>% 
  left_join(tabla_num_skim, by= "variables" )

# Reordenación de tabla final

tabla_final_num <- tabla_final_num %>% 
  dplyr::select(variables, numeric.hist, nulos, atipicos, ceros, negativos, media, min, Q1, mediana, Q3, max, mediana_vs_media, pct_dif, num_atipicos, ratio_atipicos, media_con_atip, media_sin_atip)

# VISUALIZACION FINAL VARIABLES NUMERICAS

# Ver en formato tabla

tabla_final_num %>%  flextable() 

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_empleado	▇▇▃▇▇	0	0	0	0	5.00	1	3	5	7	9	0.00	0.000000	0	0	5.00	5.00
id_jefe	▂▅▅▁▇	1	0	0	0	3.25	1	2	3	5	5	0.25	8.333333	0	0	3.25	3.25

Repetimos el proceso con el resto de las tablas, con el fin de visualizar los datos clave para la limpieza y transformación de las variables de interés.

TABLA ‘proveedores’

Variables categóricas

Data summary

Name	proveedores_non_numeric
Number of rows	29
Number of columns	10
_______________________
Column type frequency:
character	10
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nombreproveedor	0	1.00	15	15	0	29	0
nombrecontacto	0	1.00	11	24	0	29	0
titulocontacto	0	1.00	5	35	0	15	0
direccion	0	1.00	13	58	0	29	0
ciudad	0	1.00	4	13	0	29	0
region	20	0.31	2	8	0	8	0
codigopostal	0	1.00	5	5	0	29	0
pais	0	1.00	3	12	0	16	0
telefono	0	1.00	8	15	0	29	0
fax	16	0.45	8	15	0	13	0

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_proveedor	▇▇▇▇▇	0	0	0	0	15	1	8	15	22	29	0	0	0	0	15	15

TABLA ‘categorias’

Variables categóricas

Data summary

Name	categorias_non_numeric
Number of rows	8
Number of columns	2
_______________________
Column type frequency:
character	2
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nombrecategoria	0	1	6	17	0	8	0
descripcion	0	1	6	56	0	8	0

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_categoria	▇▃▇▃▇	0	0	0	0	4.5	1	2.75	4.5	6.25	8	0	0	0	0	4.5	4.5

TABLA ‘productos’

Variables categóricas

Data summary

Name	productos_non_numeric
Number of rows	77
Number of columns	2
_______________________
Column type frequency:
character	1
logical	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nombreproducto	0	1	14	14	0	77	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
descontinuado	0	1	0.1	FAL: 69, TRU: 8

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_producto	▇▇▇▇▇	0	0	0	0	39.000000	1.0	20.00	39.0	58.00	77.0	0.0000000	0.000000	0	0.000000	39.000000	39.000000
id_proveedor	▇▇▅▆▅	0	0	0	0	13.649351	1.0	7.00	13.0	20.00	29.0	0.6493506	4.995005	0	0.000000	13.649351	13.649351
id_categoria	▇▅▆▂▆	0	0	0	0	4.116883	1.0	2.00	4.0	6.00	8.0	0.1168831	2.922078	0	0.000000	4.116883	4.116883
preciounitario	▇▁▁▁▁	0	4	0	0	28.866364	2.5	13.25	19.5	33.25	263.5	9.3663636	48.032634	4	5.194805	28.866364	22.704384

TABLA ‘clientes’

Data summary

Name	clientes_non_numeric
Number of rows	91
Number of columns	10
_______________________
Column type frequency:
character	10
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nombrecliente	0	1.00	13	13	0	91	0
nombrecontacto	0	1.00	7	25	0	90	0
titulocontacto	0	1.00	5	29	0	12	0
direccion	0	1.00	12	48	0	91	0
ciudad	0	1.00	4	15	0	68	0
region	59	0.35	2	13	0	18	0
codigopostal	0	1.00	5	5	0	90	0
pais	0	1.00	3	11	0	21	0
telefono	0	1.00	8	17	0	91	0
fax	22	0.76	9	17	0	69	0

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_cliente	▇▇▇▇▇	0	0	0	0	46	1	23.5	46	68.5	91	0	0	0	0	46	46

TABLA ‘transportistas’

Data summary

Name	transportistas_non_numeri…
Number of rows	3
Number of columns	2
_______________________
Column type frequency:
character	2
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
compañia	0	1	19	19	0	3	0
telefono	0	1	14	14	0	3	0

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_transportista	▇▁▇▁▇	0	0	0	0	2	1	1.5	2	2.5	3	0	0	0	0	2	2

TABLA ‘pedidos’

Data summary

Name	pedidos_non_numeric
Number of rows	830
Number of columns	9
_______________________
Column type frequency:
character	6
Date	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nombretransporte	0	1.00	11	17	0	241	0
direcciontransporte	0	1.00	12	48	0	241	0
ciudadtransporte	0	1.00	4	15	0	70	0
regiontransporte	507	0.39	2	13	0	19	0
codpostaltransporte	0	1.00	5	5	0	241	0
paistransporte	0	1.00	3	11	0	21	0

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
fecha_orden	0	1.00	2020-07-04	2022-05-06	2021-09-09	480
fecha_requerida	0	1.00	2020-07-24	2022-06-11	2021-10-07	454
fecha_transporte	21	0.97	2020-07-10	2022-05-06	2021-09-09	387

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_orden	▇▇▇▇▇	0	0	0	0	10,662.500000	10,248.00	10,455.25	10,662.50	10,869.75	11,077.00	0.000000000	0.0000000	0	0.000000	10,662.500000	10,662.500000
id_cliente	▆▇▆▇▆	0	0	0	0	46.413253	1.00	24.00	46.00	68.00	91.00	0.413253012	0.8983761	0	0.000000	46.413253	46.413253
id_empleado	▆▇▁▃▅	0	0	0	0	4.403614	1.00	2.00	4.00	7.00	9.00	0.403614458	10.0903614	0	0.000000	4.403614	4.403614
id_transportista	▆▁▇▁▆	0	0	0	0	2.007229	1.00	1.00	2.00	3.00	3.00	0.007228916	0.3614458	0	0.000000	2.007229	2.007229
flete	▇▁▁▁▁	0	66	0	0	78.244205	0.02	13.38	41.36	91.43	1,007.64	36.884204819	89.1784449	66	7.951807	78.244205	51.397736

TABLA ‘detalle_pdos’

Variables categóricas, no hay

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_orden	▇▇▇▇▇	0	0	0	0	10,659.37587007	10,248	10,451	10,657.0	10,862.5	11,077.00	2.37587007	0.02229399	0	0.000000	10,659.37587007	10,659.37587007
id_producto	▆▇▇▇▇	0	0	0	0	40.79303944	1	22	41.0	60.0	77.00	0.20696056	0.50478185	0	0.000000	40.79303944	40.79303944
preciounitario	▇▁▁▁▁	0	98	0	0	26.21851972	2	12	18.4	32.0	263.50	7.81851972	42.49195501	98	4.547564	26.21851972	21.33788527
cantidad	▇▃▁▁▁	0	87	0	0	23.81299304	1	10	20.0	30.0	130.00	3.81299304	19.06496520	87	4.037123	23.81299304	21.29013540
descuento	▇▁▁▁▁	0	0	1,317	0	0.05616705	0	0	0.0	0.1	0.25	0.05616705	Inf	0	0.000000	0.05616705	0.05616705

Una vez revisadas las variables de las tablas, se concluye que:

• con respecto a las variables categóricas no se van a realizar ninguna labor de limpieza de datos.

• con respecto a las variables numéricas, se realizarán transformaciones para suavizar el efecto de los valores atípicos de las variables preciounitario de la tabla ‘productos’, flete de la tabla ‘pedidos’ y preciounitario y cantidad de la tabla ‘detalle_pdos’

Visualizamos cuales transformaciones son las más adecuadas para las variables númericas detalladas

productos %>% 
  plot_normality(preciounitario)

Realizamos las transformaciones

sh_log_preciounit <- shapiro.test(log(productos$preciounitario)) 
sh_sqrt_preciounit <- shapiro.test(sqrt(productos$preciounitario))

Resultados

resultados <- data.frame(
  Transformación = c("Logarítmica", "Raíz cuadrada"),
  Estadístico = c(sh_log_preciounit$statistic, sh_sqrt_preciounit$statistic),
  `Valor p` = c(sh_log_preciounit$p.value, sh_sqrt_preciounit$p.value)
)

kable(resultados, digits = 4, caption = "Resultados de las Pruebas de Normalidad de Shapiro-Wilk")

Resultados de las Pruebas de Normalidad de Shapiro-Wilk

Transformación	Estadístico	Valor.p
Logarítmica	0.9808	0.2948
Raíz cuadrada	0.8155	0.0000

Realizamos la misma operación para todas las variables que queremos transformar

Resultados de las Pruebas de Normalidad de Shapiro-Wilk

Transformación	Estadístico	Valor.p
Logarítmica	0.9655	0
Raíz cuadrada	0.9018	0

Resultados de las Pruebas de Normalidad de Shapiro-Wilk

Transformación	Estadístico	Valor.p
Logarítmica	0.9855	0
Raíz cuadrada	0.8378	0

Resultados de las Pruebas de Normalidad de Shapiro-Wilk

Transformación	Estadístico	Valor.p
Logarítmica	0.9721	0
Raíz cuadrada	0.9739	0

CONCLUSIONES PARA LAS TRANSFORMACIONES:

• De la tabla ‘clientes’-> variable preciounitario -> transformación logarítmica., la cual es la única de todas las transformaciones en la que existe normalidad.

• De la tabla ‘pedidos’->variable flete -> transformación logarítmica, al tener un valor estadístico más alto.

• De la tabla ‘detalle_pdos’-> la variable preciounitario -> transformación logarítmica, al tener un valor estadístico más alto.

• De la tabla ‘detalle_pdos’-> la variable cantidad -> transformación de raíz cuadrada, al tener un valor estadístico más alto.

1.3 Creación de las tablas objeto de análisis (transformaciones)

1.3.1 Tabla detallada ‘detalle_pdos’

Para la creación de la tabla de ‘detalle_pdos’ tenemos que combinar varias tablas, además creamos un índice para evitar que se borren duplicados cara a futuros análisis con PowerBI y dos nuevas variables como son subtotal_pdo y total_pdo

WITH tabla1 AS
  (
    SELECT ROW_NUMBER() OVER (ORDER BY T1.id_orden) AS indice,
           T1.id_orden,
           T4.id_empleado,
           CONCAT (T4.nombre,' ', T4.apellido) AS nomb_empleado,
           T1.id_producto,
           T2.nombreproducto,
           T5.id_categoria,
           T5.nombrecategoria,
           T5.descripcion AS descrip_categoria,
           T3.id_cliente,
           T7.nombrecliente,
           T1.preciounitario AS pcu,
           T2.preciounitario AS pvu,
           T1.cantidad,
           T1.descuento,
           T2.preciounitario * T1.cantidad * (1 - T1.descuento) AS subtotal_pdo,  
           T6.nombreproveedor,
           T6.ciudad AS ciudad_proveedor,
           T6.pais AS pais_proveedor
    FROM Ventas.DetalleOrden T1
    LEFT JOIN Produccion.Productos T2
    ON T1.id_producto = T2.id_producto
    LEFT JOIN Ventas.Ordenes T3
    ON T1.id_orden = T3.id_orden
    LEFT JOIN RRHH.Empleados T4
    ON T3.id_empleado = T4.id_empleado
    LEFT JOIN Produccion.Categorias T5
    ON T2.id_categoria = T5.id_categoria
    LEFT JOIN Produccion.Proveedores T6
    ON T2.id_proveedor = T6.id_proveedor
    LEFT JOIN Ventas.Clientes T7
    ON T3.id_cliente = T7.id_cliente
  )
SELECT 
  *,
  SUM (subtotal_pdo) OVER (PARTITION BY id_orden) AS total_pdo
FROM
  tabla1

1.3.2 Tabla resumen ‘pedidos’

Para la creación de la tabla de pedidos tenemos que combinar varias tablas

WITH tabla1 AS
  (
    SELECT T1.id_orden,
           CONCAT (T4.nombre,' ', T4.apellido) AS nomb_empleado,
           YEAR(T1.fecha_orden) AS año,
           MONTH (T1.fecha_orden) AS mes,
           T1.fecha_orden AS fecha_pedido,
           T1.fecha_requerida AS fecha_entrega,
           T1.flete,
           T2.nombrecliente,
           T2.ciudad AS ciudad_cliente,
           T2.pais AS pais_cliente,
           T3.compañia AS transportista
    FROM ventas.Ordenes T1
    LEFT JOIN ventas.Clientes T2
    ON T1.id_cliente = T2.id_cliente
    LEFT JOIN ventas.Transportistas T3
    ON T1.id_transportista = T3.id_transportista
    LEFT JOIN RRHH.Empleados T4
    ON T1.id_empleado = T4.id_empleado
  )
SELECT 
  *
FROM 
  tabla1

Mostramos las primeras filas del resultado

1.4 Manipulaciones finales para calidad de datos:

Resumen de datos de la tabla ‘pedidos’

Data summary

Name	pedidos_non_numeric
Number of rows	830
Number of columns	7
_______________________
Column type frequency:
character	5
Date	2
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nomb_empleado	0	1	9	15	0	9	0
nombrecliente	0	1	13	13	0	89	0
ciudad_cliente	0	1	4	15	0	68	0
pais_cliente	0	1	3	11	0	21	0
transportista	0	1	19	19	0	3	0

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
fecha_pedido	0	1	2020-07-04	2022-05-06	2021-09-09	480
fecha_entrega	0	1	2020-07-24	2022-06-11	2021-10-07	454

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
id_orden	▇▇▇▇▇	0	0	0	0	10,662.500000	10,248.00	10,455.25	10,662.50	10,869.75	11,077.00	0.0000000	0.000000000	0	0.000000	10,662.500000	10,662.500000
año	▃▁▇▁▅	0	0	0	0	2,021.142169	2,020.00	2,021.00	2,021.00	2,022.00	2,022.00	0.1421687	0.007034571	0	0.000000	2,021.142169	2,021.142169
mes	▇▅▂▃▆	0	0	0	0	6.046988	1.00	3.00	5.00	9.00	12.00	1.0469880	20.939759036	0	0.000000	6.046988	6.046988
flete	▇▁▁▁▁	0	66	0	0	78.244205	0.02	13.38	41.36	91.43	1,007.64	36.8842048	89.178444921	66	7.951807	78.244205	51.397736

Los rangos máximos de la variables ‘flete’, como se mencionó con anterioridad, son elevados y se revisarán por posibles valores atípicos.

Resumen de datos de la tabla ‘detalle_pdos’

Variables categóricas, no hay

Variables numéricas

variables	numeric.hist	nulos	atipicos	ceros	negativos	media	min	Q1	mediana	Q3	max	mediana_vs_media	pct_dif	num_atipicos	ratio_atipicos	media_con_atip	media_sin_atip
indice	▇▇▇▇▇	0	0	0	0	1,078.00000000	1.0	539.5	1,078.00	1,616.5	2,155.00	0.00000000	0.00000000	0	0.000000	1,078.00000000	1,078.00000000
id_orden	▇▇▇▇▇	0	0	0	0	10,659.37587007	10,248.0	10,451.0	10,657.00	10,862.5	11,077.00	2.37587007	0.02229399	0	0.000000	10,659.37587007	10,659.37587007
id_empleado	▆▇▁▃▃	0	0	0	0	4.33317865	1.0	2.0	4.00	7.0	9.00	0.33317865	8.32946636	0	0.000000	4.33317865	4.33317865
id_producto	▆▇▇▇▇	0	0	0	0	40.79303944	1.0	22.0	41.00	60.0	77.00	0.20696056	0.50478185	0	0.000000	40.79303944	40.79303944
id_categoria	▇▅▇▂▆	0	0	0	0	4.13549884	1.0	2.0	4.00	6.0	8.00	0.13549884	3.38747100	0	0.000000	4.13549884	4.13549884
id_cliente	▅▇▅▇▅	0	0	0	0	47.26589327	1.0	24.0	47.00	69.5	91.00	0.26589327	0.56573036	0	0.000000	47.26589327	47.26589327
pcu	▇▁▁▁▁	0	98	0	0	26.21851972	2.0	12.0	18.40	32.0	263.50	7.81851972	42.49195501	98	4.547564	26.21851972	21.33788527
pvu	▇▁▁▁▁	0	77	0	0	27.94868677	2.5	12.5	19.45	34.0	263.50	8.49868677	43.69504769	77	3.573086	27.94868677	23.17764196
cantidad	▇▃▁▁▁	0	87	0	0	23.81299304	1.0	10.0	20.00	30.0	130.00	3.81299304	19.06496520	87	4.037123	23.81299304	21.29013540
descuento	▇▁▁▁▁	0	0	1,317	0	0.05616705	0.0	0.0	0.00	0.1	0.25	0.05616705	Inf	0	0.000000	0.05616705	0.05616705
subtotal_pdo	▇▁▁▁▁	0	168	0	0	628.16842947	6.0	157.5	360.00	728.5	15,810.00	268.16842947	74.49123041	168	7.795824	628.16842947	420.17410393
total_pdo	▇▁▁▁▁	0	147	0	0	1,985.06199142	12.5	670.0	1,423.00	2,346.3	16,387.50	562.06199142	39.49838309	147	6.821346	1,985.06199142	1,545.51819920

Los rangos máximos de las variables ‘pcu’,‘pvu’ y ‘cantidad’ , como se mencionó con anterioridad, son elevados y se revisarán por posibles valores atípicos.

1.4.1 Revisión de la variable ‘flete’ de la tabla resumen ‘pedidos’

pedidos %>% 
  e_charts(x = "") %>%
  e_boxplot(flete, itemStyle = list(color = "lightblue")) %>% 
  e_tooltip(trigger = "item") %>% 
  e_image_g(
    right = 20,
    bottom = 20,
    z = -999,
    style = list(
      image = "https://www.r-project.org/logo/Rlogo.png",
      width = 50,
      height = 50,
      opacity = .6
    )
  )

A nivel general vemos muchos valores atípicos de la variable flete; a continuación vamos a segregar la variable por empleados para ver aún más detalle de los valores atípicos

Ahora procedemos a analizar la media de flete facturado por cliente y lo comparamos con el flete facturado por orden; esa diferencia la contrastamos por empleado para ver como estos se desvian con respecto a la media

rev_flete <- sqldf("
                     WITH inicial AS
                       (
                           SELECT
                           T1.nomb_empleado,
                           T1.nombrecliente,
                           T1.flete,
                           AVG (T1.flete) OVER() AS media_flete,
                           AVG (T1.flete) OVER (PARTITION BY T1.nombrecliente) AS media_flete_x_cliente
                           FROM pedidos T1
                           GROUP BY T1.nomb_empleado,
                                    T1.nombrecliente
                       ), 
                         tabla1 AS
                       (
                          SELECT *,
                                 flete - media_flete_x_cliente AS diferencia
                          FROM inicial
                          ORDER BY diferencia ASC
                       )
                      SELECT nomb_empleado,
                             media_flete,
                             SUM(diferencia) OVER (PARTITION BY nomb_empleado) dif_x_empleado
                      FROM tabla1
                      GROUP BY nomb_empleado,
                               media_flete
                      ORDER BY dif_x_empleado ASC
                  ")

Resultado

Podemos concluir que los empleados concentran los fletes facturados en importes pequeños (según la mediana que se puede visualizar por cada empleado) y facturan algunos fletes elevados (atípicos); incluso así, podemos observar que el total de flete que factura cada empleado tiene un desvío negativo con respecto a la media de flete general.

Realizamos la transformacion de la variable flete detallada en el punto de CONCLUSIONES PARA LAS TRANSFORMACIONES y la añadimos al dataset

pedidos$flete_log <- log(pedidos$flete)


skim(pedidos)

Data summary

Name	pedidos
Number of rows	830
Number of columns	12
_______________________
Column type frequency:
character	5
Date	2
numeric	5
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nomb_empleado	0	1	9	15	0	9	0
nombrecliente	0	1	13	13	0	89	0
ciudad_cliente	0	1	4	15	0	68	0
pais_cliente	0	1	3	11	0	21	0
transportista	0	1	19	19	0	3	0

Variable type: Date

skim_variable	n_missing	complete_rate	min	max	median	n_unique
fecha_pedido	0	1	2020-07-04	2022-05-06	2021-09-09	480
fecha_entrega	0	1	2020-07-24	2022-06-11	2021-10-07	454

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
id_orden	0	1	10662.50	239.74	10248.00	10455.25	10662.50	10869.75	11077.00	▇▇▇▇▇
año	0	1	2021.14	0.70	2020.00	2021.00	2021.00	2022.00	2022.00	▃▁▇▁▅
mes	0	1	6.05	3.66	1.00	3.00	5.00	9.00	12.00	▇▅▂▃▆
flete	0	1	78.24	116.78	0.02	13.38	41.36	91.43	1007.64	▇▁▁▁▁
flete_log	0	1	3.45	1.58	-3.91	2.59	3.72	4.52	6.92	▁▁▃▇▃

Comparamos la variable original con la variable transformada

Vemos una mejora de la normalidad en los datos de flete_log comparándola con su original, ya que se reduce el efecto de los valores atípicos.

1.4.2 Revisión de la variable ‘pcu’ de la tabla detallada ‘detalle_pdos’

Existen algunos precios atipicos en algunos proveedores, el departamento de compras revisará en consecuencia.

No obstante, realizamos la transformación de la variable pcu en el punto de CONCLUSIONES PARA LAS TRANSFORMACIONES; también realizamos la transformación de la variable pvu y ambas las añadimos al dataset

detalle_pdos$pcu_log <- log(detalle_pdos$pcu)
detalle_pdos$pvu_log <- log(detalle_pdos$pvu)


skim(detalle_pdos)

Data summary

Name	detalle_pdos
Number of rows	2155
Number of columns	22
_______________________
Column type frequency:
character	8
numeric	14
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nomb_empleado	0	1	9	15	0	9	0
nombreproducto	0	1	14	14	0	77	0
nombrecategoria	0	1	6	17	0	8	0
descrip_categoria	0	1	6	56	0	8	0
nombrecliente	0	1	13	13	0	89	0
nombreproveedor	0	1	15	15	0	29	0
ciudad_proveedor	0	1	4	13	0	29	0
pais_proveedor	0	1	3	12	0	16	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
indice	0	1	1078.00	622.24	1.00	539.50	1078.00	1616.50	2155.00	▇▇▇▇▇
id_orden	0	1	10659.38	241.38	10248.00	10451.00	10657.00	10862.50	11077.00	▇▇▇▇▇
id_empleado	0	1	4.33	2.49	1.00	2.00	4.00	7.00	9.00	▆▇▁▃▃
id_producto	0	1	40.79	22.16	1.00	22.00	41.00	60.00	77.00	▆▇▇▇▇
id_categoria	0	1	4.14	2.38	1.00	2.00	4.00	6.00	8.00	▇▅▇▂▆
id_cliente	0	1	47.27	25.85	1.00	24.00	47.00	69.50	91.00	▅▇▅▇▅
pcu	0	1	26.22	29.83	2.00	12.00	18.40	32.00	263.50	▇▁▁▁▁
pvu	0	1	27.95	31.61	2.50	12.50	19.45	34.00	263.50	▇▁▁▁▁
cantidad	0	1	23.81	19.02	1.00	10.00	20.00	30.00	130.00	▇▃▁▁▁
descuento	0	1	0.06	0.08	0.00	0.00	0.00	0.10	0.25	▇▁▁▁▁
subtotal_pdo	0	1	628.17	1031.40	6.00	157.50	360.00	728.50	15810.00	▇▁▁▁▁
total_pdo	0	1	1985.06	2099.97	12.50	670.00	1423.00	2346.30	16387.50	▇▁▁▁▁
pcu_log	0	1	2.95	0.77	0.69	2.48	2.91	3.47	5.57	▁▅▇▂▁
pvu_log	0	1	3.01	0.76	0.92	2.53	2.97	3.53	5.57	▁▅▇▂▁

Comparación de variables originales con variables transformadas

Vemos una mejora de la normalidad en los datos tanto de pcu_log como de pvu_log comparando ambas variables con sus originales, ya que se reduce el efecto de los valores atípicos.

1.4.3 Revisión de la variable ‘cantidad’ de la tabla detallada ‘detalle_pdos’

Dentro de la distribución normal de las cantidades vendidas, aparecen cantidades vendidas más elevadas que consideramos atipicas.

Realizamos la transformación de la variable cantidad en el punto de CONCLUSIONES PARA LAS TRANSFORMACIONES y la añadimos al dataset

detalle_pdos$cantidad_sqrt <- sqrt(detalle_pdos$cantidad)

skim(detalle_pdos)

Data summary

Name	detalle_pdos
Number of rows	2155
Number of columns	23
_______________________
Column type frequency:
character	8
numeric	15
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
nomb_empleado	0	1	9	15	0	9	0
nombreproducto	0	1	14	14	0	77	0
nombrecategoria	0	1	6	17	0	8	0
descrip_categoria	0	1	6	56	0	8	0
nombrecliente	0	1	13	13	0	89	0
nombreproveedor	0	1	15	15	0	29	0
ciudad_proveedor	0	1	4	13	0	29	0
pais_proveedor	0	1	3	12	0	16	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
indice	0	1	1078.00	622.24	1.00	539.50	1078.00	1616.50	2155.00	▇▇▇▇▇
id_orden	0	1	10659.38	241.38	10248.00	10451.00	10657.00	10862.50	11077.00	▇▇▇▇▇
id_empleado	0	1	4.33	2.49	1.00	2.00	4.00	7.00	9.00	▆▇▁▃▃
id_producto	0	1	40.79	22.16	1.00	22.00	41.00	60.00	77.00	▆▇▇▇▇
id_categoria	0	1	4.14	2.38	1.00	2.00	4.00	6.00	8.00	▇▅▇▂▆
id_cliente	0	1	47.27	25.85	1.00	24.00	47.00	69.50	91.00	▅▇▅▇▅
pcu	0	1	26.22	29.83	2.00	12.00	18.40	32.00	263.50	▇▁▁▁▁
pvu	0	1	27.95	31.61	2.50	12.50	19.45	34.00	263.50	▇▁▁▁▁
cantidad	0	1	23.81	19.02	1.00	10.00	20.00	30.00	130.00	▇▃▁▁▁
descuento	0	1	0.06	0.08	0.00	0.00	0.00	0.10	0.25	▇▁▁▁▁
subtotal_pdo	0	1	628.17	1031.40	6.00	157.50	360.00	728.50	15810.00	▇▁▁▁▁
total_pdo	0	1	1985.06	2099.97	12.50	670.00	1423.00	2346.30	16387.50	▇▁▁▁▁
pcu_log	0	1	2.95	0.77	0.69	2.48	2.91	3.47	5.57	▁▅▇▂▁
pvu_log	0	1	3.01	0.76	0.92	2.53	2.97	3.53	5.57	▁▅▇▂▁
cantidad_sqrt	0	1	4.53	1.82	1.00	3.16	4.47	5.48	11.40	▃▇▅▁▁

Comparación de variable original con la variable transformada

Vemos una mejora de la normalidad en la variable cantidad_sqrt, ya que se reduce el efecto de los valores atípicos.

1.5 Creación de nuevas variables

Se crean nuevas variables que enriqueceran el análisis posterior.

Creamos nuevas variables en la tabla detallada ‘detalle_pdos’

new_var_detalle_pdos <- sqldf("
                              SELECT
                                *,
                                CASE WHEN descuento > 0 THEN 1 ELSE 0 END AS descuento_bin
                              FROM
                                detalle_pdos
                              ")

totales_x_cliente <- sqldf("
                              SELECT 
                                nombrecliente,
                                SUM (total_pdo) AS total_x_cliente
                              FROM 
                                detalle_pdos
                              GROUP BY
                                nombrecliente
                              ")

Una vez tengamos todas las variables que queremos estudiar, las guardamos en formato .csv para poder trabajarlas dentro de un informe de PowerBi

1.6 Análisis avanzado: insights relevantes con PowerBI

1.6.1 Usando la matriz de correlación (tabla detalle_pdos)

Buscamos la fuerza de las correlaciones entre las variables numericas de la tabla ‘detalle_pdos’, para ello seleccionaremos las variables ‘log_cantidad’, ‘beneficio’ y ‘aplica_descuento’; usamos una matriz de correlacion en PowerBI, la cual puede ser filtrada por empleados, clientes, productos y además por el gráfico de cantidades vendidas por categoria, obteniendo valiosísimos insights de negocio:

Cuadro base sin filtrar

Filtrado por empleado

Filtrado por cliente

Filtrado por producto

Filtrado por empleado y cliente

La matriz de correlación intenta explicar como de fuertes son las relaciones entre las variables; los resultados oscilan entre 1 (correlación positiva fuerte) y -1 (correlación negativa fuerte), siendo 0 cuando NO hay correlación.

A continuación, se muestra un análisis de ventas y fletes creados con PowerBI que ofrece información detallada aplicando técnicas de inteligencia de tiempo.

Elegimos la medida de total de ventas y obtenemos todos los cálculos de inteligencia de tiempo

Ahora elegimos el promedio de ventas

Por último, elegimos el total de fletes cobrados a clientes

1.7 Análisis avanzado: insights relevantes (segmentación de clientes K-means)

Para clusterizar a los clientes, primero debemos de hallar su frecuencia de compra

frecuencia <- sqldf("
                     WITH tabla1 AS
                       (
                        SELECT 
                          *,
                          COUNT(*) OVER (PARTITION BY nombrecliente) AS frec_compra
                        FROM
                          pedidos
                       )
                     SELECT 
                       T1.nombrecliente,
                       T1.frec_compra,
                       T2.total_x_cliente
                     FROM 
                       tabla1 T1
                       INNER JOIN totales_x_cliente T2
                       ON T1.nombrecliente = T2.nombrecliente
                     GROUP BY 
                       T1.nombrecliente,
                       T1.frec_compra,
                       T2.total_x_cliente
                       
                   ")

head(frecuencia)

  nombrecliente frec_compra total_x_cliente
1 Cliente AHPOP           9        53524.01
2 Cliente AHXHT           6        13258.02
3 Cliente AZJED          15        98310.83
4 Cliente BSVAR           4         4587.30
5 Cliente CCFIZ           7         8854.15
6 Cliente CCKOT          10        58554.18

Realizamos las transformaciones oportunas para hallar el número óptimo de cluster para este estudio

datos_frec_compra <- data.frame(frec_compra = frecuencia$frec_compra)


datos_frec_compra_scaled <- scale(datos_frec_compra)


k_values <- 1:10
wcss <- numeric(length(k_values))


for (k in k_values) {
  kmeans_result <- kmeans(datos_frec_compra_scaled, centers = k, nstart = 25)
  wcss[k] <- kmeans_result$tot.withinss
}


wcss_df <- data.frame(K = k_values, WCSS = wcss)

RESULTADO: número óptimo de cluster = 3

Ahora que ya sabemos los clusteres óptimos hallaremos el centroide de cada cluster y graficaremos todo para visualizar el resultado obtenido

set.seed(123)
kmeans_result <- kmeans(frecuencia[, c("frec_compra", "total_x_cliente")], centers = 3)


frecuencia <- frecuencia %>%
  mutate(cluster = as.factor(kmeans_result$cluster))


centroides <- frecuencia %>%
  group_by(cluster) %>%
  summarise(
    frec_compra_centroide = mean(frec_compra),
    total_centroide = mean(total_x_cliente)
  )


ggplot(frecuencia) +
  aes(x = frec_compra, y = total_x_cliente, color = as.factor(cluster)) + 
  geom_mark_hull(aes(fill = as.factor(cluster)), concavity = 5, expand = 0.03) + 
  geom_point(size = 1.5) + 
  geom_point(data = centroides, aes(x = frec_compra_centroide, y = total_centroide), 
             color = "blue", shape = 18, size = 4) + 
  scale_y_continuous(labels = scales::label_number()) + 
  theme_minimal() +
  labs(title = "Gráfico K-means con centroides", color = "Cluster", fill = "Cluster") +
  theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"))

En el gráfico podemos ver como se agrupa por medio de la clusterización el comportamiento de compra de cada cliente, según la frecuencia de compra con respecto al total de ventas de cada cliente.

2 ANALISIS INFERENCIAL

Ahora vamos a realizar pruebas de hipótesis para ver la significancia de las variables

Añadimos una condición aplica_dcto usando la variable descuento

descuento <- sqldf("
                   WITH tabla1 AS
                     (
                   SELECT 
                     *,
                     CASE WHEN descuento_bin = 1 THEN 'si' ELSE 'no'END AS aplica_dcto
                   FROM 
                     new_var_detalle_pdos
                     )
                   SELECT 
                     aplica_dcto,
                     cantidad,
                     cantidad_sqrt,
                     subtotal_pdo
                   FROM
                     tabla1
                   ")

head(descuento)

  aplica_dcto cantidad cantidad_sqrt subtotal_pdo
1          no       12      3.464102       252.00
2          no       10      3.162278       140.00
3          no        5      2.236068       174.00
4          no        9      3.000000       209.25
5          no       40      6.324555      2120.00
6          no       10      3.162278        96.50

2.1 Pruebas de hipótesis

2.1.1 Conocer como afecta la relacion entre aplica_dcto con importes de ventas

Vamos a plantear una hipótesis sobre esta consulta en la que:

H0 (hipótesis nula) -> Aplicar un descuento NO afecta significativamente el importe total de las ventas.

H1 (hipótesis alternativa)-> Aplicar un descuento SI afecta significativamente el importe total de las ventas.

Para ello, primero filtramos la variable discreta en sus dos niveles (si o no)

sin_dcto_s_vtas <- descuento %>% filter(aplica_dcto == "no") %>% pull (subtotal_pdo)

con_dcto_s_vtas <- descuento %>% filter(aplica_dcto == "si") %>% pull (subtotal_pdo)

Vemos si los datos siguen una distribución normal, para ello sabemos que tenemos muchas observaciones en nuestros datos, por lo que las valoramos

observaciones <- length(descuento$aplica_dcto)  

Resultado observaciones: 2155

Al tener > 30 datos, tenemos una muestra lo suficientemente grande para poder asumir normalidad.

También hay que comprobar la homocedasticidad o igualdad de varianzas, para ello se realiza el test de Levene

Levene's Test for Homogeneity of Variance (center = "median")
        Df F value Pr(>F)
group    1  0.8074  0.369
      2153               

Levene's Test for Homogeneity of Variance (center = "mean")
        Df F value Pr(>F)
group    1  1.0919 0.2962
      2153               

El resultado del test arroja un p-valor mayor a 0.05, tanto aplicando tanto la mediana como la media, por lo que podriamos usar el T-test ya que encontramos homocedasticidad y asumimos normalidad.

Ahora visualizamos los datos, tanto gráficamente como con un resumen

Debido a la presencia de atipicos vamos a normalizar los datos de la variable subtotal_pdo

descuento$subtotal_pdo_log <- log(descuento$subtotal_pdo)
skim(descuento)

Data summary

Name	descuento
Number of rows	2155
Number of columns	5
_______________________
Column type frequency:
character	1
numeric	4
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
aplica_dcto	0	1	2	2	0	2	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
cantidad	0	1	23.81	19.02	1.00	10.00	20.00	30.00	130.00	▇▃▁▁▁
cantidad_sqrt	0	1	4.53	1.82	1.00	3.16	4.47	5.48	11.40	▃▇▅▁▁
subtotal_pdo	0	1	628.17	1031.40	6.00	157.50	360.00	728.50	15810.00	▇▁▁▁▁
subtotal_pdo_log	0	1	5.80	1.16	1.79	5.06	5.89	6.59	9.67	▁▃▇▃▁

Comparación de la variable original con la variable transformada

Segregamos las estadísticas descriptivas de cada grupo aplica_dcto

resumen_descuento_log <- descuento %>%
  group_by(aplica_dcto) %>%
  skim(subtotal_pdo_log)


resumen_descuento_log

Data summary

Name	Piped data
Number of rows	2155
Number of columns	5
_______________________
Column type frequency:
numeric	1
________________________
Group variables	aplica_dcto

Variable type: numeric

skim_variable	aplica_dcto	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
subtotal_pdo_log	no	0	1	5.77	1.15	1.79	5.01	5.88	6.55	9.67	▁▃▇▃▁
subtotal_pdo_log	si	0	1	5.85	1.17	2.14	5.18	5.91	6.63	9.62	▁▃▇▃▁

Tanto la media como la mediana de los datos logarítmicos son muy parecidas entre los dos grupos de descuentos, pero esta diferencia es suficientemente significativa como para decir que son parecidas? para ello, aplicamos el t-test

Separamos las muestras

sin_dcto_s_vtas_log <- descuento %>% filter(aplica_dcto == "no") %>% pull (subtotal_pdo_log)

con_dcto_s_vtas_log <- descuento %>% filter(aplica_dcto == "si") %>% pull (subtotal_pdo_log)

Realizamos el t-test comparando la superioridad de una muestra sobre la otra (análisis bilateral)

t.test(con_dcto_s_vtas_log, sin_dcto_s_vtas_log, alternative = "greater")

    Welch Two Sample t-test

data:  con_dcto_s_vtas_log and sin_dcto_s_vtas_log
t = 1.6346, df = 1764.9, p-value = 0.05116
alternative hypothesis: true difference in means is greater than 0
95 percent confidence interval:
 -0.0005716175           Inf
sample estimates:
mean of x mean of y 
 5.849164  5.765212 

El resultado arroja un p-valor muy cercano a 0.05, por lo que, tras revisar los datos posteriormente, hay evidencias estadísticas suficientes para rechazar la hipótesis nula, es por lo que se concluye que en promedio, los valores con descuento SI son mayores que los valores sin descuento, lo podemos ver en el siguiente gráfico, en el cual transformamos la media de la variable logarítmica a una escala original para apreciar con más detalle las diferencias entre medias de los grupos

Media transformada con descuento: 346.94

Media transformada sin descuento: 319.01

Diferencia de medias: 27,93 (a favor de cantidades aplicando descuento)

CONCLUSION FINAL -> SI APLICAMOS DESCUENTOS VENDEMOS DE MEDIA 27,93 € MAS QUE SI NO APLICAMOS DESCUENTOS.

2.1.2 Conocer como afecta la relacion entre aplica_dcto con cantidades vendidas

Vamos a plantear una hipótesis sobre esta consulta en la que:

H0 -> Aplicar un descuento NO afecta significativamente las cantidades vendidas.

H1 -> Aplicar un descuento SI afecta significativamente las cantidades vendidas.

Vemos si los datos siguen una distribución normal, para ello lo visualizamos gráficamente

Tenemos 2155 observaciones, por lo que asumimos normalidad en los datos

Vemos la homocedasticidad de los datos

leveneTest(cantidad_sqrt~aplica_dcto, data = descuento, center = "mean")

Levene's Test for Homogeneity of Variance (center = "mean")
        Df F value  Pr(>F)  
group    1  5.8633 0.01554 *
      2153                  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

El resultado arroja que los datos presentan heterocedasticidad.

Al tener normalidad pero no homocedasticidad, recurrimos al test de Welch

t.test(cantidad_sqrt ~ aplica_dcto, data = descuento)

    Welch Two Sample t-test

data:  cantidad_sqrt by aplica_dcto
t = -6.5306, df = 1674, p-value = 8.662e-11
alternative hypothesis: true difference in means between group no and group si is not equal to 0
95 percent confidence interval:
 -0.6878997 -0.3701339
sample estimates:
mean in group no mean in group si 
        4.323039         4.852056 

El resultado arroja un p-valor inferior a 0.05, por lo que se rechaza la hipótesis nula y se concluye que estadisticamente aplicar un descuento SI afecta significativamente las cantidades vendidas

Ahora veremos la significancia graficamente, pero calcularemos la media de la variable cantidad_sqrt debido a la alta presencia de atípicos en la variable original y luego haremos la transformación de vuelta a la escala original

# Separamos los datos por grupo
sin_dcto <- descuento %>% filter(aplica_dcto == "no")
con_dcto <- descuento %>% filter(aplica_dcto == "si")

# Calculamos la media logarítmica para cada grupo
media_sqrt_sin_dcto <- mean(sin_dcto$cantidad_sqrt)
media_sqrt_con_dcto <- mean(con_dcto$cantidad_sqrt)

# Transformamos las medias logarítmicas a la escala original
media_sqrt_a_orig_sin_dcto <- exp(media_sqrt_sin_dcto)
media_sqrt_a_orig_con_dcto <- exp(media_sqrt_con_dcto)

Media sqrt sin descuento: 4.323039

Media transformada sin descuento: 75.41746

Media sqrt con descuento: 4.852056

Media transformada con descuento: 128.0032

Comparamos los resultados obtenidos con las medias originales y podemos ver como han variado

Data summary

Name	Piped data
Number of rows	2155
Number of columns	5
_______________________
Column type frequency:
numeric	1
________________________
Group variables	aplica_dcto

Variable type: numeric

skim_variable	aplica_dcto	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
cantidad	no	0	1	21.72	17.51	1	10	18	30	130	▇▃▁▁▁
cantidad	si	0	1	27.11	20.77	1	12	20	36	130	▇▃▁▁▁

CONCLUSIONES:

Debido a la presencia de valores atípicos, tomamos la media sqrt convirtiendola a la escala original como valor correcto.

Entonces podemos concluir que, sabiendo que estadisticamente hay diferencias significativas si aplicamos un descuento con respecto a las cantidades vendidas segun el t-test y valorando la media sqrt como se ha expuesto:

Media transformada con descuento: 128.0032

Media transformada sin descuento: 75.41746

Diferencia de medias: 52,59 (a favor de cantidades aplicando descuento)

CONCLUSION FINAL -> SI APLICAMOS DESCUENTOS VENDEMOS DE MEDIA 52,59 UNIDADES MAS QUE SI NO APLICAMOS DESCUENTOS.

3 ANALISIS PREDICTIVO

3.1 Modelo de regresión lineal simple

Visualizamos las variables por si tenemos que realizar alguna transformación. Además vemos, si optaramos por ello, el resultado de la transformación

Después de este análisis, optamos por añadir al dataset las 2 transformaciones de cada variable para ver su impacto entre las correlaciones y visualizamos el resultado obtenido tras la transformación de cada variable

frecuencia$total_x_cliente_log <- log(frecuencia$total_x_cliente)
frecuencia$total_x_cliente_sqrt <- sqrt(frecuencia$total_x_cliente)
frecuencia$frec_compra_log <- log(frecuencia$frec_compra)
frecuencia$frec_compra_sqrt <- sqrt(frecuencia$frec_compra)

frecuencia %>% 
  plot_normality(total_x_cliente_log, total_x_cliente_sqrt, frec_compra_log, frec_compra_sqrt)

resultados_normalidad <- normality(frecuencia)
resultados_normalidad$p_value <- round(resultados_normalidad$p_value, 4)
resultados_normalidad %>% gt ()  %>%
  tab_header(
    title = "Resultados de Normalidad"
  ) %>%
  tab_style(
    style = cell_text(align = "center", weight = "bold"),
    locations = cells_title(groups = "title")
  )

Resultados de Normalidad
vars	statistic	p_value	sample
frec_compra	0.8773014	0.0000	89
total_x_cliente	0.5311082	0.0000	89
total_x_cliente_log	0.9786161	0.1493	89
total_x_cliente_sqrt	0.8372029	0.0000	89
frec_compra_log	0.9803499	0.1968	89
frec_compra_sqrt	0.9686456	0.0298	89

La variables que presentan normalidad según el test de Shapiro-Wilk son las variables logaritmicas de total_x_cliente y frec_compra.

Graficamos la correlación entre todas las variables para visualizar los mejores resultados

Despúes del análisis visual de las correlaciones, se van a realizar varios modelos de regresión lineal para ver cual es el que ofrece homocedasticidad, siendo siempre la variable de respuesta el total de ventas. Para ello, se escogerán las variables independientes que tengan la correlación más alta con respecto a la variable dependiente.

MODELO 1

rl_1 <- lm(sqrt(total_x_cliente) ~ frec_compra, data = frecuencia)
summary(rl_1) 

Call:
lm(formula = sqrt(total_x_cliente) ~ frec_compra, data = frecuencia)

Residuals:
     Min       1Q   Median       3Q      Max 
-110.986  -25.680    1.757   24.584  134.973 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -8.5701     9.6071  -0.892    0.375    
frec_compra  20.1748     0.8757  23.039   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 47.74 on 87 degrees of freedom
Multiple R-squared:  0.8592,    Adjusted R-squared:  0.8576 
F-statistic: 530.8 on 1 and 87 DF,  p-value: < 2.2e-16

bptest(rl_1) 

    studentized Breusch-Pagan test

data:  rl_1
BP = 9.597, df = 1, p-value = 0.001949

MODELO 2

Call:
lm(formula = log10(total_x_cliente) ~ log10(frec_compra), data = frecuencia)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.70199 -0.15951  0.01976  0.18897  0.71969 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)         2.52367    0.09485   26.61   <2e-16 ***
log10(frec_compra)  2.01036    0.10191   19.73   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2625 on 87 degrees of freedom
Multiple R-squared:  0.8173,    Adjusted R-squared:  0.8152 
F-statistic: 389.1 on 1 and 87 DF,  p-value: < 2.2e-16

    studentized Breusch-Pagan test

data:  rl_2
BP = 5.3921, df = 1, p-value = 0.02023

MODELO 3

Call:
lm(formula = sqrt(total_x_cliente) ~ sqrt(frec_compra), data = frecuencia)

Residuals:
     Min       1Q   Median       3Q      Max 
-120.102  -39.916   -1.743   30.189  160.543 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       -188.575     20.866  -9.037 3.77e-14 ***
sqrt(frec_compra)  126.032      6.833  18.445  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 57.4 on 87 degrees of freedom
Multiple R-squared:  0.7964,    Adjusted R-squared:  0.794 
F-statistic: 340.2 on 1 and 87 DF,  p-value: < 2.2e-16

    studentized Breusch-Pagan test

data:  rl_3
BP = 24.121, df = 1, p-value = 9.046e-07

MODELO 4

Call:
lm(formula = total_x_cliente ~ frec_compra, data = frecuencia)

Residuals:
   Min     1Q Median     3Q    Max 
-81955 -21582   2520  18925 143944 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -62166.6     8139.3  -7.638 2.68e-11 ***
frec_compra  11820.0      741.9  15.932  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 40440 on 87 degrees of freedom
Multiple R-squared:  0.7447,    Adjusted R-squared:  0.7418 
F-statistic: 253.8 on 1 and 87 DF,  p-value: < 2.2e-16

    studentized Breusch-Pagan test

data:  rl_4
BP = 49.882, df = 1, p-value = 1.632e-12

MODELO 5

Call:
lm(formula = log10(total_x_cliente) ~ sqrt(frec_compra), data = frecuencia)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.80441 -0.19851  0.01313  0.17887  0.75097 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)        2.54354    0.10257   24.80   <2e-16 ***
sqrt(frec_compra)  0.60554    0.03359   18.03   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2822 on 87 degrees of freedom
Multiple R-squared:  0.7889,    Adjusted R-squared:  0.7864 
F-statistic:   325 on 1 and 87 DF,  p-value: < 2.2e-16

    studentized Breusch-Pagan test

data:  rl_5
BP = 7.1446, df = 1, p-value = 0.007519

MODELO 6

Call:
lm(formula = log10(total_x_cliente) ~ frec_compra, data = frecuencia)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.17594 -0.17561  0.01841  0.21332  0.74801 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 3.489056   0.067011   52.07   <2e-16 ***
frec_compra 0.088285   0.006108   14.45   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.333 on 87 degrees of freedom
Multiple R-squared:  0.706, Adjusted R-squared:  0.7026 
F-statistic: 208.9 on 1 and 87 DF,  p-value: < 2.2e-16

    studentized Breusch-Pagan test

data:  rl_6
BP = 1.5756, df = 1, p-value = 0.2094

El modelo 6 es el único modelo donde encontramos homocedasticidad; la normalidad de los datos se asume ya que tenemos >30 observaciones.

Graficamos el modelo 6

# Coeficientes del modelo

coef_rl_6 <- coef(rl_6)

# Calculamos el valor de R^2

r_squared <- summary(rl_6)$r.squared

# Obtenemos los coeficientes del modelo (intercepto y pendiente)
intercept <- coef(rl_6)[1]
slope <- coef(rl_6)[2]

# Creamos la ecuación de la regresión en forma de texto

equation <- paste0("y = ", round(slope, 2), "x", " + ",round(intercept, 2))

r2_text <- paste0("R² = ", round(r_squared, 2))



ggplot(frecuencia) +
  aes(x = frec_compra, y = log10(total_x_cliente)) +
  geom_point(color = "lightblue") +
  geom_abline(intercept = intercept, slope = slope, color = "darkblue") +
  theme_minimal() +
  annotate("text", x = min(log10(frecuencia$total_x_cliente)), y = max(log10(frecuencia$total_x_cliente)), 
           label = equation, color = "blue", hjust = 0, vjust = 1, size = 8) +
  annotate("text", x = min(log10(frecuencia$total_x_cliente)), y = max(log10(frecuencia$total_x_cliente)) * 0.95, 
           label = r2_text, color = "blue", hjust = 0, vjust = 1, size = 8) +
  theme(axis.title.x = element_text(size = 18, face = "bold"),
        axis.title.y = element_text(size = 18, face = "bold")) +
  theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold")) +
  labs(title = "Regresión lineal, modelo 6")

Vamos a pasar el eje y a escala original, para ello, tenemos que tomar la pendiente del modelo con las variables originales (rl_4) y el intercepto del modelo rl_6

pendiente <- coef_rl_4[2]
pendiente

frec_compra 
   11820.04 

intercepto <- coef_rl_6[1]
intercepto

(Intercept) 
   3.489056 

Creamos el modelo final de regresión lineal

# Calculamos los valores ajustados

frecuencia$valores_ajustados <- intercepto + pendiente * frecuencia$frec_compra

# Ajustamos el modelo de regresión con los datos originales y valores ajustados

modelo_ajustado <- lm(total_x_cliente ~ valores_ajustados, data = frecuencia)


# Calculamos el valor de R² del modelo ajustado

r_squared_ajustado <- summary(modelo_ajustado)$r.squared

Por último, graficamos la regresión lineal

# Creamos la ecuación de la regresión en forma de texto

equation <- paste0("y = ", round(pendiente, 2), "x", " + ",round(intercepto, 2))

r2_text <- paste0("R² = ", round(r_squared_ajustado, 2))



ggplot(frecuencia) +
  aes(x = frec_compra, y = total_x_cliente) +
  geom_point(color = "lightblue") +
  geom_abline(intercept = intercepto, slope = pendiente, color = "darkblue") +
  theme_minimal() +
    annotate("text", x = min(frecuencia$frec_compra), y = max(frecuencia$total_x_cliente), 
           label = equation, color = "blue", hjust = 0, vjust = 1, size = 8) +
    annotate("text", x = min(frecuencia$frec_compra), y = max(frecuencia$total_x_cliente) * 0.95, 
           label = r2_text, color = "blue", hjust = 0, vjust = 1, size = 8) + 
  scale_y_continuous(labels = scales::label_number()) +
  theme(axis.title.x = element_text(size = 18, face = "bold"),
        axis.title.y = element_text(size = 18, face = "bold")) +
  theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold")) +
  labs(title = "Regresión lineal, modelo 6 (valores originales)")

3.2 Modelo de regresión logística

3.2.1 Regresión logística (una variable independiente)

Para esta primera regresión logística usaremos como variable dependiente el total_x_cliente_log y como variable independiente la frec_compra_log

# Calculamos la media de 'total_x_cliente_log'

media_total_x_cliente_log <- mean(frecuencia$total_x_cliente_log)

# Graficamos el resultado de la transformacion

ggplot(frecuencia, aes(x = total_x_cliente_log)) +
  geom_boxplot(fill = "lightblue", color = "darkblue", outlier.color = "darkred", outlier.size = 2) +
  geom_vline(xintercept = media_total_x_cliente_log, color = "red", linetype = "dashed", size = 1) +
  labs(title = "Boxplot de Total por cliente (log)",
       x = "Total por cliente (log)") +
  theme_bw() +
  theme(axis.title.y = element_blank(),  
        axis.text.y = element_blank(),     
        axis.ticks.y = element_blank()) +
  theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold")) +
  theme(axis.title.x = element_text(size = 18, face = "bold"))

# Calculamos el umbral en la variable transformada

umbral_var_log <- media_total_x_cliente_log

# Aplicamos la transformación inversa para obtener el umbral en la escala original

# Transformación inversa de logarítmica es exp(x) - 1

umbral_var_original <- exp(umbral_var_log) - 1

Umbral en la variable transformada: 9.929647

Umbral en la variable original: 20529.1

Se establece las ventas de la siguiente forma; total_x_cliente > 21000 -> venta alta (el evento sucede-> 1, sino 0); la nueva variable la llamaremos vtas_bin y es la que usaremos finalmente como variable de respuesta en la regresión

frecuencia <- sqldf("
                    SELECT 
                      *,
                      CASE WHEN total_x_cliente > 21000 THEN 1 ELSE 0 END AS vtas_bin                        FROM
                      frecuencia
                    ")
head(frecuencia)

  nombrecliente frec_compra total_x_cliente cluster total_x_cliente_log
1 Cliente AHPOP           9        53524.01       1           10.887886
2 Cliente AHXHT           6        13258.02       2            9.492358
3 Cliente AZJED          15        98310.83       1           11.495889
4 Cliente BSVAR           4         4587.30       2            8.431047
5 Cliente CCFIZ           7         8854.15       2            9.088642
6 Cliente CCKOT          10        58554.18       1           10.977708
  total_x_cliente_sqrt frec_compra_log frec_compra_sqrt valores_ajustados
1            231.35258        2.197225         3.000000         106383.85
2            115.14348        1.791759         2.449490          70923.73
3            313.54557        2.708050         3.872983         177304.08
4             67.72961        1.386294         2.000000          47283.65
5             94.09649        1.945910         2.645751          82743.77
6            241.97971        2.302585         3.162278         118203.89
  vtas_bin
1        1
2        0
3        1
4        0
5        0
6        1

RESUMEN

Variable independiente -> frec_compra_log

Variable dependiente -> vtas_bin

# Ajustamos el modelo

mod_reg <- glm(formula = vtas_bin ~ frec_compra_log, family = binomial, data = frecuencia)

# Medimos de la bondad de ajuste del modelo 

PseudoR2(mod_reg, which = NULL)

 McFadden 
0.5991509 

El valor de ajuste del modelo de regresión logística es alto

# Realizamos las predicciones

pred <- predict(mod_reg,  type = "response")

# Para determinar el umbral de decisión, calculamos la curva ROC y el valor AUC

roc_curve <- roc(frecuencia$vtas_bin, pred)

# Calculamos el área bajo la curva
auc_value <- auc(roc_curve)

# Graficamos la curva ROC
plot(roc_curve, main = "Curva ROC", col = "blue", lwd = 2)

# Añadimos el texto del AUC en la gráfica
text(-0.1,0.1, labels = paste("AUC:", round(auc_value, 2)), col = "red", cex = 1, , pos = 4)

# Clasificamos las predicciones

clas <- ifelse(pred > 0.5, "1", "0")

# Creamos la matriz de confusión

confusion_matrix <- table(pred = clas, actual = frecuencia$vtas_bin)
confusion_matrix

    actual
pred  0  1
   0 38  3
   1  6 42

# Extraemos los valores de la matriz de confusión

TP <- confusion_matrix["1", "1"]
FP <- confusion_matrix["1", "0"]
TN <- confusion_matrix["0", "0"]
FN <- confusion_matrix["0", "1"]

# Calculamos la precisión del modelo a la hora de clasificar

precision <- TP / (TP + FP)

print(paste("Precisión del modelo:", round(precision, 4)))

[1] "Precisión del modelo: 0.875"

Ahora visualizamos, según el punto de corte indicado, a partir de cuando se clasifican las frecuencias de compra según sea una venta alta o no, pero antes pasamos a escala original la variable independiente

frecuencia$frec_compra_original <- exp(frecuencia$frec_compra_log)

# Calculamos las predicciones del modelo

frecuencia$pred <- predict(mod_reg, type = "response")

# Clasificamos las predicciones en función del umbral que estimamos

frecuencia$clas <- ifelse(frecuencia$pred > 0.5, "1", "0")

La clasificación indica que, en el punto de corte o umbral de decisión de 0.5, el modelo estima que a partir de que el cliente compra 8 veces es el corte, es decir, que a partir de que un cliente compre 8 veces o más, éstas compras tienen una probabilidad significativamente alta de ser clasificados como altas ventas

Evolución de la frecuencia de compra, según las ventas predichas

El modelo predice la probabilidad de que según sea la frecuencia de compra del cliente, estas sean catalogadas como alta venta o no

frecuencia <- sqldf("
                    SELECT 
                      *,
                      CASE WHEN vtas_bin = 1 THEN 'si' ELSE 'no' END AS es_venta_alta
                    FROM 
                      frecuencia
                    ")
head(frecuencia)

  nombrecliente frec_compra total_x_cliente cluster total_x_cliente_log
1 Cliente AHPOP           9        53524.01       1           10.887886
2 Cliente AHXHT           6        13258.02       2            9.492358
3 Cliente AZJED          15        98310.83       1           11.495889
4 Cliente BSVAR           4         4587.30       2            8.431047
5 Cliente CCFIZ           7         8854.15       2            9.088642
6 Cliente CCKOT          10        58554.18       1           10.977708
  total_x_cliente_sqrt frec_compra_log frec_compra_sqrt valores_ajustados
1            231.35258        2.197225         3.000000         106383.85
2            115.14348        1.791759         2.449490          70923.73
3            313.54557        2.708050         3.872983         177304.08
4             67.72961        1.386294         2.000000          47283.65
5             94.09649        1.945910         2.645751          82743.77
6            241.97971        2.302585         3.162278         118203.89
  vtas_bin frec_compra_original       pred clas es_venta_alta
1        1                    9 0.68308832    1            si
2        0                    6 0.13367850    0            no
3        1                   15 0.98353637    1            si
4        0                    4 0.01092585    0            no
5        0                    7 0.29601515    0            no
6        1                   10 0.81048755    1            si

Visualizamos la frecuencia de compra original agrupada por si es considerada venta alta o no

media_por_grupo <- frecuencia %>%
  group_by(es_venta_alta) %>%
  summarize(media_frec_compra = mean(frec_compra_original), .groups = "drop")

 ggplot(frecuencia, aes(es_venta_alta, frec_compra_original, fill = es_venta_alta, color= es_venta_alta)) +
  stat_halfeye(alpha = 0.5, justification = -0.2, adjust = 0.3) +
  geom_boxplot(width = 0.12, alpha = 0.3, outlier.color = "darkred", outlier.size = 2) +
  geom_hline(data = media_por_grupo, aes(yintercept = media_frec_compra, color = es_venta_alta), linetype = "dashed", size = 0.8) +
  coord_flip() +
  theme_bw() +
  theme(legend.position = "none") +
  theme(plot.title = element_text(hjust = 0.5)) +
  labs(title = "Clasificación de la frecuencia de compra agrupada según descuento") +
   theme(axis.title.x = element_text(size = 18, face = "bold"),
        axis.title.y = element_text(size = 18, face = "bold")) +
   theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"))

3.2.2 Regresión logística (varias variables independientes)

# Cargamos los datos, selección y nuevas variables

pedidos <- dbGetQuery(con, "SELECT * FROM Ventas.Ordenes")
detalle_pdos <- dbGetQuery(con, "SELECT * FROM Ventas.DetalleOrden")
productos <- dbGetQuery(con, "SELECT * FROM Produccion.Productos")
categorias <- dbGetQuery(con, "SELECT * FROM Produccion.Categorias")

reg_logis_dcto <- sqldf("
      WITH tabla1 AS
        (
          SELECT 
            T1.id_orden,
            T4.nombrecategoria,
            T2.id_producto,
            T2.preciounitario,
            T2.cantidad,
            T2.descuento,
            CASE WHEN T2.descuento > 0 THEN 1 ELSE 0 END AS dcto_bin
          FROM
            pedidos T1
            INNER JOIN detalle_pdos T2
            ON T1.id_orden = T2.id_orden
            INNER JOIN productos T3
            ON T2.id_producto = T3.id_producto
            INNER JOIN categorias T4
            ON T3.id_categoria = T4.id_categoria
        ), tabla2 AS
        (
          SELECT 
            *,
            preciounitario * cantidad * (1-descuento) AS total_con_dcto, -- PREDICTIVA
            preciounitario * cantidad AS total_sin_dcto, -- PREDICTIVA,
            preciounitario * cantidad - preciounitario * cantidad * (1-descuento)  AS dcto_aplicado
          FROM 
            tabla1
        )
      SELECT 
        dcto_bin,
        preciounitario,
        cantidad,
        total_con_dcto,
        total_sin_dcto,
        dcto_aplicado,
        CASE WHEN nombrecategoria = 'Bebidas' THEN 1 ELSE 0 END AS es_bebidas,
        CASE WHEN nombrecategoria = 'Condimentos' THEN 1 ELSE 0 END AS es_Condimentos,
        CASE WHEN nombrecategoria = 'Dulces' THEN 1 ELSE 0 END AS es_Dulces,
        CASE WHEN nombrecategoria = 'clientes Lácteos' THEN 1 ELSE 0 END AS es_Lacteos,
        CASE WHEN nombrecategoria = 'Cereales/Granos' THEN 1 ELSE 0 END AS es_Cereales_Granos,
        CASE WHEN nombrecategoria = 'Carne/Aves' THEN 1 ELSE 0 END AS es_Carne_Aves,
        CASE WHEN nombrecategoria = 'clientes Frescos' THEN 1 ELSE 0 END AS es_Frescos,
        CASE WHEN nombrecategoria = 'Mariscos' THEN 1 ELSE 0 END AS es_Mariscos,
        CASE WHEN dcto_bin = 0 THEN 'no' ELSE 'si' END AS hay_dcto
      FROM 
        tabla2
      ")

head(reg_logis_dcto)

  dcto_bin preciounitario cantidad total_con_dcto total_sin_dcto dcto_aplicado
1        0           14.0       12          168.0          168.0             0
2        0            9.8       10           98.0           98.0             0
3        0           34.8        5          174.0          174.0             0
4        0           18.6        9          167.4          167.4             0
5        0           42.4       40         1696.0         1696.0             0
6        0            7.7       10           77.0           77.0             0
  es_bebidas es_Condimentos es_Dulces es_Lacteos es_Cereales_Granos
1          0              0         0          0                  0
2          0              0         0          0                  1
3          0              0         0          0                  0
4          0              0         0          0                  0
5          0              0         0          0                  0
6          0              0         0          0                  0
  es_Carne_Aves es_Frescos es_Mariscos hay_dcto
1             0          0           0       no
2             0          0           0       no
3             0          0           0       no
4             0          0           0       no
5             0          0           0       no
6             0          0           1       no

Graficamos la distribución de la variable cantidad agrupada por si hay o no descuento

media_por_grupo <- reg_logis_dcto %>%
  group_by(hay_dcto) %>%
  summarize(media_cantidad = mean(cantidad), .groups = "drop")

ggplot(reg_logis_dcto, aes(hay_dcto, cantidad, fill = hay_dcto, color= hay_dcto)) +
  stat_halfeye(alpha = 0.5, justification = -0.2, adjust = 0.3) +
  geom_boxplot(width = 0.12, alpha = 0.3, outlier.color = "darkred", outlier.size = 2) +
  geom_hline(data = media_por_grupo, aes(yintercept = media_cantidad, color = hay_dcto), linetype = "dashed", size = 0.8) +
  coord_flip() +
  theme_bw() +
  theme(legend.position = "none") +
  theme(plot.title = element_text(hjust = 0.5)) +
  labs(title = "Distribución de cantidad vendida agrupada según descuento") +
  theme(axis.title.x = element_text(size = 18, face = "bold"),
        axis.title.y = element_text(size = 18, face = "bold")) +
  theme(plot.title = element_text(hjust = 0.5, size = 20, face = "bold"))