# Instalar y cargar las librerías necesarias
# install.packages(c("readxl", "dplyr", "lubridate", "ggplot2", "factoextra", "cluster"))
library(readxl)
## Warning: package 'readxl' was built under R version 4.3.3
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(lubridate)
## Warning: package 'lubridate' was built under R version 4.3.3
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.3
library(plotly)
## Warning: package 'plotly' was built under R version 4.3.3
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
## Warning: package 'cluster' was built under R version 4.3.3
# Leer el archivo Excel
file_path <- "D:/@Josefh.QM/UNAP_24_1/Taller_de_Tesis/catalogoproductos.xlsx"
data <- read_excel(file_path)
# Mostrar una muestra de los datos
head(data)
## # A tibble: 6 × 11
## Cod_Prod Nom_Prod Concent Nom_Form_Farm Nom_Form_Farm_Simplif Presentac
## <dbl> <chr> <chr> <chr> <chr> <chr>
## 1 39838 3A OFTENO 0.1 % Solución Oft… SOLUCION OFTALMICA Caja Fra…
## 2 46962 3A OFTENO 0.1 % Solución Oft… SOLUCION OFTALMICA Caja Fra…
## 3 57269 3-A OFTENO 0.1 % Solución Oft… SOLUCION OFTALMICA Caja Fra…
## 4 47895 3DT BIOTIC 500 mg Tableta Recu… TABLETA Caja Env…
## 5 42762 3-GEL 582 mg + 19… Suspensión O… SUSPENSION Caja Sob…
## 6 44453 3-GEL 582 mg + 19… Suspensión O… SUSPENSION Caja Sob…
## # ℹ 5 more variables: Fracciones <dbl>, Fec_Vcto_Reg_Sanitario <chr>,
## # Num_RegSan <chr>, Nom_Titular <chr>, Situacion <chr>
# Limpieza de Datos
# Convertir fechas a formato Date
data <- data %>%
mutate(Fec_Vcto_Reg_Sanitario = as.Date(Fec_Vcto_Reg_Sanitario, format = "%d/%m/%Y"))
# Verificar valores nulos
summary(data)
## Cod_Prod Nom_Prod Concent Nom_Form_Farm
## Min. : 3 Length:18689 Length:18689 Length:18689
## 1st Qu.:40197 Class :character Class :character Class :character
## Median :47163 Mode :character Mode :character Mode :character
## Mean :45065
## 3rd Qu.:52963
## Max. :57835
## Nom_Form_Farm_Simplif Presentac Fracciones
## Length:18689 Length:18689 Min. : 1.00
## Class :character Class :character 1st Qu.: 1.00
## Mode :character Mode :character Median : 14.00
## Mean : 38.48
## 3rd Qu.: 50.00
## Max. :5000.00
## Fec_Vcto_Reg_Sanitario Num_RegSan Nom_Titular
## Min. :2011-01-22 Length:18689 Length:18689
## 1st Qu.:2023-08-05 Class :character Class :character
## Median :2025-01-10 Mode :character Mode :character
## Mean :2024-12-16
## 3rd Qu.:2026-05-21
## Max. :2029-10-13
## Situacion
## Length:18689
## Class :character
## Mode :character
##
##
##
# Transformar variables categóricas a factores y luego a valores numéricos
data <- data %>%
mutate(
Nom_Titular = as.numeric(as.factor(Nom_Titular)),
Nom_Form_Farm = as.numeric(as.factor(Nom_Form_Farm)),
Nom_Form_Farm_Simplif = as.numeric(as.factor(Nom_Form_Farm_Simplif)),
Presentac = as.numeric(as.factor(Presentac)),
Situacion = as.numeric(as.factor(Situacion))
)
# Análisis Exploratorio de Datos (EDA)
# Resumen estadístico
summary(data)
## Cod_Prod Nom_Prod Concent Nom_Form_Farm
## Min. : 3 Length:18689 Length:18689 Min. : 1.0
## 1st Qu.:40197 Class :character Class :character 1st Qu.: 56.0
## Median :47163 Mode :character Mode :character Median :110.0
## Mean :45065 Mean :100.8
## 3rd Qu.:52963 3rd Qu.:143.0
## Max. :57835 Max. :164.0
## Nom_Form_Farm_Simplif Presentac Fracciones
## Min. : 1.00 Min. : 1.0 Min. : 1.00
## 1st Qu.:12.00 1st Qu.: 405.0 1st Qu.: 1.00
## Median :23.00 Median : 524.0 Median : 14.00
## Mean :18.94 Mean : 702.3 Mean : 38.48
## 3rd Qu.:26.00 3rd Qu.: 992.0 3rd Qu.: 50.00
## Max. :29.00 Max. :1837.0 Max. :5000.00
## Fec_Vcto_Reg_Sanitario Num_RegSan Nom_Titular Situacion
## Min. :2011-01-22 Length:18689 Min. : 1.0 Min. :1
## 1st Qu.:2023-08-05 Class :character 1st Qu.:163.0 1st Qu.:1
## Median :2025-01-10 Mode :character Median :243.0 Median :1
## Mean :2024-12-16 Mean :225.4 Mean :1
## 3rd Qu.:2026-05-21 3rd Qu.:301.0 3rd Qu.:1
## Max. :2029-10-13 Max. :390.0 Max. :1
# Convertir fechas a formato Date
data <- data %>%
mutate(Fec_Vcto_Reg_Sanitario = as.Date(Fec_Vcto_Reg_Sanitario, format = "%Y-%m-%d"))
# Crear el histograma con ggplot2
p <- ggplot(data, aes(x = Fec_Vcto_Reg_Sanitario)) +
geom_histogram(binwidth = 30, fill = "blue", color = "black") +
labs(title = "Distribución de Fechas de Vencimiento de Registros Sanitarios", x = "Fecha de Vencimiento", y = "Frecuencia")
# Convertir el gráfico de ggplot2 a un gráfico interactivo con plotly
p_interactivo <- ggplotly(p)
# Mostrar el gráfico interactivo
p_interactivo
# Cargar la librería plotly
library(plotly)
# Agrupamiento por empresas farmacéuticas con ggplot2
p <- ggplot(data, aes(x = reorder(Nom_Titular, -table(Nom_Titular)[Nom_Titular]), fill = as.factor(Nom_Titular))) +
geom_bar() +
labs(title = "Número de Productos por Empresa Farmacéutica", x = "Empresa Farmacéutica", y = "Número de Productos") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, size = 8)) +
guides(fill = FALSE)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Convertir el gráfico de ggplot2 a un gráfico interactivo con plotly
p_interactivo <- ggplotly(p) %>%
layout(title = "Número de Productos por Empresa Farmacéutica",
xaxis = list(title = "Empresa Farmacéutica"),
yaxis = list(title = "Número de Productos"),
hovermode = "closest")
# Mostrar el gráfico interactivo
p_interactivo
# Preparación de datos para clusterización
data_cluster <- data %>%
select(Nom_Titular, Fec_Vcto_Reg_Sanitario) %>%
mutate(Fec_Vcto_Reg_Sanitario = as.numeric(difftime(Fec_Vcto_Reg_Sanitario, min(Fec_Vcto_Reg_Sanitario, na.rm = TRUE), units = "days")))
# Agrupar por empresa y calcular media de fechas de vencimiento
data_cluster <- data_cluster %>%
group_by(Nom_Titular) %>%
summarise(mean_vencimiento = mean(Fec_Vcto_Reg_Sanitario, na.rm = TRUE))
# Verificar que no haya valores NaN
data_cluster <- data_cluster %>% filter(!is.na(mean_vencimiento))
# Métodos de Clusterización
# Escalar los datos
data_scaled <- scale(data_cluster$mean_vencimiento)
# Método K-means
set.seed(123)
fviz_nbclust(data_scaled, kmeans, method = "wss") # Método del codo para determinar el número óptimo de clusters
kmeans_result <- kmeans(data_scaled, centers = 7) # Suponiendo 7 clusters
# Resultados del K-means
data_cluster$cluster <- kmeans_result$cluster
# Añadir una dimensión adicional para la visualización de clusters
data_cluster <- data_cluster %>%
mutate(Nom_Titular = as.numeric(as.factor(Nom_Titular)))
data_scaled <- data_cluster %>%
select(mean_vencimiento, Nom_Titular) %>%
scale()
# Visualización de clusters
fviz_cluster(kmeans_result, data = data_scaled, geom = "point", ellipse = TRUE) +
labs(title = "Clusterización de Empresas Farmacéuticas")
# Evaluación de Clusters
# Coeficiente de silueta
silhouette_score <- silhouette(kmeans_result$cluster, dist(data_scaled))
fviz_silhouette(silhouette_score)
## cluster size ave.sil.width
## 1 1 72 0.09
## 2 2 122 0.09
## 3 3 38 0.06
## 4 4 108 0.08
## 5 5 25 0.27
## 6 6 4 0.25
## 7 7 21 0.18
# Resultados finales
print(data_cluster)
## # A tibble: 390 × 3
## Nom_Titular mean_vencimiento cluster
## <dbl> <dbl> <int>
## 1 1 5128 2
## 2 2 4740 4
## 3 3 4965. 4
## 4 4 5519. 1
## 5 5 5056 2
## 6 6 4679. 4
## 7 7 5177. 2
## 8 8 5772. 3
## 9 9 4109 7
## 10 10 5286. 1
## # ℹ 380 more rows
# Guardar los resultados en un archivo CSV
#write.csv(data_cluster, "D:/@Josefh.QM/UNAP_24_1/Taller_de_Tesis/resultados_clusters.csv", row.names = FALSE)