Predicción Fallo Máquinas
Víctor López
24/4/2020
0.Opciones generales
options(scipen=999)#Desactiva la notacion cientifica1.Instalamos y cargamos las librerías necesarias (si las instalaste anteriormente es posible que te salga un error, no pasa ignóralo y simplemente cárgalas con los library de abajo)
#Instalar librerías
#install.packages('dplyr') #para manipular datos
#install.packages('skimr') #para exploración inicial
#install.packages('lubridate') #para manipular fechas
#install.packages('tidyr') #para manipular datos
#install.packages('ggplot2') #para hacer gráficos
#Cargar librerías
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(skimr)## Warning: package 'skimr' was built under R version 3.6.2library(lubridate)## Warning: package 'lubridate' was built under R version 3.6.2##
## Attaching package: 'lubridate'## The following objects are masked from 'package:dplyr':
##
## intersect, setdiff, union## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(tidyr)
library(ggplot2)
library(tidyverse)## ── Attaching packages ───────────────────────────────────────────────── tidyverse 1.3.0 ──## ✓ tibble 2.1.3 ✓ stringr 1.4.0
## ✓ readr 1.3.1 ✓ forcats 0.5.0
## ✓ purrr 0.3.4## Warning: package 'purrr' was built under R version 3.6.2## ── Conflicts ──────────────────────────────────────────────────── tidyverse_conflicts() ──
## x lubridate::as.difftime() masks base::as.difftime()
## x lubridate::date() masks base::date()
## x dplyr::filter() masks stats::filter()
## x lubridate::intersect() masks base::intersect()
## x dplyr::lag() masks stats::lag()
## x lubridate::setdiff() masks base::setdiff()
## x lubridate::union() masks base::union()library(readr)2.Cargamos los datos
path <- './dataset/DataSetFallosMaquina.csv' # El PUNTO "./" hace referencia a una ruta relativa.
read_lines(path,n_max = 5)## [1] "Temperature;Humidity;Operator;Measure1;Measure2;Measure3;Measure4;Measure5;Measure6;Measure7;Measure8;Measure9;Measure10;Measure11;Measure12;Measure13;Measure14;Measure15;Hours Since Previous Failure;Failure"
## [2] "67;82;Operator1;291;1;1;1041;846;334;706;1086;256;1295;766;968;1185;1355;1842;90;No"
## [3] "68;77;Operator1;1180;1;1;1915;1194;637;1093;524;919;245;403;723;1446;719;748;91;No"
## [4] "64;76;Operator1;1406;1;1;511;1577;1121;1948;1882;1301;273;1927;1123;717;1518;1689;92;No"
## [5] "63;80;Operator1;550;1;1;1754;1834;1413;1151;945;1312;1494;1755;1434;502;1336;711;93;No"df <- read.csv2(path, header = TRUE, sep = ";") # read.csv2 sirve para cargar datos con searador ";".
#df <- read_csv(file = './dataset/DataSetFallosMaquina.csv', sep=';')3.Análisis inicial
#Visión general
glimpse(df) #Esta funcion te permite saber las "Observations" que son el nombre de registros del Dataset y además el Nª de variables: 20## Observations: 8,784
## Variables: 20
## $ Temperature <int> 67, 68, 64, 63, 65, 67, 67, 67, 65, 63, …
## $ Humidity <int> 82, 77, 76, 80, 81, 84, 83, 76, 80, 80, …
## $ Operator <fct> Operator1, Operator1, Operator1, Operato…
## $ Measure1 <int> 291, 1180, 1406, 550, 1928, 398, 847, 10…
## $ Measure2 <int> 1, 1, 1, 1, 1, 1, 0, 2, 2, 0, 2, 3, 0, 1…
## $ Measure3 <int> 1, 1, 1, 1, 2, 2, 2, 1, 0, 0, 2, 1, 0, 1…
## $ Measure4 <int> 1041, 1915, 511, 1754, 1326, 1901, 1849,…
## $ Measure5 <int> 846, 1194, 1577, 1834, 1082, 1801, 1141,…
## $ Measure6 <int> 334, 637, 1121, 1413, 233, 1153, 1609, 9…
## $ Measure7 <int> 706, 1093, 1948, 1151, 1441, 1085, 982, …
## $ Measure8 <int> 1086, 524, 1882, 945, 1736, 1547, 1159, …
## $ Measure9 <int> 256, 919, 1301, 1312, 1033, 2005, 672, 4…
## $ Measure10 <int> 1295, 245, 273, 1494, 1549, 477, 1128, 1…
## $ Measure11 <int> 766, 403, 1927, 1755, 802, 1217, 663, 85…
## $ Measure12 <int> 968, 723, 1123, 1434, 1819, 1632, 1114, …
## $ Measure13 <int> 1185, 1446, 717, 502, 1616, 1324, 1838, …
## $ Measure14 <int> 1355, 719, 1518, 1336, 1507, 1854, 290, …
## $ Measure15 <int> 1842, 748, 1689, 711, 507, 1739, 1192, 8…
## $ Hours.Since.Previous.Failure <int> 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, …
## $ Failure <fct> No, No, No, No, No, No, No, No, No, No, …skim(df) # si en la salida no te salen los gráficos como a mi en el video usa la siguiente línea | Name | df |
| Number of rows | 8784 |
| Number of columns | 20 |
| _______________________ | |
| Column type frequency: | |
| factor | 2 |
| numeric | 18 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Operator | 0 | 1 | FALSE | 8 | Ope: 1952, Ope: 976, Ope: 976, Ope: 976 |
| Failure | 0 | 1 | FALSE | 2 | No: 8703, Yes: 81 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Temperature | 0 | 1 | 64.03 | 2.87 | 5 | 62.00 | 64.0 | 66 | 78 | ▁▁▁▆▇ |
| Humidity | 0 | 1 | 83.34 | 4.84 | 65 | 80.00 | 83.0 | 87 | 122 | ▁▇▂▁▁ |
| Measure1 | 0 | 1 | 1090.90 | 537.10 | 155 | 629.00 | 1096.0 | 1555 | 2011 | ▇▇▇▇▇ |
| Measure2 | 0 | 1 | 1.49 | 1.12 | 0 | 0.00 | 1.0 | 2 | 3 | ▇▇▁▇▇ |
| Measure3 | 0 | 1 | 1.00 | 0.82 | 0 | 0.00 | 1.0 | 2 | 2 | ▇▁▇▁▇ |
| Measure4 | 0 | 1 | 1071.63 | 536.52 | 155 | 608.75 | 1058.0 | 1533 | 2011 | ▇▇▇▇▇ |
| Measure5 | 0 | 1 | 1075.82 | 533.16 | 155 | 606.00 | 1077.0 | 1541 | 2011 | ▇▇▇▇▇ |
| Measure6 | 0 | 1 | 1076.02 | 534.00 | 155 | 623.00 | 1072.0 | 1537 | 2011 | ▇▇▇▇▇ |
| Measure7 | 0 | 1 | 1086.90 | 538.20 | 155 | 621.00 | 1089.0 | 1558 | 2011 | ▇▇▇▇▇ |
| Measure8 | 0 | 1 | 1077.28 | 537.19 | 155 | 612.00 | 1074.0 | 1541 | 2011 | ▇▇▇▇▇ |
| Measure9 | 0 | 1 | 1082.01 | 532.98 | 155 | 631.00 | 1078.0 | 1532 | 2011 | ▇▇▇▇▇ |
| Measure10 | 0 | 1 | 1082.40 | 537.58 | 155 | 619.00 | 1080.0 | 1547 | 2011 | ▇▇▇▇▇ |
| Measure11 | 0 | 1 | 1088.72 | 535.00 | 155 | 627.00 | 1093.0 | 1550 | 2011 | ▇▇▇▇▇ |
| Measure12 | 0 | 1 | 1088.33 | 533.30 | 155 | 627.00 | 1082.0 | 1552 | 2011 | ▇▇▇▇▇ |
| Measure13 | 0 | 1 | 1076.76 | 535.11 | 155 | 609.00 | 1067.0 | 1539 | 2011 | ▇▇▇▇▇ |
| Measure14 | 0 | 1 | 1088.31 | 537.26 | 155 | 617.00 | 1088.5 | 1560 | 2011 | ▇▇▇▇▇ |
| Measure15 | 0 | 1 | 1082.39 | 537.53 | 155 | 614.00 | 1076.0 | 1550 | 2011 | ▇▇▇▇▇ |
| Hours.Since.Previous.Failure | 0 | 1 | 217.34 | 151.75 | 1 | 90.00 | 195.0 | 324 | 666 | ▇▆▅▂▁ |
#knitr::kable(skim(df))
# lo que hacemos aquí es decir a R que use la función kable del paquete knitr (es una alternativa a cargrarlo con library si sólo vas a usarlo una vez como en nuestro caso), y lo que hace kable es dar un formato bonito a la salida de tablas, hay veces que si skimr tiene problemas para sacar los gráficos forzarlo con kable hace que salgan bienTenemos 8784 registros con 20 variables, tambien tenemos información sobre las variables; tipo Integer o Factorial( factorial quiere decir categoricas, que no hay puntos intermedios entre ellas), etc. Las de tipo integer son discretas ya que trabajamos con números enteros sin decimales.
Conclusiones: No hay nulos Problemas con tipos de variables: - Measure2 y Measure3 también parecen más factores que enteros, ya que vemos como 3 y 4 opciones diferentes, las demas parecen mas continuas. - Viendo el mínimo y el p25 de Temperature parece que tiene atípicos, nos puede indicar que esta algo sesgada.
Analizamos en mayor detalle la tempertura
ggplot(df,x=1) + geom_boxplot(aes(y=Temperature))
Conclusión: efectivamente vemos que son sólo 4 puntos los datos atípicos, si los dejamos nos van a sesgar las conclusiones. La gran linea central indica la media de la variable, después tenemos el percentil 25 y el 75 (las dos lineas mas cercanas tanto arriba como abajo). Lo que esta dentro de la caja son los valores mas frecuentes.
4.Calidad de datos
#Corregimos los tipos de variables y los atípicos
df <- df %>%
mutate(Measure2 = as.factor(Measure2), #Corregimos Measure2
Measure3 = as.factor(Measure3)) %>% #Corregimos Measure3
filter(Temperature > 50) #eliminamos los 4 atípicos de temperature5.Análisis exploratorio de variables (EDA)
#Exploramos las de tipo factor
df %>%
select_if(is.factor) %>%
gather() %>% # Cambia el orden de horizontal a vertical
ggplot(aes(value)) + geom_bar() + facet_wrap(~key,scales='free') +
theme(axis.text=element_text(size=6))#esto es para cambiar el tamaño del texto del eje y que se lea bien. EL FACET_WRAP SIRVE PARA QUE NOS HAGA UN GRAFICO PARA CADA VARIABLE.## Warning: attributes are not identical across measure variables;
## they will be dropped
#Y las de tipo entero
df %>%
select_if(is.integer) %>%
gather() %>%
ggplot(aes(value)) + geom_density() + facet_wrap(~key,scales='free') +
theme(axis.text=element_text(size=6))#esto es para cambiar el tamaño del texto del eje y que se lea bien
#Hacemos análisis de correlaciones, mejor que no correlacionen las variables (siempre tienen que ser continuas) para que el modelo sea preciso. Es decir, que sean cercanas a 0. Podríamos decir que podemos hacer un modelo de regresión ya que no esta correlacionadas
df %>%
select_if(is.integer) %>%
cor() %>% # Esto quiere decir que saques la correlación
round(digits = 2)## Temperature Humidity Measure1 Measure4 Measure5
## Temperature 1.00 -0.05 0.00 -0.02 0.01
## Humidity -0.05 1.00 0.00 0.00 -0.03
## Measure1 0.00 0.00 1.00 0.00 0.01
## Measure4 -0.02 0.00 0.00 1.00 0.00
## Measure5 0.01 -0.03 0.01 0.00 1.00
## Measure6 -0.01 -0.01 0.01 0.02 0.00
## Measure7 -0.01 -0.02 0.00 -0.01 0.00
## Measure8 0.00 0.01 0.00 0.01 -0.01
## Measure9 -0.02 0.00 -0.01 0.01 0.00
## Measure10 -0.01 0.00 0.01 0.00 -0.01
## Measure11 0.01 0.03 0.00 0.01 0.01
## Measure12 0.00 -0.02 -0.01 0.02 0.01
## Measure13 -0.01 -0.02 -0.01 -0.02 0.01
## Measure14 -0.01 0.00 0.00 -0.01 0.02
## Measure15 -0.01 -0.02 -0.01 0.00 0.00
## Hours.Since.Previous.Failure -0.01 0.00 0.00 -0.02 0.00
## Measure6 Measure7 Measure8 Measure9 Measure10
## Temperature -0.01 -0.01 0.00 -0.02 -0.01
## Humidity -0.01 -0.02 0.01 0.00 0.00
## Measure1 0.01 0.00 0.00 -0.01 0.01
## Measure4 0.02 -0.01 0.01 0.01 0.00
## Measure5 0.00 0.00 -0.01 0.00 -0.01
## Measure6 1.00 0.00 0.00 0.01 0.01
## Measure7 0.00 1.00 0.00 0.00 -0.01
## Measure8 0.00 0.00 1.00 0.01 -0.02
## Measure9 0.01 0.00 0.01 1.00 0.00
## Measure10 0.01 -0.01 -0.02 0.00 1.00
## Measure11 0.00 0.01 -0.02 0.01 0.01
## Measure12 0.02 0.00 0.00 0.02 0.01
## Measure13 -0.01 0.00 0.00 -0.01 0.01
## Measure14 -0.01 0.01 -0.02 0.00 0.00
## Measure15 -0.01 -0.01 0.01 0.02 -0.02
## Hours.Since.Previous.Failure -0.01 0.00 0.01 0.00 -0.01
## Measure11 Measure12 Measure13 Measure14 Measure15
## Temperature 0.01 0.00 -0.01 -0.01 -0.01
## Humidity 0.03 -0.02 -0.02 0.00 -0.02
## Measure1 0.00 -0.01 -0.01 0.00 -0.01
## Measure4 0.01 0.02 -0.02 -0.01 0.00
## Measure5 0.01 0.01 0.01 0.02 0.00
## Measure6 0.00 0.02 -0.01 -0.01 -0.01
## Measure7 0.01 0.00 0.00 0.01 -0.01
## Measure8 -0.02 0.00 0.00 -0.02 0.01
## Measure9 0.01 0.02 -0.01 0.00 0.02
## Measure10 0.01 0.01 0.01 0.00 -0.02
## Measure11 1.00 -0.01 0.00 0.01 0.01
## Measure12 -0.01 1.00 0.01 0.00 0.01
## Measure13 0.00 0.01 1.00 0.01 0.01
## Measure14 0.01 0.00 0.01 1.00 0.01
## Measure15 0.01 0.01 0.01 0.01 1.00
## Hours.Since.Previous.Failure 0.00 -0.02 0.01 0.00 -0.01
## Hours.Since.Previous.Failure
## Temperature -0.01
## Humidity 0.00
## Measure1 0.00
## Measure4 -0.02
## Measure5 0.00
## Measure6 -0.01
## Measure7 0.00
## Measure8 0.01
## Measure9 0.00
## Measure10 -0.01
## Measure11 0.00
## Measure12 -0.02
## Measure13 0.01
## Measure14 0.00
## Measure15 -0.01
## Hours.Since.Previous.Failure 1.00#Hacemos un zoom sobre el desbalanceo de la variable target. La función TABLE cuenta el numero de veces de cada uno de los valores de esa variable, básicamente la frecuencia.
table(df$Failure)##
## No Yes
## 8699 81Conclusiones: - En la primera distribucion de las horas de las maquina en los enteros, vemos que hay un punto de corte donde las maquinas no fallan (hasta las 70h aprox) y despues cada vez hay menos maquinas que duren por ejemplo 500 h sin fallar. - No se perciben patrones raros en las variables - Las variables de medidas no correlacionan - La variable target está muy desbalanceada (el modelo se acomoda y casi siempre predecirá que nunca habrá un fallo)
6.Transformación de variables No son necesarias grandes transformaciones porque el fichero ya viene muy limpio (no pasa así en la realidad)
Tampoco vamos a crear variables sintéticas (nuevas variables) que sí haríamos en la realidad (por ej número de fallos del mismo equipo, etc.)
Pero sí vamos a tener que trabajar sobre el balanceo de la variable target
#El sobre muestreo es multiplicar los casos que tienes x10 hasta conseguir el porcentaje de penetración que busco (casi siempre 20/80)
#Vamos a balancear usando la técnica del inframuestreo:
#Comprobamos la penetración exacta de la target
#Tenemos 81 sis que sobre el total de casos son un 0,9%:
cat("La proporción de penetración es:", 81/nrow(df) * 100,"%")## La proporción de penetración es: 0.9225513 %#81/nrow(df) * 100
#Para tener casi un 10% necesitaríamos incrementar la proporción aprox en x10
#Entonces vamos a reducir los nos para que salga aprox esa proporción del 10% de sis
#Nuevo df de nos
set.seed(1234) #Establecemos una semilla, una selección aleatoria de los datos pero de forma determinada
df_nos <- df %>%
filter(Failure == 'No') %>%
sample_frac(size = 0.08) #Creamos una muestra en funcion de la prop que le ponemos
#Df de sis
df_sis <- df %>% filter(Failure == 'Yes')
#Y los unimos de nuevo en un nuevo df reducido
df_red <- rbind(df_nos,df_sis)
#Comprobamos de nuevo la penetación de la target
count(df_red,Failure)## # A tibble: 2 x 2
## Failure n
## <fct> <int>
## 1 No 696
## 2 Yes 8181/nrow(df_red) * 100## [1] 10.42471Ahora ya tenmos un dataset donde la target tiene un 10% de penetración (que sigue siendo poco pero lo dejaremos así)
7.Modelización
7.1 Dividir en entrentamiento y validación: No lo vamos a hacer por simplicidad y porque tenemos pocos casos pero se debería hacer ya que. Cuando el modelo este en producción y vayan llegando los datos, la probabilidad se calcule sola. Esta fase entonces queremos comprobar que los datos que le van llegando funcionan bien. Normalmente el 70% de los datos los entrenamos y con el otro 30% serian para validar que los datos me dan aprox el mismo resultado que con el 70% de entrenamiento.
7.2 Roles de las variables
target <- 'Failure'
indep <- names(df_red)[-20] #la variable 20 es Failure. Aqui tenemos todas las variables predictoras menos la TARGET
formula <- reformulate(indep,target)La regresión logísitica es como la regresión multiple (variables quantitativas/continuas) pero para variables dicotomicas (0,1). Nosotros queremos saber la probabilidad de 1, es decir, de que se estropee la maquina. Por lo tanto lo que hacemos es aplicar una transformación matemática a esa regressión multiple (x + y = z). De esa manera transformamos la salida de una regresion multiple, en una salida entre 0 y 1 para saber la probabilidad. Funcion logísitica –> dentro de las funciones sigmoidales.
Vamos a modelizar con una regresión logística
rl <- glm(formula,df_red,family=binomial(link='logit'))
summary(rl) #Vemos el resultado##
## Call:
## glm(formula = formula, family = binomial(link = "logit"), data = df_red)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5992 -0.2251 -0.0829 -0.0319 3.9472
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -10.71197421 7.57929507 -1.413 0.1576
## Temperature 0.51063561 0.08439998 6.050 0.00000000145
## Humidity -0.32864864 0.05593164 -5.876 0.00000000421
## OperatorOperator2 -1.52872547 0.74583258 -2.050 0.0404
## OperatorOperator3 -0.94127935 0.78199528 -1.204 0.2287
## OperatorOperator4 -1.53555593 0.79710060 -1.926 0.0541
## OperatorOperator5 -1.42656277 0.95686891 -1.491 0.1360
## OperatorOperator6 -2.01372722 0.87352228 -2.305 0.0212
## OperatorOperator7 -0.05600171 0.82303039 -0.068 0.9458
## OperatorOperator8 -1.31565504 1.00509099 -1.309 0.1905
## Measure1 -0.00036411 0.00040945 -0.889 0.3739
## Measure21 -1.53274137 0.63978822 -2.396 0.0166
## Measure22 -0.88252115 0.59137875 -1.492 0.1356
## Measure23 -0.48864109 0.57668512 -0.847 0.3968
## Measure31 0.07341648 0.51626055 0.142 0.8869
## Measure32 0.40173345 0.52981346 0.758 0.4483
## Measure4 -0.00012266 0.00037570 -0.326 0.7441
## Measure5 0.00062969 0.00039368 1.599 0.1097
## Measure6 0.00008513 0.00038514 0.221 0.8251
## Measure7 0.00013942 0.00039815 0.350 0.7262
## Measure8 0.00072147 0.00041811 1.726 0.0844
## Measure9 -0.00022261 0.00040967 -0.543 0.5869
## Measure10 0.00102269 0.00042532 2.405 0.0162
## Measure11 -0.00032465 0.00039685 -0.818 0.4133
## Measure12 0.00002618 0.00042355 0.062 0.9507
## Measure13 0.00023410 0.00040261 0.581 0.5609
## Measure14 0.00026506 0.00039471 0.672 0.5019
## Measure15 0.00017387 0.00040795 0.426 0.6700
## Hours.Since.Previous.Failure -0.00141645 0.00138640 -1.022 0.3069
##
## (Intercept)
## Temperature ***
## Humidity ***
## OperatorOperator2 *
## OperatorOperator3
## OperatorOperator4 .
## OperatorOperator5
## OperatorOperator6 *
## OperatorOperator7
## OperatorOperator8
## Measure1
## Measure21 *
## Measure22
## Measure23
## Measure31
## Measure32
## Measure4
## Measure5
## Measure6
## Measure7
## Measure8 .
## Measure9
## Measure10 *
## Measure11
## Measure12
## Measure13
## Measure14
## Measure15
## Hours.Since.Previous.Failure
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 519.53 on 776 degrees of freedom
## Residual deviance: 187.39 on 748 degrees of freedom
## AIC: 245.39
##
## Number of Fisher Scoring iterations: 8# GLM es la funcion donde se encuentran todos las funciones: Modelos lineales generalizados. Le pasamos la "formula" que hemos creado, el dataframe reducido que en la realidad aqui tendríamso que pasar los datos de ENTRENAMIENTO y por ultimo que queremos hacer una regresion logistica en concreto.Sólo resultan predictivas al menos al 95% tres variables, que vamos a seleccionar como finales. Estan marcadas con un *. La temperatura si, la humedad tb y el operador 9.
indep_fin <- c('Temperature','Humidity','Measure9')
formula <- reformulate(indep_fin,target) #actualizamos la fórmula
formula## Failure ~ Temperature + Humidity + Measure9Aqui volvemos a crear un df de Independientes pero finales, las que si son predictoras o significativas para predecir el fallo.
Y volvemos a modelizar
rl <- glm(formula,df_red,family=binomial(link='logit'))
summary(rl) #Vemos el resultado##
## Call:
## glm(formula = formula, family = binomial(link = "logit"), data = df_red)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4447 -0.2574 -0.1236 -0.0566 3.3467
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -10.6798289 7.0863781 -1.507 0.132
## Temperature 0.4700295 0.0759195 6.191 0.000000000597 ***
## Humidity -0.2814188 0.0451640 -6.231 0.000000000463 ***
## Measure9 -0.0004273 0.0003521 -1.214 0.225
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 519.53 on 776 degrees of freedom
## Residual deviance: 217.20 on 773 degrees of freedom
## AIC: 225.2
##
## Number of Fisher Scoring iterations: 7Aplicamos nuestro modelo a los datos (aplicar el modelo en modo de ejecución)
df$scoring <- predict(rl,df,type='response') #Hazme la predicción de que una maquina falle. Que modelo? El RL que ya esta entrenado. Sobre que datos? DF (se haría sobre la muestra de validación). El response es para que devuelva la probabilidad de rotura.
head(df$scoring)## [1] 0.08520948 0.31437136 0.07298674 0.01564100 0.03343203 0.02451204Tenemos que la primera medición tiene un 12%, la segunda un 30%, la tercera un 7%…
Tomamos la decisión de si pensamos que será un fallo o no, en base a negocio.
#Como la penetración inicial era del 1%, vamos a poner un punto de corte muy alto, por ejemplo por encima del 80%
df$prediccion <- ifelse(df$scoring > 0.8,1,0)
#Dentro del dataframe creo una variable que se llamara "predicción", con IFELSE contrasto la condicion de que el scoring sea mayor que el 80% (0.8), si se cumple me pone un 1 y si no un 0.
table(df$prediccion)##
## 0 1
## 8732 48Hay 52 mediciones concretas donde si que piensa que la maquina se va a romper.
- Evaluación del modelo Vamos a contrastar la predicción contra la realidad
table(df$prediccion,df$Failure)##
## No Yes
## 0 8699 33
## 1 0 48# Las filas son lo que el modelo me predice. Los 0 me predice que segun el no va a fallar y en los 1 que si que va a fallar. En las columnas tengo la realidad. Esto es una matriz de confusion.De todos los que predigo que van a fallar la mayoría fallan, pero también me estoy dejando muchos fallos en el tintero por ser tan conservador
Y si fueramos menos exigentes y pusiéramos el corte un poco más abajo?
Tomamos la decisión de si pensamos que será un fallo o no
#Vamos a ver qué pasa si bajamos la decisión al 60%
df$prediccion <- ifelse(df$scoring > 0.6,1,0)Vamos a contrastar la predicción contra la realidad
table(df$prediccion,df$Failure)##
## No Yes
## 0 8694 25
## 1 5 56Tenemos que el modelo predice que no van a fallar 8687 casos y acierta, pero ha dicho que no iba a fallar en 24 y si han fallado. Por el contrario, ha predicho que si que fallarían 12 casos que no ha fallado y ha predicho bien 57 casos que si han fallado- Estas predicciones varian en función del scoring que le pongamos o de la exigencia, en este caso con un 0.6 predecimos mejor que los 0 que si han fallado (24 respecto a 30 antes) pero aumentamos el modelo falla mas cuando dice que si van a fallar cuando no lo haran en 12 respecto a 1 arriba.
Siendo menos exigentes conseguimos identificar mas de los fallos reales pero cometemos mas falsos positivos.