Random Forests: Sirve para todo?

Objetivo

Predecir el consumo para los 3 meses siguiente dada una serie de datos del consumo previo junto a variables exogenas. Las variables next_consume, next_2_consume y next_3_consume son las variables dependientes que queremos predecir.

Cargar Bibliotecas

library(readr) # para leeer el dataset
library(ranger) # random forest con esteroides
library(dplyr) # para manipular datos
library(skimr) # para mirar los datos
library(caret) # framework de machine learning

Cargar el dataset

dataset %>% select(Date)
dataset %>% names() %>% as.data.frame()

 skimr::skim(dataset)# %>% knitr::kable() %>% kable_styling(font_size = 9)

── Data Summary ────────────────────────
                           Values 
Name                       dataset
Number of rows             76     
Number of columns          32     
_______________________           
Column type frequency:            
  numeric                  32     
________________________          
Group variables            None   

La Metodologia

dataset <- dataset %>% tidyr::drop_na()
  # mirando los mismos datos, predicen parecido para los proximos 3 meses.
train<-dataset %>% sample_frac(0.8)
test <-setdiff(dataset,train)
train

test

Modelo para predecir next_consume

rf_model1 <- ranger(next_consume ~ . -next_2_consume - next_3_consume - trimestral_consume ,data=train)
rf_model1

Ranger result

Call:
 ranger(next_consume ~ . - next_2_consume - next_3_consume - trimestral_consume,      data = train) 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      54 
Number of independent variables:  28 
Mtry:                             5 
Target node size:                 5 
Variable importance mode:         none 
Splitrule:                        variance 
OOB prediction error (MSE):       48.75851 
R squared (OOB):                  0.2491389 

rf_model1$prediction.error

[1] 48.75851

Entrenamiento

Out Of Box Sampling.

Los errores MSE y R squared se calculan sobre el OOB. El concepto de OOB está relacionado con el proceso de bootstrapping, que es una técnica de muestreo utilizada en la construcción de los árboles de decisión en Random Forest. En bootstrapping, se extrae una muestra aleatoria de los datos de entrenamiento con reemplazo, lo que significa que algunas instancias pueden ser elegidas varias veces, mientras que otras pueden no ser elegidas en absoluto.

Importancia de las variables

rf_model1 <- ranger(next_consume ~ . -next_2_consume - next_3_consume - trimestral_consume ,data=train, importance = "impurity")
rf_model1

Ranger result

Call:
 ranger(next_consume ~ . - next_2_consume - next_3_consume - trimestral_consume,      data = train, importance = "impurity") 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      54 
Number of independent variables:  28 
Mtry:                             5 
Target node size:                 5 
Variable importance mode:         impurity 
Splitrule:                        variance 
OOB prediction error (MSE):       51.84603 
R squared (OOB):                  0.2015925 

impurity: Este es el método predeterminado, que calcula la importancia de una característica basándose en la disminución de la impureza del nodo (por ejemplo, Gini o entropía) cuando una característica se utiliza para dividir en los árboles de decisión. Cuanto mayor sea la disminución de la impureza, más importante se considera la característica.

rf_model1$variable.importance

                       month_consume                      unique_customer                                stock                         prev_consume 
                           167.57974                            195.31883                            264.89529                            262.75743 
                      prev_2_consume                       prev_3_consume                       prev_4_consume                       prev_5_consume 
                           135.26440                             62.02208                            125.07794                             94.85842 
                      prev_6_consume                       prev_customers                 dolar_estadounidense                     produccion_trigo 
                           206.83914                            217.88084                            151.86929                             70.43617 
                    relacion_dolares                          Tasa_Badlar                      produccion_soja           CABA_precio_m2_3_ambientes 
                            98.15683                             52.10746                             14.43870                             76.52745 
                             ICC_GBA           CABA_precio_m2_2_ambientes Generacion_neta_de_energia_electrica                             Tasa_Fed 
                            57.69531                             63.46328                            186.64863                             44.22305 
              expectativas_inflacion       CABA_precio_m2_1_a_5_ambientes            CABA_precio_m2_1_ambiente                   ICC_BienesDurables 
                            40.51086                             69.55379                             63.88734                             64.55486 
                     ICC_NacionalEco                      ICC_NacionalReg                ICC_SituacionPersonal                      produccion_maiz 
                            49.07231                             44.79680                             94.75268                             84.61231 

data.frame(impurity=rf_model1$variable.importance) %>% arrange(desc(impurity))

NA

rf_model1 <- ranger(next_consume ~ prev_6_consume + month_consume + dolar_estadounidense -next_2_consume - next_3_consume - trimestral_consume ,data=train, importance = "impurity")
rf_model1

Ranger result

Call:
 ranger(next_consume ~ prev_6_consume + month_consume + dolar_estadounidense -      next_2_consume - next_3_consume - trimestral_consume, data = train,      importance = "impurity") 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      54 
Number of independent variables:  3 
Mtry:                             1 
Target node size:                 5 
Variable importance mode:         impurity 
Splitrule:                        variance 
OOB prediction error (MSE):       48.50974 
R squared (OOB):                  0.25297 

Prediccion

predictions1 <- predict(rf_model1,data = test, type='response')
predictions1$predictions %>% as.data.frame

Error MSE en test

mse<-function(act,pred) {mean((act- pred)^2)}

data.frame(pred=predictions1$predictions, act=test$next_consume) %>% summarise(mse=mse(act,pred))

Intervalos de prediccion (quantile regression)

En vez de utilizar el promedio se utilzan los cuantiles para tener un intervalo de predicción (Meinshausen, 2006). A la hora de realizar el split, en vez de utilizar MSE o alguna otra metrica de impureza, se utiliza una metrica que tiene en cuenta a los cuantiles . Luego en cada hoja en vez de calcular el promedio, se calculan cuantiles.

rf_model1 <- ranger(next_consume ~ . -next_2_consume - next_3_consume - trimestral_consume ,data=train, importance = "impurity",quantreg = TRUE)
rf_model1

Ranger result

Call:
 ranger(next_consume ~ . - next_2_consume - next_3_consume - trimestral_consume,      data = train, importance = "impurity", quantreg = TRUE) 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      54 
Number of independent variables:  28 
Mtry:                             5 
Target node size:                 5 
Variable importance mode:         impurity 
Splitrule:                        variance 
OOB prediction error (MSE):       50.83065 
R squared (OOB):                  0.2172288 

predictions1 <- predict(rf_model1,data = test, type= "quantiles")
predictions1$predictions %>% as.data.frame()

NA
NA

p1<-data.frame(predictions1$predictions,act=test$next_consume,label="FCT 1M")

p1  %>% ggplot()+
  geom_point(aes(x=act,y=quantile..0.5),color='red')+
  geom_errorbar(aes(x=act,y=quantile..0.5,ymax=quantile..0.9,ymin=quantile..0.1),color='orange')+
  theme_classic()

Intervalo de confianza

Similar al intervalo de prediccion. En las implementaciones de Random Forests, suele confudirse. En terminos generales, uno se aplica sobre una observacion/predicción en general, mientras que el otro trata sobre estadisticos. Un ejemplo seria, la diferencia entre desviacion estandar de una variable y el error estandar sobre un conjunto de muestras.

If we change the training dataset just a little bit, will Random Forest give you the same result for that particular example?

(Wagner et al. 2014) Basado en una tecnica que se llama jacknife.

rf_model1 <- ranger(next_consume ~ stock + month_consume + prev_6_consume + prev_2_consume  ,data=train, importance = "impurity",keep.inbag  = TRUE)
rf_model1

Ranger result

Call:
 ranger(next_consume ~ stock + month_consume + prev_6_consume +      prev_2_consume, data = train, importance = "impurity", keep.inbag = TRUE) 

Type:                             Regression 
Number of trees:                  500 
Sample size:                      54 
Number of independent variables:  4 
Mtry:                             2 
Target node size:                 5 
Variable importance mode:         impurity 
Splitrule:                        variance 
OOB prediction error (MSE):       56.38659 
R squared (OOB):                  0.1316697 

predictions1 <- predict(rf_model1,data = train, type= "se")

predictions1$predictions %>% as.data.frame()

predictions1$se %>% as.data.frame()

data.frame(pred=predictions1$predictions, se= predictions1$se, act=train$next_consume) %>% ggplot()+
  geom_point(aes(x=act,y=pred),color='red')+
  geom_errorbar(aes(x=act,y=pred,ymax=pred+se,ymin=pred-se),color='orange')+
  theme_classic()