Trabajo Final de Master UNED - Master en Big Data & Business Analytics
Ricard Blanch Coscolin
Septiembre 2020
Los datos y la base del proyecto pueden encontrarse en una fuente open data como es: https://archive.ics.uci.edu/ml/datasets/Incident+management+process+enriched+event+log#
1 - Trabajo previo de transformación
1.1 - Importación de librerías y datos
1.1.1 - Librerías necesarias
Cargamos las librerías necesarias para la ejecución del programa
# Limpiamos el workspace de trabajo
rm(list = ls())
# Limpiamos la consola de cualquier otra orden que pudiéramos tener escrita
cat("\014") # ctrl+L##
## 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## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v stringr 1.4.0
## v tibble 3.0.3 v forcats 0.5.0
## v purrr 0.3.4## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union##
## Attaching package: 'data.table'## The following objects are masked from 'package:lubridate':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year## The following object is masked from 'package:purrr':
##
## transpose## The following objects are masked from 'package:dplyr':
##
## between, first, last## Loading required package: viridisLite## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## lift##
## Attaching package: 'MLmetrics'## The following objects are masked from 'package:caret':
##
## MAE, RMSE## The following object is masked from 'package:base':
##
## Recall1.1.2 - Datos de análisis
Importamos los datos con los que vamos a trabajar directamente desde la web pública, descargándonos el fichero zip, descomprimiéndolo y guardándolo bajo un nombre.
Finalmente lo visualizamos para comprobar que se haya descargado correctamente.
temp <- tempfile()
download.file("https://archive.ics.uci.edu/ml/machine-learning-databases/00498/incident_event_log.zip",temp)
log <- read_csv(unz(temp, "incident_event_log.csv"))## Parsed with column specification:
## cols(
## .default = col_character(),
## active = col_logical(),
## reassignment_count = col_double(),
## reopen_count = col_double(),
## sys_mod_count = col_double(),
## made_sla = col_logical(),
## knowledge = col_logical(),
## u_priority_confirmation = col_logical()
## )## See spec(...) for full column specifications.1.1.3 - Copiado de datos
Primeramente, copiamos los datos con otro nombre para así mantener los datos descargados en estado vírgen en caso de que fuera necesario en todo momento.
A continuación damos un vistazo general a las variables y sus características que forman nuestros datos.
## tibble [141,712 x 36] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ number : chr [1:141712] "INC0000045" "INC0000045" "INC0000045" "INC0000045" ...
## $ incident_state : chr [1:141712] "New" "Resolved" "Resolved" "Closed" ...
## $ active : logi [1:141712] TRUE TRUE TRUE FALSE TRUE TRUE ...
## $ reassignment_count : num [1:141712] 0 0 0 0 0 1 1 1 1 1 ...
## $ reopen_count : num [1:141712] 0 0 0 0 0 0 0 0 0 0 ...
## $ sys_mod_count : num [1:141712] 0 2 3 4 0 1 2 3 4 5 ...
## $ made_sla : logi [1:141712] TRUE TRUE TRUE TRUE TRUE TRUE ...
## $ caller_id : chr [1:141712] "Caller 2403" "Caller 2403" "Caller 2403" "Caller 2403" ...
## $ opened_by : chr [1:141712] "Opened by 8" "Opened by 8" "Opened by 8" "Opened by 8" ...
## $ opened_at : chr [1:141712] "29/2/2016 01:16" "29/2/2016 01:16" "29/2/2016 01:16" "29/2/2016 01:16" ...
## $ sys_created_by : chr [1:141712] "Created by 6" "Created by 6" "Created by 6" "Created by 6" ...
## $ sys_created_at : chr [1:141712] "29/2/2016 01:23" "29/2/2016 01:23" "29/2/2016 01:23" "29/2/2016 01:23" ...
## $ sys_updated_by : chr [1:141712] "Updated by 21" "Updated by 642" "Updated by 804" "Updated by 908" ...
## $ sys_updated_at : chr [1:141712] "29/2/2016 01:23" "29/2/2016 08:53" "29/2/2016 11:29" "5/3/2016 12:00" ...
## $ contact_type : chr [1:141712] "Phone" "Phone" "Phone" "Phone" ...
## $ location : chr [1:141712] "Location 143" "Location 143" "Location 143" "Location 143" ...
## $ category : chr [1:141712] "Category 55" "Category 55" "Category 55" "Category 55" ...
## $ subcategory : chr [1:141712] "Subcategory 170" "Subcategory 170" "Subcategory 170" "Subcategory 170" ...
## $ u_symptom : chr [1:141712] "Symptom 72" "Symptom 72" "Symptom 72" "Symptom 72" ...
## $ cmdb_ci : chr [1:141712] "?" "?" "?" "?" ...
## $ impact : chr [1:141712] "2 - Medium" "2 - Medium" "2 - Medium" "2 - Medium" ...
## $ urgency : chr [1:141712] "2 - Medium" "2 - Medium" "2 - Medium" "2 - Medium" ...
## $ priority : chr [1:141712] "3 - Moderate" "3 - Moderate" "3 - Moderate" "3 - Moderate" ...
## $ assignment_group : chr [1:141712] "Group 56" "Group 56" "Group 56" "Group 56" ...
## $ assigned_to : chr [1:141712] "?" "?" "?" "?" ...
## $ knowledge : logi [1:141712] TRUE TRUE TRUE TRUE TRUE TRUE ...
## $ u_priority_confirmation: logi [1:141712] FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ notify : chr [1:141712] "Do Not Notify" "Do Not Notify" "Do Not Notify" "Do Not Notify" ...
## $ problem_id : chr [1:141712] "?" "?" "?" "?" ...
## $ rfc : chr [1:141712] "?" "?" "?" "?" ...
## $ vendor : chr [1:141712] "?" "?" "?" "?" ...
## $ caused_by : chr [1:141712] "?" "?" "?" "?" ...
## $ closed_code : chr [1:141712] "code 5" "code 5" "code 5" "code 5" ...
## $ resolved_by : chr [1:141712] "Resolved by 149" "Resolved by 149" "Resolved by 149" "Resolved by 149" ...
## $ resolved_at : chr [1:141712] "29/2/2016 11:29" "29/2/2016 11:29" "29/2/2016 11:29" "29/2/2016 11:29" ...
## $ closed_at : chr [1:141712] "5/3/2016 12:00" "5/3/2016 12:00" "5/3/2016 12:00" "5/3/2016 12:00" ...
## - attr(*, "spec")=
## .. cols(
## .. number = col_character(),
## .. incident_state = col_character(),
## .. active = col_logical(),
## .. reassignment_count = col_double(),
## .. reopen_count = col_double(),
## .. sys_mod_count = col_double(),
## .. made_sla = col_logical(),
## .. caller_id = col_character(),
## .. opened_by = col_character(),
## .. opened_at = col_character(),
## .. sys_created_by = col_character(),
## .. sys_created_at = col_character(),
## .. sys_updated_by = col_character(),
## .. sys_updated_at = col_character(),
## .. contact_type = col_character(),
## .. location = col_character(),
## .. category = col_character(),
## .. subcategory = col_character(),
## .. u_symptom = col_character(),
## .. cmdb_ci = col_character(),
## .. impact = col_character(),
## .. urgency = col_character(),
## .. priority = col_character(),
## .. assignment_group = col_character(),
## .. assigned_to = col_character(),
## .. knowledge = col_logical(),
## .. u_priority_confirmation = col_logical(),
## .. notify = col_character(),
## .. problem_id = col_character(),
## .. rfc = col_character(),
## .. vendor = col_character(),
## .. caused_by = col_character(),
## .. closed_code = col_character(),
## .. resolved_by = col_character(),
## .. resolved_at = col_character(),
## .. closed_at = col_character()
## .. )## [1] 141712 36## number incident_state active reassignment_count
## Length:141712 Length:141712 Mode :logical Min. : 0.000
## Class :character Class :character FALSE:24986 1st Qu.: 0.000
## Mode :character Mode :character TRUE :116726 Median : 1.000
## Mean : 1.104
## 3rd Qu.: 1.000
## Max. :27.000
## reopen_count sys_mod_count made_sla caller_id
## Min. :0.00000 Min. : 0.000 Mode :logical Length:141712
## 1st Qu.:0.00000 1st Qu.: 1.000 FALSE:9215 Class :character
## Median :0.00000 Median : 3.000 TRUE :132497 Mode :character
## Mean :0.02192 Mean : 5.081
## 3rd Qu.:0.00000 3rd Qu.: 6.000
## Max. :8.00000 Max. :129.000
## opened_by opened_at sys_created_by sys_created_at
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## sys_updated_by sys_updated_at contact_type location
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## category subcategory u_symptom cmdb_ci
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## impact urgency priority assignment_group
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## assigned_to knowledge u_priority_confirmation notify
## Length:141712 Mode :logical Mode :logical Length:141712
## Class :character FALSE:116349 FALSE:100740 Class :character
## Mode :character TRUE :25363 TRUE :40972 Mode :character
##
##
##
## problem_id rfc vendor caused_by
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## closed_code resolved_by resolved_at closed_at
## Length:141712 Length:141712 Length:141712 Length:141712
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
## ## [1] "number" "incident_state"
## [3] "active" "reassignment_count"
## [5] "reopen_count" "sys_mod_count"
## [7] "made_sla" "caller_id"
## [9] "opened_by" "opened_at"
## [11] "sys_created_by" "sys_created_at"
## [13] "sys_updated_by" "sys_updated_at"
## [15] "contact_type" "location"
## [17] "category" "subcategory"
## [19] "u_symptom" "cmdb_ci"
## [21] "impact" "urgency"
## [23] "priority" "assignment_group"
## [25] "assigned_to" "knowledge"
## [27] "u_priority_confirmation" "notify"
## [29] "problem_id" "rfc"
## [31] "vendor" "caused_by"
## [33] "closed_code" "resolved_by"
## [35] "resolved_at" "closed_at"1.2 - 1er EDA
Realizamos un EDA sobre los datos tal cual los hemos descargado de la web para evaluarlo junto con los pasos anteriores.
Podemos destacar de este primer análisis que es muy extraño que no haya ningún valor NA en el dataframe entero. Investigando un poco vemos que los valores no conocidos han sido imputados como “?” lo cual hace que la función “inspect NA” los inteprete correctamente.
En segundo lugar, vemos que casi no ha encontrado correlación entre var iables numéricas, pero al observar el último gráfico vemos que tenemos 29 variables imputadas como caracter y sólo 3 como numéricas. Esto intentaremos corregirlo en los próximos pasos.
Y ya por último vemos que a pesar de haber unas cuantas variables relacionadas con eventos, no aparece ninguna con formato fecha. Esto también vamos a intentar corregirlo a continuación.
1.3 - Feature Engineering
1.3.1 - Imputación de valores NA
Rápidamente observamos que sobre nuestros datos, hay muchas celdas rellenadas con el valor “?”. Reemplazamos este valor, por el valor NA, de tal forma que después podamos usar la función “inspect NA” durante el EDA.
Volvemos a abrir los datos para comprobar que se haya realizado el reemplazo éxitosamente.
Al reemplazar los datos, observamos ya la presencia de muchos NA en algunas columnas. Por eso, antes de volver realizar un EDA más completo, realizamos una pequeña inspección de valores NA sobre los datos tal y cómo los tenemos ahora.
1.3.2 - Eliminación columnas con excesiva presencia de NA´s
De este primer análisis rápido, vemos que ahora si la función “inspect NA” arroja resultados y además vemos que hay 5 columnas las cuales tienen prácticamente un 100% de valores con NA. Por eso procedemos a eliminarlas ya que no aportan información a todo el análisis que se va a realizar.
Volvemos a comprobar nuevamente los datos con la misma función anterior de “inspect NA”.
my_data$problem_id <- NULL
my_data$cmdb_ci <- NULL
my_data$rfc <- NULL
my_data$vendor <- NULL
my_data$caused_by <- NULL
x <- inspect_na(my_data)
show_plot(x)
Sigue habiendo un par de columnas con aproximadamente un tercio de los valores imputados como NA, pero por el momento seguimos trabajando así a falta de ver posteriores decisiones.
1.3.3 - Transformación de fechas
Anteriormente, en el análisis de variables de nuestros datos, hemos visto que hay una serie de columnas con fechas de eventos pero estas están guardadas como carácteres. Por eso lo transformamos correctamente a un formato fecha, para posteriormente comprobar que la transformación se ha realizado correctamente y así eliminar las antiguas columnas redundantes.
## [1] "character"## [1] "character"## [1] "character"## [1] "character"## [1] "character"my_data$fe_opened_at <- dmy_hm(my_data$opened_at)
my_data$fe_resolved_at <- dmy_hm(my_data$resolved_at)
my_data$fe_closed_at <- dmy_hm(my_data$closed_at)
my_data$fe_sys_created_at <- dmy_hm(my_data$sys_created_at)
my_data$fe_sys_updated_at <- dmy_hm(my_data$sys_updated_at)
class(my_data$fe_opened_at)## [1] "POSIXct" "POSIXt"## [1] "POSIXct" "POSIXt"## [1] "POSIXct" "POSIXt"## [1] "POSIXct" "POSIXt"## [1] "POSIXct" "POSIXt"my_data$opened_at <- NULL
my_data$resolved_at <- NULL
my_data$closed_at <- NULL
my_data$sys_created_at <- NULL
my_data$sys_updated_at <- NULL
head(my_data)1.3.4 - Eliminación texto dentro de las variables
Hay muchas variables imputadas como modo carácter, aunque muchas veces el texto es repetitivo dentro de las variables. Eliminando ese texto y seleccionando el resto, podremos quizás tratarlas como numéricas (lo cual favorecerá la función “inspect” en el segundo EDA) o tratarlas más fácilmente como variables categóricas. Finalmente comprobamos que las transformaciones se han realizado correctamente.
my_data <- my_data %>%
separate(caller_id, c("txt", "fe_caller_id"), " ", convert = TRUE) %>%
separate(opened_by, c("txt", "fe_opened_by"), " ", convert = TRUE) %>%
separate(sys_created_by, c("txt", "txt2", "fe_sys_created_by"), " ", convert = TRUE) %>%
separate(sys_updated_by, c("txt", "txt2", "fe_sys_updated_by"), " ", convert = TRUE) %>%
separate(location, c("txt", "fe_location"), " ", convert = TRUE) %>%
separate(category, c("txt", "fe_category"), " ", convert = TRUE) %>%
separate(subcategory, c("txt", "fe_subcategory"), " ", convert = TRUE) %>%
separate(urgency, c("fe_urgency", "txt"), " ", convert = TRUE) %>%
separate(impact, c("fe_impact", "txt"), " ", convert = TRUE) %>%
separate(priority, c("fe_priority", "txt"), " ", convert = TRUE) %>%
separate(u_symptom, c("txt", "fe_user_symptom"), " ", convert = TRUE) %>%
separate(assignment_group, c("txt", "fe_assigned_group"), " ", convert = TRUE) %>%
separate(assigned_to, c("txt", "fe_assigned_to"), " ", convert = TRUE) %>%
separate(closed_code, c("txt", "fe_closed_code"), " ", convert = TRUE) %>%
separate(resolved_by, c("txt", "txt2", "fe_resolved_by"), " ", convert = TRUE) %>%
select(-txt, -txt2)## Warning: Expected 2 pieces. Additional pieces discarded in 141712 rows [1, 2, 3,
## 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].
## Warning: Expected 2 pieces. Additional pieces discarded in 141712 rows [1, 2, 3,
## 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].
## Warning: Expected 2 pieces. Additional pieces discarded in 141712 rows [1, 2, 3,
## 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].## tibble [141,712 x 31] (S3: tbl_df/tbl/data.frame)
## $ number : chr [1:141712] "INC0000045" "INC0000045" "INC0000045" "INC0000045" ...
## $ incident_state : chr [1:141712] "New" "Resolved" "Resolved" "Closed" ...
## $ active : logi [1:141712] TRUE TRUE TRUE FALSE TRUE TRUE ...
## $ reassignment_count : num [1:141712] 0 0 0 0 0 1 1 1 1 1 ...
## $ reopen_count : num [1:141712] 0 0 0 0 0 0 0 0 0 0 ...
## $ sys_mod_count : num [1:141712] 0 2 3 4 0 1 2 3 4 5 ...
## $ made_sla : logi [1:141712] TRUE TRUE TRUE TRUE TRUE TRUE ...
## $ fe_caller_id : int [1:141712] 2403 2403 2403 2403 2403 2403 2403 2403 2403 2403 ...
## $ fe_sys_created_by : int [1:141712] 6 6 6 6 171 171 171 171 171 171 ...
## $ fe_opened_by : int [1:141712] 8 8 8 8 397 397 397 397 397 397 ...
## $ contact_type : chr [1:141712] "Phone" "Phone" "Phone" "Phone" ...
## $ fe_location : int [1:141712] 143 143 143 143 165 165 165 165 165 165 ...
## $ fe_sys_updated_by : int [1:141712] 21 642 804 908 746 21 21 804 703 332 ...
## $ fe_subcategory : int [1:141712] 170 170 170 170 215 215 215 215 215 215 ...
## $ fe_category : int [1:141712] 55 55 55 55 40 40 40 40 40 40 ...
## $ fe_user_symptom : int [1:141712] 72 72 72 72 471 471 471 471 471 471 ...
## $ fe_impact : int [1:141712] 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_urgency : int [1:141712] 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_priority : int [1:141712] 3 3 3 3 3 3 3 3 3 3 ...
## $ fe_assigned_to : int [1:141712] NA NA NA NA 89 31 31 31 31 31 ...
## $ fe_assigned_group : int [1:141712] 56 56 56 56 70 24 24 24 24 24 ...
## $ knowledge : logi [1:141712] TRUE TRUE TRUE TRUE TRUE TRUE ...
## $ u_priority_confirmation: logi [1:141712] FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ notify : chr [1:141712] "Do Not Notify" "Do Not Notify" "Do Not Notify" "Do Not Notify" ...
## $ fe_closed_code : int [1:141712] 5 5 5 5 5 5 5 5 5 5 ...
## $ fe_resolved_by : int [1:141712] 149 149 149 149 81 81 81 81 81 81 ...
## $ fe_opened_at : POSIXct[1:141712], format: "2016-02-29 01:16:00" "2016-02-29 01:16:00" ...
## $ fe_resolved_at : POSIXct[1:141712], format: "2016-02-29 11:29:00" "2016-02-29 11:29:00" ...
## $ fe_closed_at : POSIXct[1:141712], format: "2016-03-05 12:00:00" "2016-03-05 12:00:00" ...
## $ fe_sys_created_at : POSIXct[1:141712], format: "2016-02-29 01:23:00" "2016-02-29 01:23:00" ...
## $ fe_sys_updated_at : POSIXct[1:141712], format: "2016-02-29 01:23:00" "2016-02-29 08:53:00" ...1.3.5 - Eliminación columnas con información redundante
Comprobamos algunas columnas que parecen tener información parecida y redundante para eliminar una de ellas y alijerar el data set para poder trabajar mejor.
La variable “ACTIVE” está durante todo el proceso como TRUE, excepto cuando el incidente cambia a staus CLOSED. Es en ese momento cuando la variable “ACTIVE” paso a FALSE. Con lo cual comprobamos la cantidad de veces que aparece CLOSED en la variable “INCIDENT_STATE” con la cantidad de veces que aparece FALSE en la variable “ACTIVE”.
## [1] 24985## [1] 24986Vistos los resultados anteriores, decidimos eliminar la variable “ACTIVE” por ser totalmente redundante con la variable “INCIDENT_STATE”.
1.4 - 2o EDA
Con este trabajo previo de transformación realizado, pasamos a realizar un segundo EDA completo sobre los datos.
Ahora si podemos observar como la función automática “inspect” ha sido capaz de encontrar algunas correlaciones entre variables (que posteriormente analizaremos en detalle).
Automáticamente también ha realizado una serie de histogramas, en los cuales entraremos en detalle en aquellos que sean interesantes más adelante durante el análisis gráfico de datos.
También vemos como ahora tenemos 5 tipologías de variables, se han añadido la de tipo “integer” y las de tipo “POSIXct POSIXt” (o fechas) debido a las modificaciones que hemos realizado.
Referente al tamaño del archivo, podemos ver como todas las variables referidas a eventos o fechas han disminuido mucho su tamaño al cambiarles el formato de “carácter” a “POSIXct POSIXt”. Esto es una ventaja no buscada pero que nos permitirá trabajar más ligeramente.
Y ya para finalizar podemos observar como algunas variables, más del 90% de los valores corresponden a una sola categoría. Esto nos puede dificultar a la hora de entrenar el modelo, pero ya lo veremos en detalle más adelante.
2 - Análisis gráfico
2.1 - Número de actualizaciones en los incidentes
A continuación vamos a hacer un análisis de cuantas veces un incidente creado es actualizado de alguna manera durante la vida hasta que haya sido cerrado (o hasta el último estado del cual tengamos constancia en el momento de extracción de los datos).
También extraemos los valores para cada una de las columnas del histograma con el fin de tener los datos claros.
## `summarise()` ungrouping output (override with `.groups` argument)max_sys_mod_count_order <- max_sys_mod_count[order(-max_sys_mod_count$`max(sys_mod_count)`),]
max_sys_mod_count_orderqplot(max_sys_mod_count$`max(sys_mod_count)`,
geom="histogram",
binwidth = 1,
main = "Number of times that status has been updated before it is closed",
xlab = "Number of status changes",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
vector_max_sys_mod_count <- as.vector(max_sys_mod_count$`max(sys_mod_count)`)
a <- rle(sort(vector_max_sys_mod_count))
b <- data.frame(number=a$values, n=a$lengths)
bDel anterior histograma podemos observar que la mayoría de incidentes creados en nuestra base de datos, han pasado por 2 actualizaciones, lo cual es lo mínimo exigible (OPEN y CLOSED) considerando que la mayoría esten cerrados, que es nuestro caso ya que vemos que tan sólo hay 1803 incidentes con una sola actualización de estado que corresponde al estado OPEN o directamente CLOSED.
Ahora vamos a representar automáticamente el histograma pero mostrando sólo aquellas columnas donde el número de casos no suponga más del 1% total de observaciones. Igualmente vamos a calcular cuantos incidentes hemos dejado fuera del histograma.
c <- b %>%
filter(b$n > (0.01*nrow(max_sys_mod_count)))
qplot(max_sys_mod_count$`max(sys_mod_count)`,
geom="histogram",
binwidth = 1,
main = "Number of times that status changes before it is closed",
xlab = "Number of status changes",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,nrow(c)))## Warning: Removed 1866 rows containing non-finite values (stat_bin).## Warning: Removed 2 rows containing missing values (geom_bar).
d <- b %>%
filter(b$n < (0.01*nrow(max_sys_mod_count))) %>%
summarise(sum(n)) *100/(nrow(max_sys_mod_count))
dDe esta manera vemos que aproximadamente el 92.5% de los incidentes tienen a lo sumo 15 cambios de estado. Cualquier otro valor por encima representa un porcentaje muy pequeño respecto al número total de incidentes.
2.2 - Número de incidentes por status del incidente
2.2.1 - Número de incidentes por status del incidente
Si analizamos los datos que nos dicen cual es el status de cada incidente obtenemos los siguientes resultados.
Al tratarse de variables categóricas, crearemos una función que nos permita ordenar los resultados de mayor a menor para un mejor análisis en este gráfico y en posteriores.
##
## -100 Active Awaiting Evidence Awaiting Problem
## 5 38716 38 461
## Awaiting User Info Awaiting Vendor Closed New
## 14642 707 24985 36407
## Resolved
## 25751reorder_size <- function(x) {
factor(x, levels = names(sort(table(x), decreasing = TRUE)))
}
ggplot(my_data, aes(x = reorder_size(`incident_state`))) +
geom_bar(fill = "#FF6666") +
xlab("Current overview of incident state") +
ggtitle("Number of incidents by state of the incident") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
## `summarise()` ungrouping output (override with `.groups` argument)##
## Closed
## 24918Los datos obtenidos aquí no dan resultados obvios a la primera y hay que analaizarlos con más detalle.
Primeramente vemos que tenemos un total 38716 de “incidentes activos” cuando en realidad solo tenemos 24918 incidentes generados. Esto es debido a que cada vez que el incidente es actualizado (cómo hemos visto anteriormente) este permanece como ACTIVE hasta que en algún momento pase a CLOSED. Por eso es perfectamente normal que haya más ACTIVE que incidentes totales, ya que cómo hemos visto anteriormente la mayoría de los incidentes han pasado por dos actualizaciones mínimo. Algo parecido pasa con el valor NEW.
Por otro lado, vemos que tenemos 24985 problemas CLOSED. Los cuales son más que los 24918 incidentes totales. Esto puede ser debido a que algunos problemas se han reabierto después de haber sido cerrados la primera vez, duplicando así el valor CLOSED en alguno de los incidentes. Lo mismo pasa con el valor RESOLVED, que es el estado justo antes de pasar a CLOSED (sólo pendiente de la evaluación final del técnico).
2.2.2 - Incidente con mayor número de cambios de status
A pesar de lo visto anteriormente no podemos olvidar de analizar porque algún incidente ha cambiado tantas veces de estado, por eso vamos a visualizar cual ha sido el incidente que ha tenido el número más elevado de actualizaciones.
my_data[my_data$number %in% max_sys_mod_count[which.max(max_sys_mod_count$`max(sys_mod_count)`),] ,]De la observación anterior podemos ver que este incidente se encalló esperando información por parte del cliente así como evidencias del problema. Se podría intentar hablar con el equipo SAC para ver los detalles del caso y quizás tomar algún tipo de iniciativa de cara a futuros incidentes similares. Por ejemplo, si no responde en máximo X días, el incidente se dará por cerrado.
2.3 - Número de incidentes creado por cliente
A continuación vamos a representar un histograma con el número total de incidentes creados por cliente.
calls_by_customer <- my_data %>%
group_by(number) %>%
summarise_all(last) %>%
group_by(fe_caller_id) %>%
count(fe_caller_id, name = "n_incidents")
calls_by_customer <- calls_by_customer[order(-calls_by_customer$n_incidents),]
calls_by_customerqplot(calls_by_customer$n_incidents,
geom="histogram",
binwidth = 1,
main = "Number of indicents by customer",
xlab = "Number of incidents",
ylab = "Number of customers",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
vector_max_n_incidents <- as.vector(calls_by_customer$n_incidents)
a <- rle(sort(vector_max_n_incidents))
b <- data.frame(number=a$values, n=a$lengths)
bObservamos que la mayoría de clientes han realizado o abierto un sólo incidente. Incluso alguno más pero los valores decaen rápidamente.
Por otro lado, podemos ver que el cliente “1904” ha abierto un total de 438 incidentes. El cliente “290” un total de 258 incidentes. Y el cliente “4514” un total de 130 incidentes. Podríamos intentar a través de SAC, contactar con estos clientes para ver porque se desvían tanto respecto a la media de incidentes, ya que podemos ver que a continuación los siguientes clientes tan sólo han abierto una cincuantena de incidentes.
2.4 - Número de incidentes por código de cierre
A continuación vamos a representar el número total de incidentes pero agrupados por el código de cierre. Veremos como la mayoría se han cerrado con el código “6” con mucha diferencia respecto al segundo y tercero que serían los códigos “7” y “9”.
Esta información podríamos transmitírsela a nuestro cliente para que entendiera la tipología de la mayoría de los incidentes creados y cómo han sido resueltos.
##
## 1 2 3 4 5 6 7 8 9 10 11 12 13
## 3265 349 608 1139 4469 86583 20733 5646 13562 1678 1493 13 59
## 14 15 16 17
## 12 183 1091 115ggplot(my_data, aes(x = `fe_closed_code`)) +
geom_bar(fill = "#FF6666") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
xlab("Resolution code") +
ylab("Number of incidents") +
ggtitle("Number of incidents by resolution code")## Warning: Removed 714 rows containing non-finite values (stat_count).
2.5 - Número de incidentes por notificación al cierre
Si analizamos los incidentes por aquellos que se han notificado al cierre y los que no, veremos que la gran mayoría de incidentes no han sido notificados.
En unos pocos se envío un email al usuario que había abierto el incidente, pero son muy pocos.
Quizás nuestro cliente podría tomar acciones ante estos resultados o eliminar estos datos del dataframe ya que aportan poca información actualmente.
##
## Do Not Notify Send Email
## 141593 119ggplot(my_data, aes(x = `notify`)) +
geom_bar(fill = "#FF6666") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
xlab("Notification system used") +
ylab("Number of incidents") +
ggtitle("Number of incidents by notification system used")
2.6 - Número de incidentes por canal de contacto del usuario al reportar el incidente
Si analizamos los incidentes por la tipología del sistema de contacto usado por los usuarios al reportar el incidente, veremos que la casi totalidad de ellos han sido reportados por vía telefónica. Las otras vías de contacto, han sido todas usadas alguna vez pero en un número tna bajo que las hacen prácticamente despreciables.
##
## Direct opening Email IVR Phone Self service
## 17 220 18 140462 995ggplot(my_data, aes(x = reorder_size(`contact_type`))) +
geom_bar(fill = "#FF6666") +
xlab("Type of contact with customer") +
ylab("Number of incidents") +
ggtitle("Number of incidents by contact type used by the user to report") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
2.7 - Número de incidentes por Service Level Agreement reachment
Si representamos la cantidad de veces que hemos alcanzado el nivel de calidad exigido por el cliente, veremos que hemos sido bastante exitosos ya que la mayoría de las veces hemos alcanzado el nivel esperado.
##
## FALSE TRUE
## 9215 132497ggplot(my_data, aes(x = `made_sla`)) +
geom_bar(fill = "#FF6666") +
xlab("Achieved SLA target") +
ggtitle("Number of incidents by achievement of SLA target") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
2.8 - Número de incidentes por categoría y subcategoría de clasificación del incidente
##
## 2 3 4 5 6 7 8 9 10 12 13 14 15
## 77 1 22 31 7 207 264 7365 24 3 994 5 3
## 16 17 19 20 21 22 23 24 25 26 27 28 29
## 7 512 1592 5506 69 420 7779 4561 30 18453 2 2256 32
## 30 31 32 33 34 35 36 37 38 40 41 42 43
## 15 92 7273 160 3946 2037 2 6584 290 3760 36 15977 858
## 44 45 46 47 48 49 50 51 52 53 54 55 56
## 1798 3619 13324 50 10 2 93 2390 16 15968 139 801 322
## 57 58 59 61 62 63
## 6532 5 42 5168 25 78ggplot(my_data, aes(x = `fe_category`)) +
geom_bar(fill = "#FF6666") +
xlab("Category of incident") +
ggtitle("Number of incidents by type of category description") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))## Warning: Removed 78 rows containing non-finite values (stat_count).
##
## 2 3 4 6 8 9 10 11 12 13 14 16 17
## 7 1788 140 199 2 4124 54 12 17 174 4 772 38
## 18 20 22 23 24 25 28 29 30 31 32 33 34
## 12 155 6 62 6 202 1565 1003 127 973 9 29 31
## 35 36 37 40 42 43 44 45 46 47 48 50 51
## 5 2917 15 88 69 1674 1149 77 49 186 16 68 13
## 52 53 54 56 57 59 60 62 64 65 66 67 68
## 18 27 324 15 92 250 263 5 225 80 16 19 73
## 69 71 72 74 75 77 78 80 82 83 84 85 86
## 439 5 157 51 2113 34 45 611 628 17 3 23 250
## 87 88 89 90 92 94 95 96 97 99 100 101 102
## 4 624 112 178 72 720 3 49 4 38 13 104 27
## 103 104 105 106 107 109 110 111 112 113 114 115 116
## 1517 12 246 180 461 34 252 21 501 118 1546 21 2
## 117 118 119 120 122 123 124 125 126 127 128 129 130
## 509 71 13 95 12 1425 2 1947 23 288 3 19 360
## 131 132 134 135 136 138 140 141 142 144 145 146 149
## 4 163 675 3467 3 30 7 3 18 48 331 409 6
## 150 151 152 153 154 155 156 157 158 159 160 161 162
## 1659 227 9 413 1170 12 35 2 62 301 3 20 51
## 163 164 165 166 167 168 169 170 171 172 173 174 175
## 897 7880 3 32 75 635 14 3349 204 38 6 35785 10496
## 176 177 178 179 181 182 183 184 185 186 187 188 189
## 57 363 186 1 122 152 323 391 761 14 6 5 181
## 191 192 193 194 195 196 197 198 199 200 202 203 204
## 376 19 10 57 11 6 43 85 29 792 659 25 7
## 205 207 208 209 210 211 212 213 215 216 217 218 219
## 26 18 150 31 32 4 12 11 356 10 14 106 56
## 220 222 223 224 225 226 227 228 229 230 231 232 233
## 702 15 15598 492 32 26 8 248 485 39 857 24 166
## 234 235 236 237 240 241 242 243 244 245 246 247 248
## 9 21 3 15 44 1 170 157 50 47 68 196 366
## 249 250 251 252 253 254 255 256 257 258 259 260 261
## 255 152 1083 153 43 66 514 38 98 172 422 98 121
## 262 264 269 270 271 273 274 275 276 277 279 280 281
## 30 1 41 376 285 24 10 3643 7 274 10 5 137
## 282 283 284 285 287 288 289 291 292 294 295 296 298
## 16 48 1 216 33 9 267 20 34 71 13 21 5
## 299 300 301 302 303 304 305
## 30 930 218 627 1558 8 284ggplot(my_data, aes(x = `fe_subcategory`)) +
geom_bar(fill = "#FF6666") +
xlab("Sub-Category of incident") +
ggtitle("Number of incidents by type of sub-category description") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))## Warning: Removed 111 rows containing non-finite values (stat_count).
2.9 - Número de incidentes por uso de la base de conocimiento interna
Vemos que la mayoría de las veces no ha sido necesaria usar la base de conocimiento interno
##
## FALSE TRUE
## 116349 25363ggplot(my_data, aes(x = `knowledge`)) +
geom_bar(fill = "#FF6666") +
xlab("Usage of knowledge base") +
ggtitle("Number of incidents resolved using knowledge base available") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
2.10 - Número de incidentes por número de veces que se ha reabierto el problema
Vemos que la mayoría de las veces que se ha dado el problema por cerrado
##
## 0 1 2 3 4 5 6 7 8
## 139398 1918 190 107 48 24 18 5 4ggplot(my_data, aes(x = `reopen_count`)) +
geom_bar(fill = "#FF6666") +
xlab("Status if reopened") +
ggtitle("Number of incidents requested to be reopen due to no satisfaction from customer") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
2.11 - Número de incidentes por impacto / urgencia / prioridad
##
## 1 2 3
## 3491 134335 3886ggplot(my_data, aes(x = `fe_impact`)) +
geom_bar(fill = "#FF6666") +
xlab("Impact Status") +
ggtitle("Number of incidents by impact of the incident") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
##
## 1 2 3
## 4020 134094 3598ggplot(my_data, aes(x = `fe_urgency`)) +
geom_bar(fill = "#FF6666") +
xlab("Urgency status") +
ggtitle("Number of incidents by urgency of the incident") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
##
## 1 2 3 4
## 2258 2972 132452 4030ggplot(my_data, aes(x = `fe_priority`)) +
geom_bar(fill = "#FF6666") +
xlab("Piority status") +
ggtitle("Number of incidents by priority of the incident") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
2.12 - Intervalos entre etapas del proceso
2.12.1 - Intervalos entre etapas del proceso
A continuación vamos a calcular cuanto es el intervalo de tiempo entre cada uno de los pasos para analizar cuanto tiempo se invierte en la resolución de los incidentes y en cada uno de los pasos intermedios.
# Intervalo 1: tiempo transcurrido entre que el incidente es abierto y se crea el proceso de resolución
interval_1 <- my_data %>%
group_by(number, fe_opened_at, fe_sys_created_at) %>%
summarise()## `summarise()` regrouping output by 'number', 'fe_opened_at' (override with `.groups` argument)# Intervalo 2: tiempo transcurrido entre que se crea el proceso de resolución y se empieza a trabajar en él
interval_2 <- my_data %>%
group_by(number, fe_sys_created_at) %>%
summarise(first(fe_sys_updated_at))## `summarise()` regrouping output by 'number' (override with `.groups` argument)# Intervalo 3: tiempo transcurrido entre que se empieza a trabajar en el incidente y se da por resuelto el problema
interval_3 <- my_data %>%
group_by(number, fe_resolved_at) %>%
summarise(first(fe_sys_updated_at))## `summarise()` regrouping output by 'number' (override with `.groups` argument)# Intervalo 4: tiempo transcurrido entre que se da por resuelto el incidente y se cierra el mismo
interval_4 <- my_data %>%
group_by(number, fe_resolved_at, fe_closed_at) %>%
summarise()## `summarise()` regrouping output by 'number', 'fe_resolved_at' (override with `.groups` argument)# Intervalo total: tiempo transcurrido en total por incidente entre que se abre en el sistema y se acaba dando por cerrado
interval_total <- my_data %>%
group_by(number, fe_opened_at, fe_closed_at) %>%
summarise() ## `summarise()` regrouping output by 'number', 'fe_opened_at' (override with `.groups` argument)## `summarise()` ungrouping output (override with `.groups` argument)intervals$interval_1 <- interval(interval_1$fe_opened_at, interval_1$fe_sys_created_at)
intervals$interval_1 <- as.period(intervals$interval_1, unit = "day")
intervals$interval_2 <- interval(interval_2$fe_sys_created_at, interval_2$`first(fe_sys_updated_at)`)
intervals$interval_2 <- as.period(intervals$interval_2, unit = "day")
intervals$interval_3 <- interval(interval_3$`first(fe_sys_updated_at)`, interval_3$fe_resolved_at)
intervals$interval_3 <- as.period(intervals$interval_3, unit = "day")
intervals$interval_4 <- interval(interval_4$fe_resolved_at, interval_4$fe_closed_at)
intervals$interval_4 <- as.period(intervals$interval_4, unit = "day")
intervals$interval_total <- interval(interval_total$fe_opened_at, interval_total$fe_closed_at)
intervals$interval_total <- as.period(intervals$interval_total, unit = "day")
intervalsVemos que algunos valores presentan NA’s, por eso recuperamos la función “inspect NA” sobre esta tabla de intervalos para un análisis más rápido
Vemos que las dos primeras variables, presentan alrededor de un 50% de valores NA. Si recuperamos los valores obtenidos en el EDA, veremos que hay una variable llamada “fe_sys_created_at” con casi un 40% de NA’s entre sus valores. Esta variable es usada en el cálculo de los dos primeros intérvalos y de ahí que tengamos tantos valores NA. Deberíamos revisar con los responsables del procesos porque no se está rellenando este campo correctamente.
Además vemos que la variable “fe_sys_created_at” muchas veces coincide con “fe_sys_updated_at” dando valores para el intervalo de 0s, lo cual no aporta ninguna información.
Por eso volvemos a calcular los intérvalos, saltándonos este paso y obteniendo ahora sí unos intervalos claros para la mayoría de casos.
# Intervalo 1_2: tiempo transcurrido entre que el incidente es abierto y se empieza a trabajar en él (contiene el tiempo usado hasta que se crea el proceso de resolución)
interval_1_2 <- my_data %>%
group_by(number, fe_opened_at) %>%
summarise(first(fe_sys_updated_at))## `summarise()` regrouping output by 'number' (override with `.groups` argument)# Intervalo 3: tiempo transcurrido entre que se empieza a trabajar en el incidente y se da por resuelto el problema
interval_3 <- my_data %>%
group_by(number, fe_resolved_at) %>%
summarise(first(fe_sys_updated_at))## `summarise()` regrouping output by 'number' (override with `.groups` argument)# Intervalo 4: tiempo transcurrido entre que se da por resuelto el incidente y se cierra el mismo
interval_4 <- my_data %>%
group_by(number, fe_resolved_at, fe_closed_at) %>%
summarise()## `summarise()` regrouping output by 'number', 'fe_resolved_at' (override with `.groups` argument)# Intervalo total: tiempo transcurrido en total por incidente entre que se abre en el sistema y se acaba dando por cerrado
interval_total <- my_data %>%
group_by(number, fe_opened_at, fe_closed_at) %>%
summarise() ## `summarise()` regrouping output by 'number', 'fe_opened_at' (override with `.groups` argument)## `summarise()` ungrouping output (override with `.groups` argument)intervals$interval_1_2 <- interval(interval_1_2$fe_opened_at, interval_1_2$`first(fe_sys_updated_at)`)
intervals$interval_1_2 <- as.period(intervals$interval_1_2, unit = "day")
intervals$interval_3 <- interval(interval_3$`first(fe_sys_updated_at)`, interval_3$fe_resolved_at)
intervals$interval_3 <- as.period(intervals$interval_3, unit = "day")
intervals$interval_4 <- interval(interval_4$fe_resolved_at, interval_4$fe_closed_at)
intervals$interval_4 <- as.period(intervals$interval_4, unit = "day")
intervals$interval_total <- interval(interval_total$fe_opened_at, interval_total$fe_closed_at)
intervals$interval_total <- as.period(intervals$interval_total, unit = "day")
intervals
Vemos que seguimos teniendo bastantes valores NA, pero ahora son menos y no molestan tanto a nuestro estudio como para dejarlo los datos y seguir en este estado.
Si representamos en un histograma el tiempo invertido total para resolver un problema obtenemos el siguiente histograma.
Además podemos extraer la media y la mediana para el intervalo total de resolución y comprender mejor así el histograma.
qplot(as.duration(intervals$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem solving",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,100))## Warning: Removed 319 rows containing non-finite values (stat_bin).## Warning: Removed 2 rows containing missing values (geom_bar).
## [1] 13.13869## [1] 6.0777782.12.2 - Intervalos entre etapa del proceso cruzado con códigos de cierre
Ahora vamos a visualizar el mismo histograma que anteriormente acerca de cuanto tiempo ha pasado entre la fecha de apertura de un incidente y su fecha de cierre, pero cruzándolo con los códigos de cierre por incidente. se ha intentado representar todo de una solo vez mediante la función faced grid pero al haber tantos códigos de cierre, la visualización era muy mala, por eso se ha preferido; de una forma quizás más enfarragosa; representarlos individualmente para un mejor análisis y representación.
De esta manera vamos a intentar ver si quizás ha habido alguna tipología de incidente que haya podido provocar mayores desviaciones en los tiempos de resolución que otras tipologías.
interval_close_code <- my_data %>%
group_by(number, fe_closed_code) %>%
summarise() %>%
select(fe_closed_code)## `summarise()` regrouping output by 'number' (override with `.groups` argument)## Adding missing grouping variables: `number`interval_close_code$number <- NULL
interval_close_code$interval_total <- intervals$interval_total
interval_close_code_1 <- interval_close_code %>%
filter(fe_closed_code == 1)
interval_close_code_2 <- interval_close_code %>%
filter(fe_closed_code == 2)
interval_close_code_3 <- interval_close_code %>%
filter(fe_closed_code == 3)
interval_close_code_4 <- interval_close_code %>%
filter(fe_closed_code == 4)
interval_close_code_5 <- interval_close_code %>%
filter(fe_closed_code == 5)
interval_close_code_6 <- interval_close_code %>%
filter(fe_closed_code == 6)
interval_close_code_7 <- interval_close_code %>%
filter(fe_closed_code == 7)
interval_close_code_8 <- interval_close_code %>%
filter(fe_closed_code == 8)
interval_close_code_9 <- interval_close_code %>%
filter(fe_closed_code == 9)
interval_close_code_10 <- interval_close_code %>%
filter(fe_closed_code == 10)
interval_close_code_11 <- interval_close_code %>%
filter(fe_closed_code == 11)
interval_close_code_12 <- interval_close_code %>%
filter(fe_closed_code == 12)
interval_close_code_13 <- interval_close_code %>%
filter(fe_closed_code == 13)
interval_close_code_14 <- interval_close_code %>%
filter(fe_closed_code == 14)
interval_close_code_15 <- interval_close_code %>%
filter(fe_closed_code == 15)
interval_close_code_16 <- interval_close_code %>%
filter(fe_closed_code == 16)
interval_close_code_17 <- interval_close_code %>%
filter(fe_closed_code == 17)
qplot(as.duration(interval_close_code_1$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 1",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_2$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 2",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_3$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 3",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_4$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 4",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_5$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 5",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_6$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 6",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_7$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 7",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_8$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 8",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_9$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 9",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_10$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 10",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_11$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 11",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_12$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 12",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_13$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 13",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_14$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 14",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_15$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 15",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_16$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 16",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_close_code_17$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem - Clossing code 17",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
Vemos comportamientos similares en la mayoría de ellos, con valores mucho más leevados en los códigos de cierre “6” y “7” como ya era de esperar. Ahora bien si que es verdad que vemos comportamientos anómalos en los códigos de cierre “12”/“13”/“14”/“15”/“17” pero en ninguno de ellos tenemos valores muy altos de incidentes acumulados, em algunos incluso un solo incidente, lo cual probablemente sea la explicación de este comportamiento anómalo al no tener población suficiente como para un estudio más generalizado.
2.12.3 - Tiempo invertido en la resolución por código de cierre
Anteriormente hemos sacado un gráfico con la tipología de los problemas por código de cierre. Hemos visto que la mayoría de problemas se cerraban con el código “6”, por eso ahora vamos a representar el tiempo total invertido en cada uno de los códigos de cierre y donde esperamos un comportamiento similar si tuviéramos en cuenta que la tipología de problemas no alarga ni acorta en exceso el tiempo invertido en resolverlo.
Para poder realizar este gráfico, hemos tenido que reemplazar los NA’s que anteriormente hemos visto que existían por los valores medios de los tiempos invertidos.
time_by_close_code <- my_data %>%
group_by(number) %>%
summarise_all(last) %>%
select(fe_closed_code)
time_by_close_code$interval_total <- as.period(intervals$interval_total, unit = "hour")
time_by_close_code <- time_by_close_code %>%
mutate(new = as.duration(hms(interval_total))) %>%
group_by(fe_closed_code) ## Warning: Problem with `mutate()` input `new`.
## x Some strings failed to parse, or all strings are NAs
## i Input `new` is `as.duration(hms(interval_total))`.## Warning in .parse_hms(..., order = "HMS", quiet = quiet): Some strings failed to
## parse, or all strings are NAsx_num_mean <- mean(time_by_close_code$new, na.rm = TRUE) # Calculate mean
time_by_close_code$new[is.na(time_by_close_code$new)] <- x_num_mean # Replace by mean
time_by_close_code$interval_total <- NULL
time_by_close_code_sum <- time_by_close_code %>%
summarise(sum(new))## `summarise()` ungrouping output (override with `.groups` argument) #mutate(sum_times = seconds_to_period(sum_times))
time_by_close_code_sum <- time_by_close_code_sum[-c(18), ]
time_by_close_code_sumDe los resultados se observa un comportamiento muy similar en todos ellos, con el tiempo mediano de resolución en valores muy aproximados independientemente de la tipología del problema o del código de cierre usado para ello.
2.12.4 - Intervalos entre etapa del proceso cruzado con localizaciones de los incidentes
Si intentáramos realizar lo mismo que en el gráfico anterior pero cruzándolo con las distintas localizaciones de nuestros clientes (algunos de ellos tienen más de una localización a la que debemos dar soporte), debido a la gran cantidad de lcoalizaciones en el data set, sería nuevamente imposible visualizar nada.
Por eso vamos a visualizar en una lista ordenada cuales son aquellas localizaciones donde hemos invertido más tiempo en resolver problemas y después procederemos a realizar unos histogramas para cada una de estas localizaciones (similares a los anteriores) con el fin de observar algún comportamiento anómalo.
Vemos cuánto ha sido el tiempo total (en segundos) invertido por localización.
time_by_location <- my_data %>%
group_by(number) %>%
summarise_all(last) %>%
select(fe_location)
time_by_location$interval_total <- as.period(intervals$interval_total, unit = "hour")
time_by_location <- time_by_location %>%
mutate(new = as.duration(hms(interval_total))) %>%
group_by(fe_location) ## Warning: Problem with `mutate()` input `new`.
## x Some strings failed to parse, or all strings are NAs
## i Input `new` is `as.duration(hms(interval_total))`.## Warning in .parse_hms(..., order = "HMS", quiet = quiet): Some strings failed to
## parse, or all strings are NAsx_num_mean <- mean(time_by_location$new, na.rm = TRUE) # Calculate mean
time_by_location$new[is.na(time_by_location$new)] <- x_num_mean # Replca by mean
time_by_location <- time_by_location %>%
summarise(sum(new)) %>%
arrange(-`sum(new)`)## `summarise()` ungrouping output (override with `.groups` argument)Con eso. filtramos las tres primeras posiciones y representamos.
## `summarise()` ungrouping output (override with `.groups` argument)interval_location$number <- NULL
interval_location$interval_total <- intervals$interval_total
interval_location_1 <- interval_location %>%
filter(`last(fe_location)` == 204)
interval_location_2 <- interval_location %>%
filter(`last(fe_location)` == 161)
interval_location_3 <- interval_location %>%
filter(`last(fe_location)` == 143)
qplot(as.duration(interval_location_1$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem solving - 1st position location",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_location_2$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem solving - 2nd position location",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
qplot(as.duration(interval_location_3$interval_total) / ddays(1),
geom="histogram",
binwidth = 1,
main = "Duration of problem solving - 3rd position location",
xlab = "Time elapsed in days",
ylab = "Number of incidents",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
De los gráficos anteriores, podemos ver un comportamiento muy similar entre las tres primeras localizaciones. Además de ser un comportamiento similar al general representado anteriormente para todas ellas juntas, lo cual nos hace descartar que haya localizaciones que representen un mayor impacto en el tiempo de resolución que otras de cara a planificación de soporte en un futuro.
2.13 - Mapas de calor
2.13.1 - Mapa de calor global
A continuación podemos representar en un mapa de calor, el número de incidentes abiertos según su fecha de apertura o recepción.
Primeramente representaremos en base al año y mes de apertura.
## `summarise()` regrouping output by 'number' (override with `.groups` argument)heat_map$fe_anio <- year(heat_map$`first(fe_opened_at)`)
heat_map$fe_mes <- month(heat_map$`first(fe_opened_at)`)
heat_map$fe_dianum <- day(heat_map$`first(fe_opened_at)`)
heat_map$fe_diasem <- wday(heat_map$`first(fe_opened_at)`)
heat_map$fe_anio <- as.factor(heat_map$fe_anio)
heat_map$fe_mes <- as.factor(heat_map$fe_mes)
heat_map$fe_dianum <- as.factor(heat_map$fe_dianum)
heat_map$fe_diasem <- as.factor(heat_map$fe_diasem)
levels(heat_map$fe_mes) <- c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
ggplot((heat_map %>%
group_by(fe_anio, fe_mes) %>%
summarise(count = n_distinct(number))),
aes(fe_mes, fe_anio, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Month") + ylab("Year")+
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per month")## `summarise()` regrouping output by 'fe_anio' (override with `.groups` argument)
Como vemos, todo justo disponemos de un año entero de datos pero no de ningún año natural. En cualquier caso, vemos que al inicio de la serie temporal es cuando parece haber más incidentes en comparación con el resto de la serie.
Por eso, a continuación vamos a analizar con más detalle el año 2016.
2.13.2 - Mapa de calor 2016
ggplot((heat_map %>%
filter(fe_anio == 2016) %>%
group_by(fe_anio, fe_mes, fe_dianum) %>%
summarise(count = n_distinct(number))),
aes(fe_dianum, fe_mes, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Day") + ylab("Month")+
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per day in 2016")## `summarise()` regrouping output by 'fe_anio', 'fe_mes' (override with `.groups` argument)
Del mapa de calor anterior, observamos que en los primeros meses de los cuales disponemos fechas, son los días o semanas más calientes de todos los datos. Habiendo al menos una apertura al día y habiendo incluso algunos días muy calientes (7 de Marzo). Pero vemos como después rápidamente decae el uso de la herramienta sin conocer el factor que puede haber detrás: aburrimiento de la herramienta; ya no hay problemas por resolver, etc.
Esto deberíamos comunicárselo a nuestro cliente para que tomara las acciones que considerara pertinentes.
2.13.3 - Mapa de calor por cliente
En paralelo también vamos a analizar los mapas de calor de nuestros 3 clientes principales (en número de incidentes reportados) para observar su comportamiento respecto al del global de los datos.
ggplot((heat_map %>%
filter(fe_anio == 2016, fe_caller_id == 1904) %>%
group_by(fe_anio, fe_mes, fe_dianum) %>%
summarise(count = n_distinct(number))),
aes(fe_dianum, fe_mes, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Day") + ylab("Month") +
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per day in 2016 - 1st customer")## `summarise()` regrouping output by 'fe_anio', 'fe_mes' (override with `.groups` argument)
ggplot((heat_map %>%
filter(fe_anio == 2016, fe_caller_id == 290) %>%
group_by(fe_anio, fe_mes, fe_dianum) %>%
summarise(count = n_distinct(number))),
aes(fe_dianum, fe_mes, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Day") + ylab("Month") +
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per day in 2016 - 2nd customer")## `summarise()` regrouping output by 'fe_anio', 'fe_mes' (override with `.groups` argument)
ggplot((heat_map %>%
filter(fe_anio == 2016, fe_caller_id == 4514) %>%
group_by(fe_anio, fe_mes, fe_dianum) %>%
summarise(count = n_distinct(number))),
aes(fe_dianum, fe_mes, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Day") + ylab("Month") +
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per day in 2016 - 3rd customer")## `summarise()` regrouping output by 'fe_anio', 'fe_mes' (override with `.groups` argument)
De los 3 gráficos anteriores, no observamos ningún patrón entre ellos. Ni entre ellos ni el mapa de calor general. Con lo cual deberemos seguir indagando para averiguar que pudo suceder el día 7 de Marzo para tener ese gran número de incidentes abiertos.
Por otro lado, destacar de los gráficos anteriores que en el segundo gráfico se observa como nuestro segundo cliente en número de incidentes abiertos, reportó la gran mayoría de ellos durante los 12 primeros días de Mayo. Y después prácticamente no volvió a reportar ninguno. A través de nuestro SAC podríamos averiguar que pasó con este cliente para ver si podemos ayudarle en un futuro a no tener estos problemas.
Del tercer gráfico vemos también un comportamiento concentrado en pocos días y con un poco caliente el día 20 de Abril, con casi 4 veces más llamadas que ningún otro día. Podríamos tomar acciones parecidas a las comentadas para el anterior cliente.
Y del primer cliente, es del que destacaríamos quizás el comportamiento más homogéneo pero también concentrado un poco más a finales de Marzo, pero nunca llegando a puntos tan calientes como con los otros clientes.
2.14 - Análisis 7 de Marzo 2016
De los gráficos anteriores, hemos observado un punto muy caliente el día 07 de marzo de 2016. Por eso vamos a analizar con detalle que pudo haber sucedido ese día.
2.14.1 - Análisis 7 de Marzo 2016
Primeramente, vamos a agrupar todos los datos por número de incidente ocurridos en ese día y mostrando la última linea de cada uno de ellos donde se resume toda la información de lo ocurrido en cada uno de esos incidentes.
siete_Marzo <- my_data
siete_Marzo$fe_anio <- year(siete_Marzo$fe_opened_at)
siete_Marzo$fe_mes <- month(siete_Marzo$fe_opened_at)
siete_Marzo$fe_dianum <- day(siete_Marzo$fe_opened_at)
siete_Marzo <- siete_Marzo %>%
filter(fe_anio == 2016) %>%
filter(fe_mes == 3) %>%
filter(fe_dianum == 7) %>%
group_by(number) %>%
summarise_all(last)
siete_MarzoDel análisis anterior podemos ver que efectivamente ese día se crearon un total de 607 incidentes. Vamos a dividirlo por cliente a ver si es que alguno de nuestros clientes quizás tuvo un problema específico.
2.14.2 - Análisis 7 de Marzo 2016 por cliente
calls_by_customer_7_marzo <- siete_Marzo %>%
group_by(fe_caller_id) %>%
count(fe_caller_id, name = "n_incidents")
calls_by_customer_7_marzo <- calls_by_customer_7_marzo[order(-calls_by_customer_7_marzo$n_incidents),]
calls_by_customer_7_marzoqplot(calls_by_customer_7_marzo$n_incidents,
geom="histogram",
binwidth = 1,
main = "Number of indicents by customer",
xlab = "Number of incidents",
ylab = "Number of customers",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
De este análisis observamos que la mayoría de clientes abrieron sólo una solicitud durante ese día, algunos dos solicitudes y unos pocos tres y menos aún hasta 5. Lo cual indica que no fue un problema único sino global y que se debió extender en el tiempo, pero no de forma repetida sino única ya que no hay muchos clientes que abrieron más de una. Ahora realizaremos un análisis similar por localizaciones para ver si quizás se debió a algún problema local en la infraestructura.
2.14.3 - Análisis 7 de Marzo 2016 por localizacion
calls_by_location_7_marzo <- siete_Marzo %>%
group_by(fe_location) %>%
count(fe_location, name = "n_incidents")
calls_by_location_7_marzo <- calls_by_location_7_marzo[order(-calls_by_location_7_marzo$n_incidents),]
calls_by_location_7_marzoqplot(calls_by_location_7_marzo$n_incidents,
geom="histogram",
binwidth = 1,
main = "Number of indicents by location",
xlab = "Number of incidents",
ylab = "Number of customers",
fill=I("blue"),
col=I("red"),
alpha=I(.2),
xlim=c(0,NA))## Warning: Removed 1 rows containing missing values (geom_bar).
De este análisis, observamos que hubo sobretodo dos localizaciones (la 204 y la 143) donde se reportaron más veces estos incidentes. Aunque hubo muchas más localizaciones, pero esas dos fueron los focos más calientes. Habría que investigar porque eso sucedió: quizás un fallo en el infraestructura, quizás más trabajadores en esas localizaciones que en otras.
2.14.4 - Análisis 7 de Marzo 2016 - Mapa de calor horario
Vamos a intentar analizar el problema ocurrido el 7 de marzo mediante un mapa de calor de las incidencias abiertas por hora a lo largo dle día.
siete_Marzo$fe_hora <- hour(siete_Marzo$fe_opened_at)
siete_Marzo$fe_hora <- as.factor(siete_Marzo$fe_hora)
ggplot((siete_Marzo %>%
group_by(fe_dianum, fe_hora) %>%
summarise(count = n_distinct(number))),
aes(fe_hora, fe_dianum, fill = count)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name="Total Calls") +
xlab("Hour") + ylab("7th march")+
theme(plot.title = element_text(face = "bold",
size = rel(1.4)), axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_equal() + labs(title="Total number of incidents per hour on 7th March 2016")## `summarise()` regrouping output by 'fe_dianum' (override with `.groups` argument)
2.14.5 - Análisis 7 de Marzo 2016 - Número de incidentes por impacto / urgencia / prioridad
##
## 1 2 3
## 8 570 29ggplot(siete_Marzo, aes(x = `fe_impact`)) +
geom_bar(fill = "#FF6666") +
xlab("Impact Status") +
ggtitle("Number of incidents by impact of the incident - 7th march") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
##
## 1 2 3
## 8 573 26ggplot(siete_Marzo, aes(x = `fe_urgency`)) +
geom_bar(fill = "#FF6666") +
xlab("Urgency status") +
ggtitle("Number of incidents by urgency of the incident - 7th march") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
##
## 1 2 3 4
## 4 8 566 29ggplot(siete_Marzo, aes(x = `fe_priority`)) +
geom_bar(fill = "#FF6666") +
xlab("Piority status") +
ggtitle("Number of incidents by priority of the incident - 7th march") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Efectivamente vemos que es un problema que empieza a aparecer a primera hora de la mañana, cuando nuestros clientes tomaron la actividad y se extiende a lo largo de la mañana así como se deberieon dar cuenta del problema y fueron reportándolo sistemáticamente. Después una vez reportado, el número de incidencias va disminuyendo aunque vemos que algún cliente aún lo estaba reportando a última hora d ela jornada (quizás pueda deberse a algún desfase horario entre lcoalizaciones).
Con esta información, quizás nuestro cliente podría encontrar en que falló en el sistema para que hubiera este pico de incidencias a lo largo dle día proveniente de distintas lcoalizaciones y clientas, lo cual confirma que fue un problema que afectó a toda nuestra red.
3 - Modelos de predicción
Vamos a realizar varios modelos de predicción sobre nuestros datos. Intentaremos compararlos entre ellos y sacar conclusiones de todo ello.
La variable que nos interesa predecir primeramente es el tiempo total de resolución de un problema, de esta manera podríamos estimar mejor cargas de trabajo en función de posibles escenarios por tipo de cliente, localización, etc. derivados de nuevas implantaciones de nuestro producto por ejemplo.
3.1 - Modelo Ranger
Primeramente vamos a ejecutar un modelo Ranger que tan buenos resultados nos ha dado en otros análisis y prácticas del master, pero antes completaremos los datos y los trabajaremos más para una correcta ejecución del modelo.
3.1.1 - Completado y transformación de datos
Empezaremos rellenando aquellos campos con NA’s ya que siempre ayuda a una mejor definición del modelo Ranger (aunque este modelo a diferencia de otros sea capaz de entenderlos y procesarlos como posibles soluciones). Asignaremos la variable dummy (99999) en aquellos campos que tengan datos sin imputar ya que este factor no se ha usado para completar ninguna de las variables.
to_ranger <- my_data
to_ranger$fe_assigned_group[is.na(to_ranger$fe_assigned_group)] = 99999
to_ranger$fe_assigned_to[is.na(to_ranger$fe_assigned_to)] = 99999
to_ranger$fe_user_symptom[is.na(to_ranger$fe_user_symptom)] = 99999
to_ranger$fe_sys_created_by[is.na(to_ranger$fe_sys_created_by)] = 99999
to_ranger$fe_opened_by[is.na(to_ranger$fe_opened_by)] = 99999
to_ranger$fe_closed_code[is.na(to_ranger$fe_closed_code)] = 99999
to_ranger$fe_resolved_by[is.na(to_ranger$fe_resolved_by)] = 99999
to_ranger$fe_subcategory[is.na(to_ranger$fe_subcategory)] = 99999
to_ranger$fe_category[is.na(to_ranger$fe_category)] = 99999
to_ranger$fe_location[is.na(to_ranger$fe_location)] = 99999
to_ranger$fe_caller_id[is.na(to_ranger$fe_caller_id)] = 99999
to_ranger$fe_sys_created_at <- NULL
to_ranger$fe_resolved_at <- NULL
head(to_ranger)Después sumarizaremos las series temporales, calcularemos la variable duración que es la variable que queremos estimar y la añadiremos al data frame de estudio junto con el desglose de la variable fecha de entrada (para ayudar a la predicción), eliminando otras variables sobrantes.
to_ranger <- to_ranger %>%
group_by(number) %>%
summarise_all(last)
# Extraemos horas trabajadas
to_ranger <- to_ranger %>%
mutate(duration = as.numeric(difftime(fe_closed_at, fe_opened_at, unit = 'hour')))
# Extraemos datos apertura
to_ranger$year_opened_at <- year(to_ranger$fe_opened_at)
to_ranger$month_opened_at <- month(to_ranger$fe_opened_at)
to_ranger$day_opened_at <- day(to_ranger$fe_opened_at)
# Eliminamos fechas y 2 primeras columnas que no sirven
to_ranger$fe_opened_at <- NULL
to_ranger$fe_resolved_at <- NULL
to_ranger$fe_closed_at <- NULL
to_ranger$fe_sys_created_at <- NULL
to_ranger$fe_sys_updated_at <- NULL
to_ranger$number <- NULL
to_ranger$incident_state <- NULL
head(to_ranger)3.1.2 - Lanzamiento modelo Ranger Loop1
3.1.2.1 - División data set training y test
Con estos datos podemos pasar a realizar la división de datos entre datos de entrenamiento y test para lanzar ya el modelo.
set.seed(1234)
validationIndex <- createDataPartition(to_ranger$duration, p = 0.80, list = FALSE)
ranger_train <- to_ranger[validationIndex,]## Warning: The `i` argument of ``[`()` can't be a matrix as of tibble 3.0.0.
## Convert to a vector.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.ranger_test <- to_ranger[-validationIndex,]
fit_ranger <- ranger(
duration ~. ,
data = ranger_train,
num.trees = 100,
importance = 'impurity',
write.forest = TRUE,
min.node.size = 1,
splitrule = "gini",
verbose = TRUE,
classification = TRUE
)## Growing trees.. Progress: 1%. Estimated remaining time: 1 hour, 50 minutes, 33 seconds.
## Growing trees.. Progress: 5%. Estimated remaining time: 43 minutes, 4 seconds.
## Growing trees.. Progress: 9%. Estimated remaining time: 34 minutes, 12 seconds.
## Growing trees.. Progress: 13%. Estimated remaining time: 30 minutes, 13 seconds.
## Growing trees.. Progress: 17%. Estimated remaining time: 27 minutes, 30 seconds.
## Growing trees.. Progress: 21%. Estimated remaining time: 25 minutes, 27 seconds.
## Growing trees.. Progress: 25%. Estimated remaining time: 23 minutes, 36 seconds.
## Growing trees.. Progress: 29%. Estimated remaining time: 21 minutes, 57 seconds.
## Growing trees.. Progress: 33%. Estimated remaining time: 20 minutes, 26 seconds.
## Growing trees.. Progress: 37%. Estimated remaining time: 19 minutes, 5 seconds.
## Growing trees.. Progress: 41%. Estimated remaining time: 17 minutes, 47 seconds.
## Growing trees.. Progress: 45%. Estimated remaining time: 16 minutes, 26 seconds.
## Growing trees.. Progress: 49%. Estimated remaining time: 15 minutes, 7 seconds.
## Growing trees.. Progress: 53%. Estimated remaining time: 13 minutes, 50 seconds.
## Growing trees.. Progress: 57%. Estimated remaining time: 12 minutes, 36 seconds.
## Growing trees.. Progress: 61%. Estimated remaining time: 11 minutes, 22 seconds.
## Growing trees.. Progress: 65%. Estimated remaining time: 10 minutes, 9 seconds.
## Growing trees.. Progress: 69%. Estimated remaining time: 8 minutes, 58 seconds.
## Growing trees.. Progress: 73%. Estimated remaining time: 7 minutes, 47 seconds.
## Growing trees.. Progress: 77%. Estimated remaining time: 6 minutes, 36 seconds.
## Growing trees.. Progress: 81%. Estimated remaining time: 5 minutes, 26 seconds.
## Growing trees.. Progress: 85%. Estimated remaining time: 4 minutes, 17 seconds.
## Growing trees.. Progress: 89%. Estimated remaining time: 3 minutes, 8 seconds.
## Growing trees.. Progress: 93%. Estimated remaining time: 1 minute, 59 seconds.
## Growing trees.. Progress: 97%. Estimated remaining time: 51 seconds.3.1.2.2 - Resultados modelo Ranger Loop1
Podemos analizar los resultados de nuestro modelo
## Ranger result
##
## Call:
## ranger(duration ~ ., data = ranger_train, num.trees = 100, importance = "impurity", write.forest = TRUE, min.node.size = 1, splitrule = "gini", verbose = TRUE, classification = TRUE)
##
## Type: Classification
## Number of trees: 100
## Sample size: 19935
## Number of independent variables: 26
## Mtry: 5
## Target node size: 1
## Variable importance mode: impurity
## Splitrule: gini
## OOB prediction error: 99.38 %## Length Class Mode
## predictions 19935 -none- numeric
## num.trees 1 -none- numeric
## num.independent.variables 1 -none- numeric
## mtry 1 -none- numeric
## min.node.size 1 -none- numeric
## variable.importance 26 -none- numeric
## prediction.error 1 -none- numeric
## forest 8 ranger.forest list
## confusion.matrix 59910838 table numeric
## splitrule 1 -none- character
## treetype 1 -none- character
## call 10 -none- call
## importance.mode 1 -none- character
## num.samples 1 -none- numeric
## replace 1 -none- logical3.1.2.3 - Variables importantes modelo Ranger Loop1
Podemos observar rápidamente en los resultados que parece haber un gran error en la predicción de los resultados, aún así vamos a analizarlo un poco más, empezando por representar las variables más importantes en el modelo por el orden de relevancia.
vars_imp <- fit_ranger$variable.importance
vars_imp <- as.data.frame(vars_imp)
vars_imp$myvar <- rownames(vars_imp)
vars_imp <- as.data.table(vars_imp)
setorder(vars_imp, -vars_imp)
ggbarplot(vars_imp[1:10],
x = "myvar", y = "vars_imp",
color = "blue", # Set bar border colors to white
palette = "jco", # jco journal color palett. see ?ggpar
sort.val = "asc", # Sort the value in descending order
sort.by.groups = FALSE, # Don't sort inside each group
x.text.angle = 90, # Rotate vertically x axis texts
ylab = "Importancia",
xlab = 'Variable',
rotate = TRUE,
ggtheme = theme_minimal()
)
Vemos que como era de esperar el día de apertura del incidente así como el cliente que lo abre son dos de las variables más importantes en nuestro modelo Ranger. La tercera variable sería la localización des de la que se está reportando el incidente.
Esto precisamente es lo que buscábamos en el modelo, proder predecir el tiempo de resolución en base a alguna de estas variables.
3.1.2.4 - Precisión modelo Ranger Loop1
Pero vamos a ver ahora en detalle como de preciso ha sido el modelo.
ranger_pred <- predict(fit_ranger, data = ranger_test)
Accuracy(y_pred = ranger_pred$predictions, y_true = ranger_test$duration)## [1] 0.006421834Vemos que el acierto de este modelo es de tan sólo un 0.6%. A continuación vamos a trabajar un poco más los datos previos a imputar a ver si podemos mejorar el resultado.
3.1.3 - Lanzamiento modelo Ranger Loop 2
3.1.3.1 - Ampliación transformación de datos
Las variables de tipo “lógico” las transformamos en variables de tipo factor. También eliminamos dos variables de tipo “character” que según la tabla de variables importantes vista antes ni tan siquiera aparecían en el Top10, con lo cual simplificamos un poco los dats imputados.
to_ranger2 <- to_ranger
to_ranger2$fe_made_sla <- ifelse(to_ranger2$made_sla == TRUE, 'Si', 'No')
to_ranger2$fe_made_sla <- as.factor(to_ranger2$fe_made_sla)
to_ranger2$made_sla <- NULL
to_ranger2$fe_knowledge <- ifelse(to_ranger2$knowledge == TRUE, 'Si', 'No')
to_ranger2$fe_knowledge <- as.factor(to_ranger2$fe_knowledge)
to_ranger2$knowledge <- NULL
to_ranger2$fe_u_priority_confirmation <- ifelse(to_ranger2$u_priority_confirmation == TRUE, 'Si', 'No')
to_ranger2$fe_u_priority_confirmation <- as.factor(to_ranger2$fe_u_priority_confirmation)
to_ranger2$u_priority_confirmation <- NULL
to_ranger2$notify <- NULL
to_ranger2$contact_type <- NULL
head(to_ranger2)3.1.3.2 - División data set training y test
Volvemos a dividir en los das particiones necesarias para el modelo.
set.seed(1234)
validationIndex <- createDataPartition(to_ranger2$duration, p = 0.80, list = FALSE)
ranger2_train <- to_ranger2[validationIndex,]
ranger2_test <- to_ranger2[-validationIndex,]
fit_ranger2 <- ranger(
duration ~. ,
data = ranger2_train,
num.trees = 100,
importance = 'impurity',
write.forest = TRUE,
min.node.size = 1,
splitrule = "gini",
verbose = TRUE,
classification = TRUE
)## Growing trees.. Progress: 1%. Estimated remaining time: 1 hour, 29 minutes, 6 seconds.
## Growing trees.. Progress: 5%. Estimated remaining time: 34 minutes, 12 seconds.
## Growing trees.. Progress: 9%. Estimated remaining time: 27 minutes, 38 seconds.
## Growing trees.. Progress: 13%. Estimated remaining time: 24 minutes, 18 seconds.
## Growing trees.. Progress: 17%. Estimated remaining time: 22 minutes, 7 seconds.
## Growing trees.. Progress: 21%. Estimated remaining time: 20 minutes, 37 seconds.
## Growing trees.. Progress: 25%. Estimated remaining time: 19 minutes, 21 seconds.
## Growing trees.. Progress: 29%. Estimated remaining time: 17 minutes, 57 seconds.
## Growing trees.. Progress: 33%. Estimated remaining time: 16 minutes, 47 seconds.
## Growing trees.. Progress: 37%. Estimated remaining time: 15 minutes, 39 seconds.
## Growing trees.. Progress: 41%. Estimated remaining time: 14 minutes, 33 seconds.
## Growing trees.. Progress: 45%. Estimated remaining time: 13 minutes, 29 seconds.
## Growing trees.. Progress: 49%. Estimated remaining time: 12 minutes, 24 seconds.
## Growing trees.. Progress: 53%. Estimated remaining time: 11 minutes, 21 seconds.
## Growing trees.. Progress: 57%. Estimated remaining time: 10 minutes, 22 seconds.
## Growing trees.. Progress: 61%. Estimated remaining time: 9 minutes, 20 seconds.
## Growing trees.. Progress: 65%. Estimated remaining time: 8 minutes, 20 seconds.
## Growing trees.. Progress: 69%. Estimated remaining time: 7 minutes, 23 seconds.
## Growing trees.. Progress: 73%. Estimated remaining time: 6 minutes, 25 seconds.
## Growing trees.. Progress: 77%. Estimated remaining time: 5 minutes, 28 seconds.
## Growing trees.. Progress: 81%. Estimated remaining time: 4 minutes, 31 seconds.
## Growing trees.. Progress: 85%. Estimated remaining time: 3 minutes, 34 seconds.
## Growing trees.. Progress: 89%. Estimated remaining time: 2 minutes, 37 seconds.
## Growing trees.. Progress: 93%. Estimated remaining time: 1 minute, 40 seconds.
## Growing trees.. Progress: 97%. Estimated remaining time: 43 seconds.3.1.3.3 - Resultados modelo Ranger Loop2
Volvemos a analizar los resultados
## Ranger result
##
## Call:
## ranger(duration ~ ., data = ranger2_train, num.trees = 100, importance = "impurity", write.forest = TRUE, min.node.size = 1, splitrule = "gini", verbose = TRUE, classification = TRUE)
##
## Type: Classification
## Number of trees: 100
## Sample size: 19935
## Number of independent variables: 24
## Mtry: 4
## Target node size: 1
## Variable importance mode: impurity
## Splitrule: gini
## OOB prediction error: 99.34 %## Length Class Mode
## predictions 19935 -none- numeric
## num.trees 1 -none- numeric
## num.independent.variables 1 -none- numeric
## mtry 1 -none- numeric
## min.node.size 1 -none- numeric
## variable.importance 24 -none- numeric
## prediction.error 1 -none- numeric
## forest 8 ranger.forest list
## confusion.matrix 60408296 table numeric
## splitrule 1 -none- character
## treetype 1 -none- character
## call 10 -none- call
## importance.mode 1 -none- character
## num.samples 1 -none- numeric
## replace 1 -none- logical3.1.3.4 - Variables importantes modelo Ranger Loop2
Y volvemos a analizar las variables más importantes para el modelo.
vars2_imp <- fit_ranger2$variable.importance
vars2_imp <- as.data.frame(vars2_imp)
vars2_imp$myvar <- rownames(vars2_imp)
vars2_imp <- as.data.table(vars2_imp)
setorder(vars2_imp, -vars2_imp)
ggbarplot(vars2_imp[1:10],
x = "myvar", y = "vars2_imp",
color = "blue", # Set bar border colors to white
palette = "jco", # jco journal color palett. see ?ggpar
sort.val = "asc", # Sort the value in descending order
sort.by.groups = FALSE, # Don't sort inside each group
x.text.angle = 90, # Rotate vertically x axis texts
ylab = "Importancia",
xlab = 'Variable',
rotate = TRUE,
ggtheme = theme_minimal()
)
3.1.3.5 - Precisión modelo Ranger Loop1
Finalmente volvemos a analizar la precisón del modelo después de las mejoras en los datos que hemos realizado.
ranger2_pred <- predict(fit_ranger2, data = ranger2_test)
Accuracy(y_pred = ranger2_pred$predictions, y_true = ranger2_test$duration)## [1] 0.0076259283.1.4 - Conclusiones modelo Ranger
Vemos, que a pesar de haber realizado una serie de mejoras en los datos, tan sólo hemos conseguido mejorar la precisión del modelo, del 0.6% al 0.7%. Cierto es que observando el comportamiento de las variables importantes (prácticamente idénticas para ambos loops), el modelo se comporta como esperábamos y usa las variables deseadas como variables de entrada. Pero si bien esto es cierto, tabmbién es bien cierto que el modelo tiene una precisión muy baja lo cual lo hace prácticamente inviable de implantar como modelo de producción.
Por eso, ahora analizaremos otros modelos pero al mismo tiempo vamos a cambiar la variable de entrada o incógnita a ser predicha para ver si así mejora el comportamiento general de los modelos o no.
3.2 - Modelo GLM (Generalized Linear Model)
En la web de dónde los datos han sido extraídos se recomienda usar modelos de predicción basados en regresión y clusterización. Por eso, el primer modelo que vamos a probar con la nueva variable de predicción será un modelo de regresión.
3.2.1 - Completado y transformación de datos
Primeramente completamos los datos de idéntica manera que hemos realizado en el modelo Ranger.
to_glm <- my_data
to_glm$fe_assigned_group[is.na(to_glm$fe_assigned_group)]=99999
to_glm$fe_assigned_to[is.na(to_glm$fe_assigned_to)]=99999
to_glm$fe_user_symptom[is.na(to_glm$fe_user_symptom)]=99999
to_glm$fe_sys_created_by[is.na(to_glm$fe_sys_created_by)]=99999
to_glm$fe_opened_by[is.na(to_glm$fe_opened_by)]=99999
to_glm$fe_closed_code[is.na(to_glm$fe_closed_code)]=99999
to_glm$fe_resolved_by[is.na(to_glm$fe_resolved_by)]=99999
to_glm$fe_subcategory[is.na(to_glm$fe_subcategory)]=99999
to_glm$fe_category[is.na(to_glm$fe_category)]=99999
to_glm$fe_location[is.na(to_glm$fe_location)]=99999
to_glm$fe_caller_id[is.na(to_glm$fe_caller_id)]=99999
to_glm$fe_sys_created_at <- NULL
to_glm$fe_resolved_at <- NULL
head(to_glm)Al igual que en el modelo Ranger, sumarizamos los datos, cálculamos la duración en la resolución de los incidentes y desglosamos las fechas de entrada. Añadiéndolo todo al data frame de estudio y eliminando otras columnas que no nos aportan nada durante la predicción.
to_glm <- to_glm %>%
group_by(number) %>%
summarise_all(last)
# Extraemos horas trabajadas
to_glm <- to_glm %>%
mutate(duration = as.numeric(difftime(fe_closed_at, fe_opened_at, unit = 'hour')))
# Extraemos datos apertura
to_glm$year_opened_at <- year(to_glm$fe_opened_at)
to_glm$month_opened_at <- month(to_glm$fe_opened_at)
to_glm$day_opened_at <- day(to_glm$fe_opened_at)
# Eliminamos fechas y 2 primeras columnas que no sirven
to_glm$fe_opened_at <- NULL
to_glm$fe_resolved_at <- NULL
to_glm$fe_closed_at <- NULL
to_glm$fe_sys_created_at <- NULL
to_glm$fe_sys_updated_at <- NULL
to_glm$number <- NULL
to_glm$incident_state <- NULL
head(to_glm)Transformamos una serie de variables a factor para poder trabajar con esta tipología de modelos.
to_glm$fe_made_sla <- ifelse(to_glm$made_sla == TRUE, 'Si', 'No')
to_glm$fe_made_sla <- as.factor(to_glm$fe_made_sla)
to_glm$made_sla <- NULL
to_glm$fe_knowledge <- ifelse(to_glm$knowledge == TRUE, 'Si', 'No')
to_glm$fe_knowledge <- as.factor(to_glm$fe_knowledge)
to_glm$knowledge <- NULL
to_glm$fe_u_priority_confirmation <- ifelse(to_glm$u_priority_confirmation == TRUE, 'Si', 'No')
to_glm$fe_u_priority_confirmation <- as.factor(to_glm$fe_u_priority_confirmation)
to_glm$u_priority_confirmation <- NULL
head(to_glm)En lugar de usar un one-hot encoding para las variables de tipo factor, vamos a realizar una transformación a frecuencias para poder trabajarlas mejor.
to_glm <- as.data.frame(to_glm)
to_glm <- as.data.table(to_glm)
to_glm[ , fe_contact_type := .N , by = .(contact_type)]
to_glm[ , fe_notify := .N , by = .(notify)]
to_rem <- c('contact_type', 'notify')
to_glm[ , (to_rem) := NULL]
str(to_glm)## Classes 'data.table' and 'data.frame': 24918 obs. of 27 variables:
## $ reassignment_count : num 0 1 0 0 1 1 1 6 1 1 ...
## $ reopen_count : num 0 0 0 0 0 0 0 0 0 0 ...
## $ sys_mod_count : num 4 8 6 3 7 7 8 13 3 10 ...
## $ fe_caller_id : num 2403 2403 4416 4491 3765 ...
## $ fe_sys_created_by : num 6 171 99999 81 81 ...
## $ fe_opened_by : num 8 397 8 180 180 180 131 131 24 180 ...
## $ fe_location : num 143 165 204 204 93 93 143 108 161 143 ...
## $ fe_sys_updated_by : int 908 908 908 908 908 908 908 908 908 908 ...
## $ fe_subcategory : num 170 215 125 97 168 125 168 94 185 110 ...
## $ fe_category : num 55 40 20 9 53 20 53 45 55 9 ...
## $ fe_user_symptom : num 72 471 471 450 232 ...
## $ fe_impact : int 2 2 2 2 1 2 2 2 2 2 ...
## $ fe_urgency : int 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_priority : int 3 3 3 3 2 3 3 3 3 3 ...
## $ fe_assigned_to : num 99999 89 6 125 99999 ...
## $ fe_assigned_group : num 56 24 70 25 23 23 28 33 54 28 ...
## $ fe_closed_code : num 5 5 10 3 7 7 6 1 5 1 ...
## $ fe_resolved_by : num 149 81 5 113 62 62 71 197 208 215 ...
## $ duration : num 131 149 141 174 129 ...
## $ year_opened_at : int 2016 2016 2016 2016 2016 2016 2016 2016 2016 2016 ...
## $ month_opened_at : int 2 2 2 2 2 2 2 2 2 2 ...
## $ day_opened_at : int 29 29 29 29 29 29 29 29 29 29 ...
## $ fe_made_sla : Factor w/ 2 levels "No","Si": 2 2 2 2 1 2 2 2 2 2 ...
## $ fe_knowledge : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_u_priority_confirmation: Factor w/ 2 levels "No","Si": 1 1 1 1 1 1 1 1 1 1 ...
## $ fe_contact_type : int 24688 24688 24688 24688 24688 24688 24688 24688 24688 24688 ...
## $ fe_notify : int 24882 24882 24882 24882 24882 24882 24882 24882 24882 24882 ...
## - attr(*, ".internal.selfref")=<externalptr>El principal cambio que vamos a realizar ahora, va ser cambiar el concepto de la variable a predecir. Anteriormente habíamos intentado predecir una variable que nos determinara el tiempo exacto que tardábamos en resolver un incidente. Esto ya hemos visto que no nos ha dado muy buenos resultados (muy baja precisión) en los primeros intentos.
Posiblemente pueda deberse a una falta de datos insuficientes para estimar una variable tan concreta. Por eso vamos a cambiar y vamos a intentar estimar si somos capaces de resolver un incidente en menos de 6 días (tiempo estimado, visto el análisis gráfico anterior, como tiempo promedio de resolución de un indicente.
Con ello generaremos una nueva variable tipo factor (SI / NO) que será la variable a predecir. Después de la transformación, miramos las proporciones de nuestra nueva variable de predicción para probar que no nos haya quedado muy desbalanceada ya que podría influir en el ajuste del modelo y nos podría falsear los datos de precisión del modelo.
to_glm$fe_duration <- ifelse(to_glm$duration < 144, 'Si', 'No')
res_target <- round(prop.table(table(to_glm$fe_duration))*100, 2)
library(kableExtra)##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rows| Var1 | Freq |
|---|---|
| No | 51.31 |
| Si | 48.69 |
3.2.2 - División data set training y test y lanzamiento modelo GLM
Dividimos el data set en los dos data sets de training y test necesarios para el modelo.
set.seed(1234)
validationIndex <- createDataPartition(to_glm$fe_duration, p = 0.80, list = FALSE)
glm_train <- to_glm[validationIndex,]
glm_test <- to_glm[-validationIndex,]
trainControl <- trainControl(
method = "cv",
number = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary
)
set.seed(7)
fit_glm <- train(
fe_duration~.,
data = glm_train,
method = "glm",
metric = "ROC",
trControl = trainControl
)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred3.2.3 - Resultados modelo GLM
## Generalized Linear Model
##
## 19935 samples
## 26 predictor
## 2 classes: 'No', 'Si'
##
## No pre-processing
## Resampling: Cross-Validated (3 fold)
## Summary of sample sizes: 13289, 13291, 13290
## Resampling results:
##
## ROC Sens Spec
## 0.9537597 0.8311489 0.9284016##
## Call:
## NULL
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.6998 -0.1052 0.0000 0.4658 8.4904
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.867e+03 1.039e+03 -4.686 2.79e-06 ***
## reassignment_count -8.530e-02 3.430e-02 -2.487 0.01290 *
## reopen_count -2.889e-02 3.269e-01 -0.088 0.92956
## sys_mod_count -5.024e-01 1.523e-02 -32.991 < 2e-16 ***
## fe_caller_id -4.164e-05 1.487e-05 -2.800 0.00511 **
## fe_sys_created_by 6.818e-06 5.516e-07 12.361 < 2e-16 ***
## fe_opened_by -4.214e-06 1.499e-06 -2.811 0.00494 **
## fe_location 1.107e-03 4.312e-04 2.569 0.01021 *
## fe_sys_updated_by -1.048e-03 3.211e-04 -3.262 0.00110 **
## fe_subcategory 1.534e-03 3.595e-04 4.268 1.97e-05 ***
## fe_category -2.611e-03 5.572e-04 -4.686 2.79e-06 ***
## fe_user_symptom 1.915e-06 6.085e-07 3.146 0.00165 **
## fe_impact 3.065e+00 2.471e-01 12.406 < 2e-16 ***
## fe_urgency 1.408e+00 2.343e-01 6.009 1.87e-09 ***
## fe_priority -4.990e+00 2.705e-01 -18.444 < 2e-16 ***
## fe_assigned_to -3.142e-06 1.728e-06 -1.819 0.06894 .
## fe_assigned_group -2.858e-06 9.047e-07 -3.159 0.00158 **
## fe_closed_code -9.310e-06 3.438e-06 -2.708 0.00678 **
## fe_resolved_by 2.099e-05 4.405e-06 4.766 1.88e-06 ***
## year_opened_at 2.409e+00 5.109e-01 4.715 2.42e-06 ***
## month_opened_at 3.981e-01 3.805e-02 10.462 < 2e-16 ***
## day_opened_at 1.427e-02 2.970e-03 4.806 1.54e-06 ***
## fe_made_slaSi 4.988e+00 1.582e-01 31.537 < 2e-16 ***
## fe_knowledgeSi 9.432e-01 1.312e-01 7.187 6.61e-13 ***
## fe_u_priority_confirmationSi 1.168e+00 8.142e-02 14.341 < 2e-16 ***
## fe_contact_type 9.674e-05 1.723e-05 5.613 1.98e-08 ***
## fe_notify 4.010e-04 5.368e-03 0.075 0.94045
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 27622 on 19934 degrees of freedom
## Residual deviance: 10890 on 19908 degrees of freedom
## AIC: 10944
##
## Number of Fisher Scoring iterations: 133.2.4 - Variables importantes modelo GLM
vars_imp_glm <- varImp(fit_glm)$importance
vars_imp_glm$myvar <- rownames(vars_imp_glm)
vars_imp_glm <- as.data.table(vars_imp_glm)
setorder(vars_imp_glm, -Overall)
ggbarplot(vars_imp_glm[1:10],
x = "myvar", y = "Overall",
#fill = 'myvar',
color = "blue", # Set bar border colors to white
palette = "jco", # jco journal color palett. see ?ggpar
sort.val = "asc", # Sort the value in descending order
sort.by.groups = FALSE, # Don't sort inside each group
x.text.angle = 90, # Rotate vertically x axis texts
ylab = "Importancia",
xlab = 'Variable',
#legend.title = "MPG Group",
rotate = TRUE,
ggtheme = theme_minimal()
)
3.2.5 - Precisión modelo GLM
A continuación vamos a analizar tanto el valor de precisión del modelo como la matriz de confusión.
library(e1071)
glm_pred <- predict(fit_glm, newdata = glm_test)
confusionMatrix(glm_test$fe_duration, glm_pred)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Si
## No 2137 420
## Si 215 2211
##
## Accuracy : 0.8726
## 95% CI : (0.863, 0.8817)
## No Information Rate : 0.528
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7455
##
## Mcnemar's Test P-Value : 5.703e-16
##
## Sensitivity : 0.9086
## Specificity : 0.8404
## Pos Pred Value : 0.8357
## Neg Pred Value : 0.9114
## Prevalence : 0.4720
## Detection Rate : 0.4289
## Detection Prevalence : 0.5131
## Balanced Accuracy : 0.8745
##
## 'Positive' Class : No
## 3.2.6 - Conclusiones modelo GLM
Hemos visto como cambiando la tipología de la variable a predecir hemos conseguido aumentar nuestra predicción hasta un valor alrededor del 87%. Este es un valor que para un primer loop, es mucho mejor que los valores tan bajos obtenidos anteriormente.
3.3 - Modelo GLM h2o
A continuación vamos a comparar el anterior modelo GLM, con un modelo GLM alicado directamente con el paquete H2O visto en uno de los módulos del máster y que tan buen rendimiento daban.
3.3.1 - Creación cluster h20
Lo primero es iniciar el cluster de h2o sobre el que trabajaremos ya que debemos recordar el funcionamiento de este paquete mediante la aplicación Java.
##
## ----------------------------------------------------------------------
##
## Your next step is to start H2O:
## > h2o.init()
##
## For H2O package documentation, ask for help:
## > ??h2o
##
## After starting H2O, you can use the Web UI at http://localhost:54321
## For more information visit http://docs.h2o.ai
##
## ----------------------------------------------------------------------##
## Attaching package: 'h2o'## The following objects are masked from 'package:data.table':
##
## hour, month, week, year## The following objects are masked from 'package:lubridate':
##
## day, hour, month, week, year## The following objects are masked from 'package:stats':
##
## cor, sd, var## The following objects are masked from 'package:base':
##
## %*%, %in%, &&, ||, apply, as.factor, as.numeric, colnames,
## colnames<-, ifelse, is.character, is.factor, is.numeric, log,
## log10, log1p, log2, round, signif, trunc##
## H2O is not running yet, starting it now...
##
## Note: In case of errors look at the following log files:
## C:\Users\blanch01\AppData\Local\Temp\RtmpwV6bkl\file8f986a645ecb/h2o_blanch01_started_from_r.out
## C:\Users\blanch01\AppData\Local\Temp\RtmpwV6bkl\file8f983f8c536c/h2o_blanch01_started_from_r.err
##
##
## Starting H2O JVM and connecting: . Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 4 seconds 236 milliseconds
## H2O cluster timezone: +01:00
## H2O data parsing timezone: UTC
## H2O cluster version: 3.30.1.1
## H2O cluster version age: 30 days
## H2O cluster name: H2O_started_from_R_blanch01_snc915
## H2O cluster total nodes: 1
## H2O cluster total memory: 2.00 GB
## H2O cluster total cores: 4
## H2O cluster allowed cores: 4
## H2O cluster healthy: TRUE
## H2O Connection ip: localhost
## H2O Connection port: 54321
## H2O Connection proxy: NA
## H2O Internal Security: FALSE
## H2O API Extensions: Amazon S3, Algos, AutoML, Core V3, TargetEncoder, Core V4
## R Version: R version 4.0.2 (2020-06-22)3.3.2 - Conversión a objeto h2o
Vamos a procesar el mismo data table que el anterior modelo GLM pero antes debemos transformarlo en objeto h2O para poder ser ejecutado por el paquete.
## Warning in use.package("data.table"): data.table cannot be used without R
## package bit64 version 0.9.7 or higher. Please upgrade to take advangage of
## data.table speedups.##
|
| | 0%
|
|======================================================================| 100%3.3.3 - División data set training y test y lanzamiento modelo GLM h2o
A continuacion dividimos los modelos en training y test y lanzamos el modelo de predicción GLM pero directamente en el entorno H2o.
splits <- h2o.splitFrame(
data = datIn_hex,
ratios = c(0.6,0.2),
## only need to specify 2 fractions, the 3rd is implied
destination_frames = c("train_hex", "valid_hex", "test_hex"),
seed = 1234
)
train_hex <- splits[[1]]
valid_hex <- splits[[2]]
test_hex <- splits[[3]]
y <- "fe_duration"
x <- setdiff(names(datIn_hex), y)
train_hex[, y] <- as.factor( train_hex[,y] )
nfolds <- 5
fit_glm_h2o <- h2o.glm(
x = x,
y = y,
training_frame = train_hex,
validation_frame = valid_hex,
nfolds = nfolds,
keep_cross_validation_predictions = TRUE,
seed = 7777777,
stopping_metric = 'AUC',
)## Warning in .h2o.processResponseWarnings(res): Stopping metric is ignored for _stopping_rounds=0..##
|
| | 0%
|
|========================= | 36%
|
|======================================================================| 100%3.3.4 - Resultados modelo GLM h2o
Podemos observar los resultados de este nuevo modelo
## Model Details:
## ==============
##
## H2OBinomialModel: glm
## Model ID: GLM_model_R_1599734664096_1
## GLM Model: summary
## family link regularization
## 1 binomial logit Elastic Net (alpha = 0.5, lambda = 4.304E-4 )
## number_of_predictors_total number_of_active_predictors number_of_iterations
## 1 29 29 7
## training_frame
## 1 RTMP_sid_8f7a_7
##
## Coefficients: glm coefficients
## names coefficients standardized_coefficients
## 1 Intercept -5554.899019 -2.263144
## 2 fe_made_sla.No -2.467898 -2.467898
## 3 fe_made_sla.Si 2.096138 2.096138
## 4 fe_knowledge.No -0.386888 -0.386888
## 5 fe_knowledge.Si 0.274146 0.274146
##
## ---
## names coefficients standardized_coefficients
## 25 fe_resolved_by 0.000017 0.104230
## 26 year_opened_at 2.756512 0.208238
## 27 month_opened_at 0.392903 0.383047
## 28 day_opened_at 0.004451 0.040269
## 29 fe_contact_type 0.000103 0.241610
## 30 fe_notify 0.000033 0.030289
##
## H2OBinomialMetrics: glm
## ** Reported on training data. **
##
## MSE: 0.08455696
## RMSE: 0.2907868
## LogLoss: 0.2746297
## Mean Per-Class Error: 0.1190121
## AUC: 0.9545696
## AUCPR: 0.9450776
## Gini: 0.9091392
## R^2: 0.6614614
## Residual Deviance: 8230.137
## AIC: 8290.137
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 6363 1356 0.175670 =1356/7719
## Si 453 6812 0.062354 =453/7265
## Totals 6816 8168 0.120729 =1809/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.475974 0.882784 232
## 2 max f2 0.122271 0.934516 333
## 3 max f0point5 0.760591 0.885775 133
## 4 max accuracy 0.529022 0.880139 216
## 5 max precision 0.928770 0.989353 37
## 6 max recall 0.000043 1.000000 399
## 7 max specificity 0.997278 0.999870 0
## 8 max absolute_mcc 0.475974 0.764745 232
## 9 max min_per_class_accuracy 0.637261 0.876798 181
## 10 max mean_per_class_accuracy 0.518791 0.881433 219
## 11 max tns 0.997278 7718.000000 0
## 12 max fns 0.997278 7260.000000 0
## 13 max fps 0.000043 7719.000000 399
## 14 max tps 0.000043 7265.000000 399
## 15 max tnr 0.997278 0.999870 0
## 16 max fnr 0.997278 0.999312 0
## 17 max fpr 0.000043 1.000000 399
## 18 max tpr 0.000043 1.000000 399
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: glm
## ** Reported on validation data. **
##
## MSE: 0.08381175
## RMSE: 0.2895026
## LogLoss: 0.2688792
## Mean Per-Class Error: 0.1170156
## AUC: 0.9541681
## AUCPR: 0.9448805
## Gini: 0.9083361
## R^2: 0.6646394
## Residual Deviance: 2717.293
## AIC: 2777.293
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 2169 404 0.157015 =404/2573
## Si 191 2289 0.077016 =191/2480
## Totals 2360 2693 0.117752 =595/5053
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.534579 0.884980 222
## 2 max f2 0.120590 0.938001 336
## 3 max f0point5 0.758015 0.886706 142
## 4 max accuracy 0.537403 0.882248 221
## 5 max precision 0.989487 1.000000 0
## 6 max recall 0.000378 1.000000 398
## 7 max specificity 0.989487 1.000000 0
## 8 max absolute_mcc 0.534579 0.767507 222
## 9 max min_per_class_accuracy 0.652259 0.877419 185
## 10 max mean_per_class_accuracy 0.534579 0.882984 222
## 11 max tns 0.989487 2573.000000 0
## 12 max fns 0.989487 2476.000000 0
## 13 max fps 0.000043 2573.000000 399
## 14 max tps 0.000378 2480.000000 398
## 15 max tnr 0.989487 1.000000 0
## 16 max fnr 0.989487 0.998387 0
## 17 max fpr 0.000043 1.000000 399
## 18 max tpr 0.000378 1.000000 398
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: glm
## ** Reported on cross-validation data. **
## ** 5-fold cross-validation on training data (Metrics computed for combined holdout predictions) **
##
## MSE: 0.08519051
## RMSE: 0.2918741
## LogLoss: 0.2766302
## Mean Per-Class Error: 0.1191376
## AUC: 0.9538589
## AUCPR: 0.9439595
## Gini: 0.9077179
## R^2: 0.6589248
## Residual Deviance: 8290.474
## AIC: 8346.474
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 6411 1308 0.169452 =1308/7719
## Si 500 6765 0.068823 =500/7265
## Totals 6911 8073 0.120662 =1808/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.499100 0.882123 229
## 2 max f2 0.134108 0.933823 334
## 3 max f0point5 0.761902 0.883455 131
## 4 max accuracy 0.531637 0.879605 220
## 5 max precision 0.932314 0.989071 32
## 6 max recall 0.000048 1.000000 399
## 7 max specificity 0.997437 0.999870 0
## 8 max absolute_mcc 0.499100 0.763675 229
## 9 max min_per_class_accuracy 0.636902 0.875372 183
## 10 max mean_per_class_accuracy 0.499100 0.880862 229
## 11 max tns 0.997437 7718.000000 0
## 12 max fns 0.997437 7261.000000 0
## 13 max fps 0.000048 7719.000000 399
## 14 max tps 0.000048 7265.000000 399
## 15 max tnr 0.997437 0.999870 0
## 16 max fnr 0.997437 0.999449 0
## 17 max fpr 0.000048 1.000000 399
## 18 max tpr 0.000048 1.000000 399
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## Cross-Validation Metrics Summary:
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## accuracy 0.8793874 0.0034768793 0.8828619 0.8822178 0.8747879 0.8802172
## auc 0.9538453 0.0029955332 0.95793754 0.9547117 0.9501931 0.95464194
## aucpr 0.944085 0.005813419 0.9525934 0.94726187 0.9386793 0.94231635
## err 0.1206126 0.0034768793 0.1171381 0.11778215 0.12521207 0.11978283
## err_count 361.4 9.762172 352.0 359.0 369.0 353.0
## cv_5_valid
## accuracy 0.87685215
## auc 0.9517423
## aucpr 0.93957406
## err 0.123147845
## err_count 374.0
##
## ---
## mean sd cv_1_valid cv_2_valid cv_3_valid
## precision 0.83417696 0.0073280428 0.845625 0.8327381 0.83199006
## r2 0.6588781 0.0112714125 0.66700834 0.6674052 0.64299643
## recall 0.9378229 0.01225954 0.9279835 0.9471902 0.93194443
## residual_deviance 1658.0948 43.711567 1590.0153 1647.2576 1696.2141
## rmse 0.29186013 0.0048142895 0.2884006 0.28821802 0.29867166
## specificity 0.8243802 0.011218565 0.84033614 0.821133 0.82017255
## cv_4_valid cv_5_valid
## precision 0.82545453 0.8350769
## r2 0.6661335 0.65084696
## recall 0.9544499 0.92754614
## residual_deviance 1661.0983 1695.8894
## rmse 0.288762 0.29524845
## specificity 0.8105263 0.82973323.3.5 - Variables importantes modelo GLM h2o
También podemos observar las variables importantes del modelo siguiendo nomenclatura h2o.
3.3.6 - Precisión modelo GLM h2o
Podemos usar funciones de h2o que permiten conseguir el performance.
## [1] 0.94843183.3.7 - Conclusiones modelo GLM
Hemos visto como cambiando el modelo de cálculo, a pesar de estar basado en el mismo principio de regresión, hemos conseguido aumentar nuestra predicción hasta un valor alrededor del 94%. Este ya empieza a ser un valor mucho mejor que los que hemos ido obteniendo hasta ahora.
3.4 - Modelo GBM h2o (Gradient Boosting Machine)
Vamos a continuación a lanzar un modelo GBM desde el mismo entorno h2o para compararlo con el anterior modelo GLM.
3.4.1 - División data set training y test y lanzamiento modelo GBM h2o
Usaremos los mismos datos de entrenamiento que el anterior modelo GLM, por ello no realizamos ningún pre-procesado de los datos ni división en conjuntos ya que ya ha sido realizada.
# Identify predictors and response
y <- "fe_duration"
x <- setdiff(names(datIn_hex), y)
train_hex[, y] <- as.factor( train_hex[,y] )
nfolds <- 5
fit_gbm_h2o <- h2o.gbm(
x = x,
y = y,
training_frame = train_hex,
validation_frame = valid_hex,
nfolds = nfolds,
keep_cross_validation_predictions = TRUE,
seed = 7777777,
stopping_metric = 'AUC',
verbose = FALSE ,
ntrees = 200
# max_depth = 20,
# categorical_encoding = 'Enum'
)## Warning in .h2o.processResponseWarnings(res): Stopping metric is ignored for _stopping_rounds=0..##
|
| | 0%
|
|============= | 18%
|
|================================================= | 70%
|
|=================================================== | 73%
|
|===================================================== | 75%
|
|========================================================== | 83%
|
|============================================================ | 86%
|
|============================================================== | 89%
|
|================================================================ | 92%
|
|================================================================== | 95%
|
|======================================================================| 100%3.4.2 - Resultados modelo GBM h2o
Podemos observar los resultados de este nuevo modelo
## Model Details:
## ==============
##
## H2OBinomialModel: gbm
## Model ID: GBM_model_R_1599734664096_21
## Model Summary:
## number_of_trees number_of_internal_trees model_size_in_bytes min_depth
## 1 200 200 77059 5
## max_depth mean_depth min_leaves max_leaves mean_leaves
## 1 5 5.00000 13 32 25.91000
##
##
## H2OBinomialMetrics: gbm
## ** Reported on training data. **
##
## MSE: 0.03951965
## RMSE: 0.1987955
## LogLoss: 0.1349877
## Mean Per-Class Error: 0.05113177
## AUC: 0.9910238
## AUCPR: 0.9901704
## Gini: 0.9820476
## R^2: 0.8417761
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 7259 460 0.059593 =460/7719
## Si 310 6955 0.042670 =310/7265
## Totals 7569 7415 0.051388 =770/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.532202 0.947548 212
## 2 max f2 0.335013 0.968132 273
## 3 max f0point5 0.649399 0.954662 172
## 4 max accuracy 0.532202 0.948612 212
## 5 max precision 0.998282 1.000000 0
## 6 max recall 0.074375 1.000000 357
## 7 max specificity 0.998282 1.000000 0
## 8 max absolute_mcc 0.532202 0.897372 212
## 9 max min_per_class_accuracy 0.560508 0.947921 202
## 10 max mean_per_class_accuracy 0.532202 0.948868 212
## 11 max tns 0.998282 7719.000000 0
## 12 max fns 0.998282 7209.000000 0
## 13 max fps 0.000281 7719.000000 399
## 14 max tps 0.074375 7265.000000 357
## 15 max tnr 0.998282 1.000000 0
## 16 max fnr 0.998282 0.992292 0
## 17 max fpr 0.000281 1.000000 399
## 18 max tpr 0.074375 1.000000 357
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: gbm
## ** Reported on validation data. **
##
## MSE: 0.06518979
## RMSE: 0.2553229
## LogLoss: 0.2039328
## Mean Per-Class Error: 0.09214681
## AUC: 0.9736156
## AUCPR: 0.9720576
## Gini: 0.9472312
## R^2: 0.7391525
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 2270 303 0.117761 =303/2573
## Si 165 2315 0.066532 =165/2480
## Totals 2435 2618 0.092618 =468/5053
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.459806 0.908199 232
## 2 max f2 0.141349 0.944976 329
## 3 max f0point5 0.686976 0.915627 156
## 4 max accuracy 0.528559 0.907382 213
## 5 max precision 0.998043 1.000000 0
## 6 max recall 0.008319 1.000000 384
## 7 max specificity 0.998043 1.000000 0
## 8 max absolute_mcc 0.459806 0.816104 232
## 9 max min_per_class_accuracy 0.563509 0.905558 201
## 10 max mean_per_class_accuracy 0.459806 0.907853 232
## 11 max tns 0.998043 2573.000000 0
## 12 max fns 0.998043 2457.000000 0
## 13 max fps 0.000296 2573.000000 399
## 14 max tps 0.008319 2480.000000 384
## 15 max tnr 0.998043 1.000000 0
## 16 max fnr 0.998043 0.990726 0
## 17 max fpr 0.000296 1.000000 399
## 18 max tpr 0.008319 1.000000 384
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: gbm
## ** Reported on cross-validation data. **
## ** 5-fold cross-validation on training data (Metrics computed for combined holdout predictions) **
##
## MSE: 0.06500648
## RMSE: 0.2549637
## LogLoss: 0.2028805
## Mean Per-Class Error: 0.09379826
## AUC: 0.9738078
## AUCPR: 0.9714929
## Gini: 0.9476156
## R^2: 0.7397352
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 6884 835 0.108175 =835/7719
## Si 577 6688 0.079422 =577/7265
## Totals 7461 7523 0.094234 =1412/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.501530 0.904517 217
## 2 max f2 0.129467 0.946251 339
## 3 max f0point5 0.746473 0.916628 132
## 4 max accuracy 0.532565 0.905966 207
## 5 max precision 0.998006 1.000000 0
## 6 max recall 0.014164 1.000000 383
## 7 max specificity 0.998006 1.000000 0
## 8 max absolute_mcc 0.501530 0.812037 217
## 9 max min_per_class_accuracy 0.551588 0.905162 201
## 10 max mean_per_class_accuracy 0.501530 0.906202 217
## 11 max tns 0.998006 7719.000000 0
## 12 max fns 0.998006 7156.000000 0
## 13 max fps 0.000304 7719.000000 399
## 14 max tps 0.014164 7265.000000 383
## 15 max tnr 0.998006 1.000000 0
## 16 max fnr 0.998006 0.984997 0
## 17 max fpr 0.000304 1.000000 399
## 18 max tpr 0.014164 1.000000 383
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## Cross-Validation Metrics Summary:
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## accuracy 0.90648675 0.0040933965 0.90848583 0.9117454 0.9073634 0.90329146
## auc 0.9738371 0.0028239987 0.97668326 0.9764966 0.9719789 0.97383267
## aucpr 0.9715968 0.0035141185 0.97561586 0.97393763 0.96978104 0.97198373
## err 0.09351325 0.0040933965 0.09151414 0.08825459 0.09263658 0.096708514
## err_count 280.2 12.049896 275.0 269.0 273.0 285.0
## cv_5_valid
## accuracy 0.90154755
## auc 0.97019386
## aucpr 0.96666557
## err 0.09845242
## err_count 299.0
##
## ---
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## pr_auc 0.9715968 0.0035141185 0.97561586 0.97393763 0.96978104 0.97198373
## precision 0.8887645 0.012908175 0.8755556 0.90755737 0.8961303 0.8816845
## r2 0.73968005 0.013406648 0.75140727 0.7551573 0.7326321 0.73627496
## recall 0.9229445 0.013674799 0.94581616 0.91062963 0.9166667 0.92431676
## rmse 0.2549205 0.00656036 0.24918601 0.24729024 0.25847134 0.25664294
## specificity 0.89100724 0.015134426 0.8733032 0.9127944 0.8984738 0.8835526
## cv_5_valid
## pr_auc 0.96666557
## precision 0.88289475
## r2 0.7229286
## recall 0.91729325
## rmse 0.26301202
## specificity 0.886912353.4.3 - Variables importantes modelo GBM h2o
También podemos observar las variables importantes del modelo siguiendo nomenclatura h2o.
3.4.4 - Precisión modelo GBM h2o
Podemos usar funciones de h2o que permiten conseguir el performance.
## [1] 0.97308583.4.5 - Conclusiones modelo GBM
Ahora vemos como cambiando a un modelo más complejo como es el GBM, hemos vuelto a aumentar nuestra predicción hasta un valor alrededor del 97%.
3.5 - Modelo GLM h2o factorizado
A continuación vamos a intentar mejorar los resultados de los modelos anteriores, trabajando sobre ellos los datos de entrada. Para ello vamos a convertir la mayoría de ellos a tipo factor para una mejor comprensión del modelo y ver si así aumentamos la precisión.
3.5.1 - Ampliación transformación de datos
Realizamos las modificaciones mencionadas a tipo factor de los datos.
to_glm2 <- to_glm
to_glm2$reassignment_count <- as.factor(to_glm2$reassignment_count)
to_glm2$reopen_count <- as.factor(to_glm2$reopen_count)
to_glm2$sys_mod_count <- as.factor(to_glm2$sys_mod_count)
to_glm2$fe_caller_id <- as.factor(to_glm2$fe_caller_id)
to_glm2$fe_sys_created_by <- as.factor(to_glm2$fe_sys_created_by)
to_glm2$fe_opened_by <- as.factor(to_glm2$fe_opened_by)
to_glm2$fe_location <- as.factor(to_glm2$fe_location)
to_glm2$fe_sys_updated_by <- as.factor(to_glm2$fe_sys_updated_by)
to_glm2$fe_subcategory <- as.factor(to_glm2$fe_subcategory)
to_glm2$fe_category <- as.factor(to_glm2$fe_category)
to_glm2$fe_user_symptom <- as.factor(to_glm2$fe_user_symptom)
to_glm2$reassignment_count <- as.factor(to_glm2$reassignment_count)
to_glm2$fe_impact <- as.factor(to_glm2$fe_impact)
to_glm2$fe_urgency <- as.factor(to_glm2$fe_urgency)
to_glm2$fe_priority <- as.factor(to_glm2$fe_priority)
to_glm2$fe_assigned_to <- as.factor(to_glm2$fe_assigned_to)
to_glm2$fe_assigned_group <- as.factor(to_glm2$fe_assigned_group)
to_glm2$fe_closed_code <- as.factor(to_glm2$fe_closed_code)
to_glm2$fe_resolved_by <- as.factor(to_glm2$fe_resolved_by)
to_glm2$year_opened_at <- as.factor(to_glm2$year_opened_at)
to_glm2$month_opened_at <- as.factor(to_glm2$month_opened_at)
to_glm2$day_opened_at <- as.factor(to_glm2$day_opened_at)
to_glm2$fe_contact_type <- as.factor(to_glm2$fe_contact_type)
to_glm2$fe_notify <- as.factor(to_glm2$fe_notify)
str(to_glm2)## Classes 'data.table' and 'data.frame': 24918 obs. of 27 variables:
## $ reassignment_count : Factor w/ 22 levels "0","1","2","3",..: 1 2 1 1 2 2 2 7 2 2 ...
## $ reopen_count : Factor w/ 7 levels "0","1","2","3",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ sys_mod_count : Factor w/ 103 levels "1","2","3","4",..: 4 8 6 3 7 7 8 13 3 10 ...
## $ fe_caller_id : Factor w/ 5245 levels "2","4","5","6",..: 2247 2247 4113 4175 3517 2011 2654 4952 3545 418 ...
## $ fe_sys_created_by : Factor w/ 186 levels "1","2","3","5",..: 5 132 186 66 66 66 52 52 10 66 ...
## $ fe_opened_by : Factor w/ 208 levels "2","3","4","5",..: 6 152 6 74 74 74 56 56 13 74 ...
## $ fe_location : Factor w/ 225 levels "2","3","4","5",..: 127 144 181 181 82 82 127 95 141 127 ...
## $ fe_sys_updated_by : Factor w/ 74 levels "16","20","21",..: 68 68 68 68 68 68 68 68 68 68 ...
## $ fe_subcategory : Factor w/ 246 levels "2","3","4","6",..: 133 172 95 72 131 95 131 69 146 83 ...
## $ fe_category : Factor w/ 53 levels "2","4","5","6",..: 45 32 15 7 43 15 43 36 45 7 ...
## $ fe_user_symptom : Factor w/ 398 levels "4","5","6","7",..: 42 291 291 273 122 291 374 190 398 290 ...
## $ fe_impact : Factor w/ 3 levels "1","2","3": 2 2 2 2 1 2 2 2 2 2 ...
## $ fe_urgency : Factor w/ 3 levels "1","2","3": 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_priority : Factor w/ 4 levels "1","2","3","4": 3 3 3 3 2 3 3 3 3 3 ...
## $ fe_assigned_to : Factor w/ 221 levels "2","4","5","6",..: 221 74 4 107 221 221 66 187 221 205 ...
## $ fe_assigned_group : Factor w/ 71 levels "2","3","5","6",..: 48 20 62 21 19 19 24 29 46 24 ...
## $ fe_closed_code : Factor w/ 18 levels "1","2","3","4",..: 5 5 10 3 7 7 6 1 5 1 ...
## $ fe_resolved_by : Factor w/ 217 levels "2","3","4","5",..: 138 72 4 104 57 57 64 184 194 201 ...
## $ year_opened_at : Factor w/ 2 levels "2016","2017": 1 1 1 1 1 1 1 1 1 1 ...
## $ month_opened_at : Factor w/ 12 levels "1","2","3","4",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ day_opened_at : Factor w/ 31 levels "1","2","3","4",..: 29 29 29 29 29 29 29 29 29 29 ...
## $ fe_made_sla : Factor w/ 2 levels "No","Si": 2 2 2 2 1 2 2 2 2 2 ...
## $ fe_knowledge : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_u_priority_confirmation: Factor w/ 2 levels "No","Si": 1 1 1 1 1 1 1 1 1 1 ...
## $ fe_contact_type : Factor w/ 5 levels "4","9","59","158",..: 5 5 5 5 5 5 5 5 5 5 ...
## $ fe_notify : Factor w/ 2 levels "36","24882": 2 2 2 2 2 2 2 2 2 2 ...
## $ fe_duration : Factor w/ 2 levels "No","Si": 2 1 2 1 2 2 1 1 1 1 ...
## - attr(*, ".internal.selfref")=<externalptr>3.5.2 - Conversión a objeto h2o
Vamos a procesar el nuevo data table pero antes debemos transformarlo en objeto h2O para poder ser ejecutado por el paquete como hemos realizado antes igualmente.
## Warning in use.package("data.table"): data.table cannot be used without R
## package bit64 version 0.9.7 or higher. Please upgrade to take advangage of
## data.table speedups.##
|
| | 0%
|
|======================================================================| 100%3.5.3 - División data set training y test y lanzamiento modelo GLM h2o factorizado
Con estos datos pasamos a realizar las divisiones en data sets y a lanzar el nuevo modelo
splits <- h2o.splitFrame(
data = datIn_hex2,
ratios = c(0.6,0.2),
## only need to specify 2 fractions, the 3rd is implied
destination_frames = c("train_hex", "valid_hex", "test_hex"),
seed = 1234
)
train_hex2 <- splits[[1]]
valid_hex2 <- splits[[2]]
test_hex2 <- splits[[3]]
y <- "fe_duration"
x <- setdiff(names(datIn_hex2), y)
train_hex2[, y] <- as.factor( train_hex2[,y] )
nfolds <- 5
fit_glm2_h2o <- h2o.glm(
x = x,
y = y,
training_frame = train_hex2,
validation_frame = valid_hex2,
nfolds = nfolds,
keep_cross_validation_predictions = TRUE,
seed = 7777777,
stopping_metric = 'AUC',
)## Warning in .h2o.processResponseWarnings(res): Stopping metric is ignored for _stopping_rounds=0..##
|
| | 0%
|
|======================================================================| 100%3.5.4 - Resultados modelo GLM h2o factorizado
Podemos observar los resultados de este nuevo modelo
## Model Details:
## ==============
##
## H2OBinomialModel: glm
## Model ID: GLM_model_R_1599734664096_789
## GLM Model: summary
## family link regularization
## 1 binomial logit Elastic Net (alpha = 0.5, lambda = 0.03368 )
## number_of_predictors_total number_of_active_predictors number_of_iterations
## 1 7362 8 4
## training_frame
## 1 RTMP_sid_8f7a_15
##
## Coefficients: glm coefficients
## names coefficients standardized_coefficients
## 1 Intercept -0.979514 -0.979514
## 2 fe_caller_id.10 0.000000 0.000000
## 3 fe_caller_id.1000 0.000000 0.000000
## 4 fe_caller_id.1001 0.000000 0.000000
## 5 fe_caller_id.1002 0.000000 0.000000
##
## ---
## names coefficients standardized_coefficients
## 7358 fe_u_priority_confirmation.No 0.000000 0.000000
## 7359 fe_u_priority_confirmation.Si 0.000000 0.000000
## 7360 year_opened_at.2016 0.000000 0.000000
## 7361 year_opened_at.2017 0.000000 0.000000
## 7362 fe_notify.24882 0.000000 0.000000
## 7363 fe_notify.36 0.000000 0.000000
##
## H2OBinomialMetrics: glm
## ** Reported on training data. **
##
## MSE: 0.1104257
## RMSE: 0.3323036
## LogLoss: 0.3677559
## Mean Per-Class Error: 0.1493755
## AUC: 0.9332497
## AUCPR: 0.9280269
## Gini: 0.8664994
## R^2: 0.5578915
## Residual Deviance: 11020.91
## AIC: 11038.91
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 5754 1965 0.254567 =1965/7719
## Si 321 6944 0.044184 =321/7265
## Totals 6075 8909 0.152563 =2286/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.477993 0.858662 35
## 2 max f2 0.449576 0.924673 37
## 3 max f0point5 0.686770 0.861370 15
## 4 max accuracy 0.564194 0.852710 31
## 5 max precision 0.849806 0.997381 0
## 6 max recall 0.078875 1.000000 71
## 7 max specificity 0.849806 0.999223 0
## 8 max absolute_mcc 0.477993 0.713810 35
## 9 max min_per_class_accuracy 0.564194 0.847778 31
## 10 max mean_per_class_accuracy 0.564194 0.852864 31
## 11 max tns 0.849806 7713.000000 0
## 12 max fns 0.849806 4980.000000 0
## 13 max fps 0.078875 7719.000000 71
## 14 max tps 0.078875 7265.000000 71
## 15 max tnr 0.849806 0.999223 0
## 16 max fnr 0.849806 0.685478 0
## 17 max fpr 0.078875 1.000000 71
## 18 max tpr 0.078875 1.000000 71
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: glm
## ** Reported on validation data. **
##
## MSE: 0.1078972
## RMSE: 0.3284771
## LogLoss: 0.3618529
## Mean Per-Class Error: 0.1430261
## AUC: 0.9362032
## AUCPR: 0.931224
## Gini: 0.8724064
## R^2: 0.5682649
## Residual Deviance: 3656.885
## AIC: 3674.885
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 1948 625 0.242907 =625/2573
## Si 107 2373 0.043145 =107/2480
## Totals 2055 2998 0.144864 =732/5053
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.477993 0.866375 32
## 2 max f2 0.449576 0.929754 34
## 3 max f0point5 0.686770 0.860138 14
## 4 max accuracy 0.564194 0.856917 28
## 5 max precision 0.849806 0.998693 0
## 6 max recall 0.078875 1.000000 63
## 7 max specificity 0.849806 0.999611 0
## 8 max absolute_mcc 0.477993 0.726592 32
## 9 max min_per_class_accuracy 0.564194 0.851924 28
## 10 max mean_per_class_accuracy 0.564194 0.857010 28
## 11 max tns 0.849806 2572.000000 0
## 12 max fns 0.849806 1716.000000 0
## 13 max fps 0.078875 2573.000000 63
## 14 max tps 0.078875 2480.000000 63
## 15 max tnr 0.849806 0.999611 0
## 16 max fnr 0.849806 0.691935 0
## 17 max fpr 0.078875 1.000000 63
## 18 max tpr 0.078875 1.000000 63
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: glm
## ** Reported on cross-validation data. **
## ** 5-fold cross-validation on training data (Metrics computed for combined holdout predictions) **
##
## MSE: 0.1149854
## RMSE: 0.339095
## LogLoss: 0.3833751
## Mean Per-Class Error: 0.1501852
## AUC: 0.9294349
## AUCPR: 0.9240377
## Gini: 0.8588699
## R^2: 0.5396357
## Residual Deviance: 11488.98
## AIC: 11504.98
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 5801 1918 0.248478 =1918/7719
## Si 377 6888 0.051893 =377/7265
## Totals 6178 8806 0.153163 =2295/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.489676 0.857196 126
## 2 max f2 0.468994 0.924673 138
## 3 max f0point5 0.683035 0.847593 52
## 4 max accuracy 0.489676 0.846837 126
## 5 max precision 0.827929 1.000000 0
## 6 max recall 0.096566 1.000000 245
## 7 max specificity 0.827929 1.000000 0
## 8 max absolute_mcc 0.489676 0.710319 126
## 9 max min_per_class_accuracy 0.550647 0.835926 118
## 10 max mean_per_class_accuracy 0.489676 0.849815 126
## 11 max tns 0.827929 7719.000000 0
## 12 max fns 0.827929 6839.000000 0
## 13 max fps 0.096566 7719.000000 245
## 14 max tps 0.096566 7265.000000 245
## 15 max tnr 0.827929 1.000000 0
## 16 max fnr 0.827929 0.941363 0
## 17 max fpr 0.096566 1.000000 245
## 18 max tpr 0.096566 1.000000 245
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## Cross-Validation Metrics Summary:
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## accuracy 0.8467237 0.007957915 0.85391015 0.8540026 0.8357652 0.8483203
## auc 0.93034905 0.0047104624 0.93520206 0.9343233 0.9235438 0.92861265
## aucpr 0.924991 0.0046226094 0.9308135 0.9283816 0.9195271 0.9243802
## err 0.15327634 0.007957915 0.14608985 0.14599738 0.16423482 0.15167968
## err_count 459.2 21.498837 439.0 445.0 484.0 447.0
## cv_5_valid
## accuracy 0.84162
## auc 0.93006355
## aucpr 0.92185265
## err 0.15837999
## err_count 481.0
##
## ---
## mean sd cv_1_valid cv_2_valid cv_3_valid
## precision 0.78196007 0.011279979 0.79197705 0.79452056 0.7722096
## r2 0.53954506 0.0107423095 0.54992825 0.5492048 0.52386856
## recall 0.9486689 0.0070773936 0.9478738 0.94245094 0.94166666
## residual_deviance 2297.7969 31.366013 2269.5583 2303.1238 2312.3105
## rmse 0.33910722 0.003966041 0.33528978 0.33554673 0.3449222
## specificity 0.75078696 0.01723843 0.7653523 0.7708466 0.734572
## cv_4_valid cv_5_valid
## precision 0.7816092 0.7694841
## r2 0.53897125 0.53575236
## recall 0.95304835 0.9583049
## residual_deviance 2264.1567 2339.8352
## rmse 0.3393264 0.34045097
## specificity 0.75 0.73316393.5.5 - Variables importantes modelo GLM h2o factorizado
También podemos observar las variables importantes del modelo siguiendo nomenclatura h2o.
3.5.6 - Precisión modelo GLM h2o factorizado
Podemos usar funciones de h2o que permiten conseguir el performance.
## [1] 0.93011993.5.7 - Conclusiones modelo GLM h2o factorizado
Vemos cómo con estos cambios, la precisión del modelo ha bajado un poco, del 94% al 93%. Aún así sigue siendo superior al primer modelo GLM lanzado fuera del entorno h2o.
3.6 - Modelo GBM h2o factorizado
Vamos a continuación a lanzar un modelo GBM desde el mismo entorno h2o para compararlo con el anterior modelo GLM y con el data frame factorizado del último modelo.
3.6.1 - División data set training y test y lanzamiento modelo GBM h2o factorizado
Usaremos los mismos datos de entrenamiento que el anterior modelo GLM, por ello no realizamos ningún pre-procesado de los datos ni división en conjuntos ya que ya ha sido realizada.
# Identify predictors and response
y <- "fe_duration"
x <- setdiff(names(datIn_hex2), y)
train_hex2[, y] <- as.factor( train_hex2[,y] )
nfolds <- 5
fit_gbm2_h2o <- h2o.gbm(
x = x,
y = y,
training_frame = train_hex2,
validation_frame = valid_hex2,
nfolds = nfolds,
keep_cross_validation_predictions = TRUE,
seed = 7777777,
stopping_metric = 'AUC',
verbose = FALSE ,
ntrees = 200
# max_depth = 20,
# categorical_encoding = 'Enum'
)## Warning in .h2o.processResponseWarnings(res): Stopping metric is ignored for _stopping_rounds=0..##
|
| | 0%
|
|=============================================== | 67%
|
|================================================ | 69%
|
|================================================== | 72%
|
|==================================================== | 74%
|
|====================================================== | 78%
|
|========================================================== | 83%
|
|============================================================ | 85%
|
|============================================================== | 88%
|
|================================================================ | 91%
|
|======================================================================| 100%3.6.2 - Resultados modelo GBM h2o factorizado
Podemos observar los resultados de este nuevo modelo
## Model Details:
## ==============
##
## H2OBinomialModel: gbm
## Model ID: GBM_model_R_1599734664096_809
## Model Summary:
## number_of_trees number_of_internal_trees model_size_in_bytes min_depth
## 1 200 200 185586 5
## max_depth mean_depth min_leaves max_leaves mean_leaves
## 1 5 5.00000 10 32 26.06500
##
##
## H2OBinomialMetrics: gbm
## ** Reported on training data. **
##
## MSE: 0.004250965
## RMSE: 0.06519943
## LogLoss: 0.02833834
## Mean Per-Class Error: 0.002028272
## AUC: 0.9998944
## AUCPR: 0.9998715
## Gini: 0.9997888
## R^2: 0.9829805
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 7693 26 0.003368 =26/7719
## Si 5 7260 0.000688 =5/7265
## Totals 7698 7286 0.002069 =31/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.497706 0.997870 204
## 2 max f2 0.480724 0.998817 206
## 3 max f0point5 0.623830 0.997711 187
## 4 max accuracy 0.497706 0.997931 204
## 5 max precision 0.999148 1.000000 0
## 6 max recall 0.385037 1.000000 220
## 7 max specificity 0.999148 1.000000 0
## 8 max absolute_mcc 0.497706 0.995863 204
## 9 max min_per_class_accuracy 0.576026 0.997522 194
## 10 max mean_per_class_accuracy 0.497706 0.997972 204
## 11 max tns 0.999148 7719.000000 0
## 12 max fns 0.999148 7205.000000 0
## 13 max fps 0.000137 7719.000000 399
## 14 max tps 0.385037 7265.000000 220
## 15 max tnr 0.999148 1.000000 0
## 16 max fnr 0.999148 0.991741 0
## 17 max fpr 0.000137 1.000000 399
## 18 max tpr 0.385037 1.000000 220
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: gbm
## ** Reported on validation data. **
##
## MSE: 0.06855655
## RMSE: 0.2618331
## LogLoss: 0.2292674
## Mean Per-Class Error: 0.09126992
## AUC: 0.97415
## AUCPR: 0.9728778
## Gini: 0.9483
## R^2: 0.7256809
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 2288 285 0.110766 =285/2573
## Si 178 2302 0.071774 =178/2480
## Totals 2466 2587 0.091629 =463/5053
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.398801 0.908624 230
## 2 max f2 0.046098 0.945310 354
## 3 max f0point5 0.842469 0.921830 105
## 4 max accuracy 0.398801 0.908371 230
## 5 max precision 0.999012 1.000000 0
## 6 max recall 0.000116 1.000000 399
## 7 max specificity 0.999012 1.000000 0
## 8 max absolute_mcc 0.398801 0.817556 230
## 9 max min_per_class_accuracy 0.515528 0.906724 201
## 10 max mean_per_class_accuracy 0.398801 0.908730 230
## 11 max tns 0.999012 2573.000000 0
## 12 max fns 0.999012 2449.000000 0
## 13 max fps 0.000116 2573.000000 399
## 14 max tps 0.000116 2480.000000 399
## 15 max tnr 0.999012 1.000000 0
## 16 max fnr 0.999012 0.987500 0
## 17 max fpr 0.000116 1.000000 399
## 18 max tpr 0.000116 1.000000 399
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## H2OBinomialMetrics: gbm
## ** Reported on cross-validation data. **
## ** 5-fold cross-validation on training data (Metrics computed for combined holdout predictions) **
##
## MSE: 0.06901951
## RMSE: 0.2627156
## LogLoss: 0.2313613
## Mean Per-Class Error: 0.0925675
## AUC: 0.9738522
## AUCPR: 0.9708184
## Gini: 0.9477044
## R^2: 0.7236683
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Si Error Rate
## No 6954 765 0.099106 =765/7719
## Si 625 6640 0.086029 =625/7265
## Totals 7579 7405 0.092766 =1390/14984
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.462185 0.905249 217
## 2 max f2 0.040585 0.940594 363
## 3 max f0point5 0.913645 0.923849 71
## 4 max accuracy 0.470868 0.907234 215
## 5 max precision 0.997949 0.995641 4
## 6 max recall 0.000129 1.000000 399
## 7 max specificity 0.999117 0.999870 0
## 8 max absolute_mcc 0.462185 0.814546 217
## 9 max min_per_class_accuracy 0.504591 0.906465 204
## 10 max mean_per_class_accuracy 0.462185 0.907432 217
## 11 max tns 0.999117 7718.000000 0
## 12 max fns 0.999117 7085.000000 0
## 13 max fps 0.000129 7719.000000 399
## 14 max tps 0.000129 7265.000000 399
## 15 max tnr 0.999117 0.999870 0
## 16 max fnr 0.999117 0.975224 0
## 17 max fpr 0.000129 1.000000 399
## 18 max tpr 0.000129 1.000000 399
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
## Cross-Validation Metrics Summary:
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## accuracy 0.9078086 0.0074161957 0.9171381 0.91371393 0.9060061 0.9026128
## auc 0.9738261 0.0028552606 0.9770293 0.9767067 0.97229666 0.97236794
## aucpr 0.97064143 0.0043593235 0.9755034 0.97455037 0.969861 0.96815705
## err 0.09219142 0.0074161957 0.0828619 0.08628609 0.093993895 0.09738717
## err_count 276.2 21.568495 249.0 263.0 277.0 287.0
## cv_5_valid
## accuracy 0.89957196
## auc 0.97072995
## aucpr 0.9651355
## err 0.10042805
## err_count 305.0
##
## ---
## mean sd cv_1_valid cv_2_valid cv_3_valid cv_4_valid
## pr_auc 0.97064143 0.0043593235 0.9755034 0.97455037 0.969861 0.96815705
## precision 0.8896287 0.016344063 0.9076197 0.8926261 0.8958475 0.8888131
## r2 0.72357243 0.018277623 0.741729 0.7434582 0.71984386 0.7084839
## recall 0.92500705 0.012211924 0.9231824 0.93432635 0.9138889 0.9131044
## rmse 0.262643 0.008697037 0.25399035 0.2531293 0.26458046 0.2698267
## specificity 0.89170253 0.018410336 0.9114415 0.8943348 0.8984738 0.89276314
## cv_5_valid
## pr_auc 0.9651355
## precision 0.86323714
## r2 0.70434713
## recall 0.94053316
## rmse 0.27168822
## specificity 0.861499373.6.3 - Variables importantes modelo GBM h2o factorizado
También podemos observar las variables importantes del modelo siguiendo nomenclatura h2o.
3.6.4 - Precisión modelo GBM h2o factorizado
Podemos usar funciones de h2o que permiten conseguir el performance.
## [1] 0.97401613.6.5 - Conclusiones modelo GBM h2o factorizado
Vemos cómo con estos cambios, la precisión del modelo se ha mantenido igual respecto al primer modelo GBM, ha pasado de un 97.3 a un 97.4.
3.7 - Modelo Ranger factorizado
Desde que hemos realizado el cambio de variable a predecir, la verdad es que aún no hemos intentado lanzar un modelo Ranger como en los primeros loops, por eso partiendo de este último modelo factorizado vamos a repetir los pasos de un modelo Ranger.
3.7.1 - División data set training y test y lanzamiento modelo Ranger factorizado
to_ranger3 <- to_glm2
set.seed(1234)
validationIndex <- createDataPartition(to_ranger3$fe_duration, p = 0.80, list = FALSE)
ranger3_train <- to_ranger3[validationIndex,]
ranger3_test <- to_ranger3[-validationIndex,]
fit_ranger3 <- ranger(
fe_duration ~. ,
data = ranger3_train,
num.trees = 100,
importance = 'impurity',
write.forest = TRUE,
min.node.size = 1,
splitrule = "gini",
verbose = TRUE,
classification = TRUE
)3.7.2 - Resultados modelo Ranger factorizado
Podemos analizar los resultados de nuestro modelo
## Ranger result
##
## Call:
## ranger(fe_duration ~ ., data = ranger3_train, num.trees = 100, importance = "impurity", write.forest = TRUE, min.node.size = 1, splitrule = "gini", verbose = TRUE, classification = TRUE)
##
## Type: Classification
## Number of trees: 100
## Sample size: 19935
## Number of independent variables: 26
## Mtry: 5
## Target node size: 1
## Variable importance mode: impurity
## Splitrule: gini
## OOB prediction error: 9.41 %## Length Class Mode
## predictions 19935 factor numeric
## num.trees 1 -none- numeric
## num.independent.variables 1 -none- numeric
## mtry 1 -none- numeric
## min.node.size 1 -none- numeric
## variable.importance 26 -none- numeric
## prediction.error 1 -none- numeric
## forest 9 ranger.forest list
## confusion.matrix 4 table numeric
## splitrule 1 -none- character
## treetype 1 -none- character
## call 10 -none- call
## importance.mode 1 -none- character
## num.samples 1 -none- numeric
## replace 1 -none- logical3.7.3 - Variables importantes modelo Ranger factorizado
Podemos analizar los variables importantes de nuestro modelo
vars3_imp <- fit_ranger3$variable.importance
vars3_imp <- as.data.frame(vars3_imp)
vars3_imp$myvar <- rownames(vars3_imp)
vars3_imp <- as.data.table(vars3_imp)
setorder(vars3_imp, -vars3_imp)
ggbarplot(vars3_imp[1:10],
x = "myvar", y = "vars3_imp",
color = "blue", # Set bar border colors to white
palette = "jco", # jco journal color palett. see ?ggpar
sort.val = "asc", # Sort the value in descending order
sort.by.groups = FALSE, # Don't sort inside each group
x.text.angle = 90, # Rotate vertically x axis texts
ylab = "Importancia",
xlab = 'Variable',
rotate = TRUE,
ggtheme = theme_minimal()
)
3.7.4 - Precisión modelo Ranger factorizado
Vamos a ver ahora en detalle como de preciso ha sido el modelo.
ranger3_pred <- predict(fit_ranger3, data = ranger3_test)
Accuracy(y_pred = ranger3_pred$predictions, y_true = ranger3_test$fe_duration)## [1] 0.90909093.7.5 - Conclusiones modelo Ranger factorizado
Podemos ver como el modelo ha aumentado su precisión hasta un 90%B aproximadamente si lo comparamos con los primeros modelos Ranger que hemos lanzado. Aún así sigue teniendo una precisión menor que los modelos GLM o GBM que hemos lanzado.
Está claro que la diferencia entre modelos Ranger se debe principalmente al cambio en la variable a ser predicha. Por otro lado, la diferencia entre modelos es debida a la propia naturaleza distinta del modelo.
Finalmente destacar que las variables importantes, han cambiado completamente. Hemos pasado de tener variables importantes como eran el número de cliente o la fecha de apertura en los primeros modelos. A otras variables (prácticamente iguales entre los segundos modelos) totalmente distintas como son el contador de cambios de status del sistema o un atributo booleano que indica si hemos excedido al target SLA o no.
Este cambio en las variables ha coincidico con el cambio en el cálculo de la variable de predicción, lo cual indica que en función de como lo calculemos dependerá de unas variables u otras.