Load and clean data

data <- readRDS(here::here("data", "sakulatordata.rds"))

# Some data cleaning
data$case_subtype <- factor(data$case_subtype)
data$case_court <- factor(data$case_court)
data$case_date_start <- ymd(data$case_date_start)
data$case_month_start <- as.character(data$case_date_start, format="%m")

Correlations

Korrelasjonsanalysen viser høy korrelasjon mellom “Internasjonal rett” og “menneskerettigheter”, og mellom “case_sivil_straffeprosess” og “case_straffeprosess”. I den videre analysen droppes internasjonal rett og case_sivil_straffeprosess.

data_red <- data[,-c(1:19)]
data_red <- sapply( data_red, as.numeric )
correlations <- cor(data_red, use="pairwise.complete.obs")
# correlations

Create training and test datasets

# Set seed
set.seed(1234)

# Get row numbers for the training data
trainRowNumbers <- createDataPartition(data$case_time_court_hearing, p=0.80, list=FALSE) 

# Create the training dataset
trainData <- data[trainRowNumbers,]

# Create the test dataset
testData <- data[-trainRowNumbers,]

# Store X and Y for later use.
y = trainData$case_time_court_hearing
y2 = testData$case_time_court_hearing

# Store case_id for later use
id <- trainData$case_id
id2 <- testData$case_id

One-hot encoding of categorical data

dummies_model <-
  dummyVars(
    case_time_court_hearing ~ case_priority + case_n_trans + case_subtype + case_n_part +
      case_n_witnesses + case_time_lowercourt + case_court +
      case_ecocrime + case_sivilekrav + case_menneskerettigheter + case_narkotika_alkohol_doping + 
      case_vold + case_transport_kommunikasjoner + case_straffeprosess +
      case_seksuallovbrudd + case_tvang_trusler_omsorgsunndragelse +
      case_vern_offentlig_myndighet +  case_økonomi + case_vinning +
      case_alminnelige_strafferett + case_erstatning_forsikringsrett + case_helse_omsorgsrett +
      case_forvaltning_kommunalrett + case_offentligro_orden_sikkerhet + 
      case_landbruk_jakt_skogbruk + case_skadeverk + case_utlendingsrett + 
      case_bank_finans_regnskapsrett + case_skatteforvaltning + case_skatte_avgiftsrett + 
      case_utenfor_straffeloven + case_arbeidsrett + case_falskforklaring_anklage +
      case_stats_statsforfatnings_statsborgerrett + case_eu_eøs + 
      case_fiskeri_fangstrett_havbruk + case_hms_beredskaps_sikkerhetsrett +
      case_domstolloven + case_advokatrett_rettshjelp + case_miljøvern_natur_friluftsliv + 
      case_næringsrett + case_vern_informasjon_informasjonsutveksling + 
      case_svalbard_biland + case_sivilprosess_tvisteloven + case_toll +
      case_selskaper_fond_foreninger + case_familie_person_barnerett + 
      case_kultur_idrett_underholdning + case_forurensning_klima_utslipp +
      case_pensjons_trygderett + case_tvangsfullbyrdelse + case_immatrialrett + 
      case_utenfor_folketrygdeloven + case_miljø + case_ikt_medierett +
      case_energirett + case_konkurs_gjeld_pant + case_inntekts_formueskatt + 
      case_fast_eiendom_rettsforhold + case_forbruker_kjøps_konkurranserett +
      case_merverdiavgift + case_anskaffelser_avtaler_bygg_entrepriser + 
      case_ytelser_sykdom + case_skattebetaling + case_skoler_universiteter_forskning,
    data = trainData
  )
trainData_mat <- predict(dummies_model, newdata = trainData)
trainData <- data.frame(trainData_mat)
str(trainData)
## 'data.frame':    9067 obs. of  75 variables:
##  $ case_priority                                            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_n_trans                                             : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_subtype.Fagdommersak                                : num  0 1 0 0 0 0 1 0 0 0 ...
##  $ case_subtype.Lagrettesak                                 : num  1 0 0 0 1 0 0 0 0 0 ...
##  $ case_subtype.Meddomsrettssak...begrenset.anke            : num  0 0 0 0 0 1 0 0 0 0 ...
##  $ case_subtype.Meddomsrettssak...bevisanke..gammel.ordning.: num  0 0 1 1 0 0 0 1 1 1 ...
##  $ case_subtype.Meddomsrettssak...bevisanke.over.6.år       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_subtype.Meddomsrettssak...bevisanke.under.6.år      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_n_part                                              : num  2 2 5 2 2 2 2 2 2 2 ...
##  $ case_n_witnesses                                         : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_time_lowercourt                                     : num  72 106 255 231 513 161 164 180 117 160 ...
##  $ case_court.Agder.Lagmannsrett                            : num  0 0 0 0 0 1 0 0 0 0 ...
##  $ case_court.Borgarting.Lagmannsrett                       : num  1 0 1 0 0 0 1 0 0 1 ...
##  $ case_court.Eidsivating.Lagmannsrett                      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_court.Frostating.Lagmannsrett                       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_court.Gulating.Lagmannsrett                         : num  0 1 0 1 1 0 0 1 0 0 ...
##  $ case_court.Hålogaland.Lagmannsrett                       : num  0 0 0 0 0 0 0 0 1 0 ...
##  $ case_ecocrime                                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_sivilekrav                                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_menneskerettigheter                                 : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_narkotika_alkohol_doping                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vold                                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_transport_kommunikasjoner                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_straffeprosess                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_seksuallovbrudd                                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_tvang_trusler_omsorgsunndragelse                    : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vern_offentlig_myndighet                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_økonomi                                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vinning                                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_alminnelige_strafferett                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_erstatning_forsikringsrett                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_helse_omsorgsrett                                   : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forvaltning_kommunalrett                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_offentligro_orden_sikkerhet                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_landbruk_jakt_skogbruk                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skadeverk                                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utlendingsrett                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_bank_finans_regnskapsrett                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skatteforvaltning                                   : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skatte_avgiftsrett                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utenfor_straffeloven                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_arbeidsrett                                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_falskforklaring_anklage                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_stats_statsforfatnings_statsborgerrett              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_eu_eøs                                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_fiskeri_fangstrett_havbruk                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_hms_beredskaps_sikkerhetsrett                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_domstolloven                                        : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_advokatrett_rettshjelp                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_miljøvern_natur_friluftsliv                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_næringsrett                                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vern_informasjon_informasjonsutveksling             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_svalbard_biland                                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_sivilprosess_tvisteloven                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_toll                                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_selskaper_fond_foreninger                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_familie_person_barnerett                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_kultur_idrett_underholdning                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forurensning_klima_utslipp                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_pensjons_trygderett                                 : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_tvangsfullbyrdelse                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_immatrialrett                                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utenfor_folketrygdeloven                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_miljø                                               : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_ikt_medierett                                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_energirett                                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_konkurs_gjeld_pant                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_inntekts_formueskatt                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_fast_eiendom_rettsforhold                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forbruker_kjøps_konkurranserett                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_merverdiavgift                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_anskaffelser_avtaler_bygg_entrepriser               : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_ytelser_sykdom                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skattebetaling                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skoler_universiteter_forskning                      : num  NA NA NA NA NA NA NA NA NA NA ...
dummies_model2 <-
  dummyVars(
    case_time_court_hearing ~ case_priority + case_n_trans + case_subtype + case_n_part +
      case_n_witnesses + case_time_lowercourt + case_court +
      case_ecocrime + case_sivilekrav + case_menneskerettigheter + case_narkotika_alkohol_doping + 
      case_vold + case_transport_kommunikasjoner + case_straffeprosess +
      case_seksuallovbrudd + case_tvang_trusler_omsorgsunndragelse +
      case_vern_offentlig_myndighet +  case_økonomi +  case_vinning +
      case_alminnelige_strafferett + case_erstatning_forsikringsrett + case_helse_omsorgsrett +
      case_forvaltning_kommunalrett + case_offentligro_orden_sikkerhet + 
      case_landbruk_jakt_skogbruk + case_skadeverk + case_utlendingsrett + 
      case_bank_finans_regnskapsrett + case_skatteforvaltning + case_skatte_avgiftsrett + 
      case_utenfor_straffeloven + case_arbeidsrett + case_falskforklaring_anklage +
      case_stats_statsforfatnings_statsborgerrett + case_eu_eøs + 
      case_fiskeri_fangstrett_havbruk + case_hms_beredskaps_sikkerhetsrett +
      case_domstolloven + case_advokatrett_rettshjelp + case_miljøvern_natur_friluftsliv + 
      case_næringsrett + case_vern_informasjon_informasjonsutveksling + 
      case_svalbard_biland + case_sivilprosess_tvisteloven + case_toll +
      case_selskaper_fond_foreninger + case_familie_person_barnerett + 
      case_kultur_idrett_underholdning + case_forurensning_klima_utslipp +
      case_pensjons_trygderett + case_tvangsfullbyrdelse + case_immatrialrett + 
      case_utenfor_folketrygdeloven + case_miljø + case_ikt_medierett +
      case_energirett + case_konkurs_gjeld_pant + case_inntekts_formueskatt + 
      case_fast_eiendom_rettsforhold + case_forbruker_kjøps_konkurranserett +
      case_merverdiavgift + case_anskaffelser_avtaler_bygg_entrepriser + 
      case_ytelser_sykdom + case_skattebetaling + case_skoler_universiteter_forskning,
    data = testData
  )
testData_mat <- predict(dummies_model2, newdata = testData)
testData <- data.frame(testData_mat)
str(testData)
## 'data.frame':    2265 obs. of  75 variables:
##  $ case_priority                                            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_n_trans                                             : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_subtype.Fagdommersak                                : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_subtype.Lagrettesak                                 : num  1 1 0 1 0 0 0 1 0 0 ...
##  $ case_subtype.Meddomsrettssak...begrenset.anke            : num  0 0 0 0 0 0 0 0 0 1 ...
##  $ case_subtype.Meddomsrettssak...bevisanke..gammel.ordning.: num  0 0 1 0 1 1 1 0 1 0 ...
##  $ case_subtype.Meddomsrettssak...bevisanke.over.6.år       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_subtype.Meddomsrettssak...bevisanke.under.6.år      : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_n_part                                              : num  8 2 2 2 2 2 3 2 2 2 ...
##  $ case_n_witnesses                                         : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_time_lowercourt                                     : num  354 211 231 183 130 66 226 91 154 54 ...
##  $ case_court.Agder.Lagmannsrett                            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_court.Borgarting.Lagmannsrett                       : num  0 1 0 1 1 0 1 1 1 1 ...
##  $ case_court.Eidsivating.Lagmannsrett                      : num  1 0 0 0 0 1 0 0 0 0 ...
##  $ case_court.Frostating.Lagmannsrett                       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_court.Gulating.Lagmannsrett                         : num  0 0 1 0 0 0 0 0 0 0 ...
##  $ case_court.Hålogaland.Lagmannsrett                       : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ case_ecocrime                                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_sivilekrav                                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_menneskerettigheter                                 : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_narkotika_alkohol_doping                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vold                                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_transport_kommunikasjoner                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_straffeprosess                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_seksuallovbrudd                                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_tvang_trusler_omsorgsunndragelse                    : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vern_offentlig_myndighet                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_økonomi                                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vinning                                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_alminnelige_strafferett                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_erstatning_forsikringsrett                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_helse_omsorgsrett                                   : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forvaltning_kommunalrett                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_offentligro_orden_sikkerhet                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_landbruk_jakt_skogbruk                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skadeverk                                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utlendingsrett                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_bank_finans_regnskapsrett                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skatteforvaltning                                   : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skatte_avgiftsrett                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utenfor_straffeloven                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_arbeidsrett                                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_falskforklaring_anklage                             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_stats_statsforfatnings_statsborgerrett              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_eu_eøs                                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_fiskeri_fangstrett_havbruk                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_hms_beredskaps_sikkerhetsrett                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_domstolloven                                        : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_advokatrett_rettshjelp                              : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_miljøvern_natur_friluftsliv                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_næringsrett                                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_vern_informasjon_informasjonsutveksling             : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_svalbard_biland                                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_sivilprosess_tvisteloven                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_toll                                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_selskaper_fond_foreninger                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_familie_person_barnerett                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_kultur_idrett_underholdning                         : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forurensning_klima_utslipp                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_pensjons_trygderett                                 : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_tvangsfullbyrdelse                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_immatrialrett                                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_utenfor_folketrygdeloven                            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_miljø                                               : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_ikt_medierett                                       : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_energirett                                          : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_konkurs_gjeld_pant                                  : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_inntekts_formueskatt                                : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_fast_eiendom_rettsforhold                           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_forbruker_kjøps_konkurranserett                     : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_merverdiavgift                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_anskaffelser_avtaler_bygg_entrepriser               : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_ytelser_sykdom                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skattebetaling                                      : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ case_skoler_universiteter_forskning                      : num  NA NA NA NA NA NA NA NA NA NA ...

Create matrix

train_matrix <- xgb.DMatrix(data = as.matrix(trainData), label = y)
test_matrix <- xgb.DMatrix(data = as.matrix(testData), label = y2)

Parameters and best.cv

params <-
  list(
    booster = 'gbtree',
    eta = 0.1,
    gamma = 0,
    max.depth = 8,
    subsample = 1,
    colsample_bytree = 1,
    min_child_weight = 1,
    objective = "reg:squarederror"
  )

set.seed(1234)

bst.cv <- xgb.cv(
  data = train_matrix,
  label = y,
  params = params,
  nrounds = 300,
  nfold = 5,
  print_every_n = 20,
  verbose = 2
)
## Warning in xgb.cv(data = train_matrix, label = y, params = params, nrounds =
## 300, : xgb.cv: label will be ignored, since data is of type xgb.DMatrix
## Warning in xgb.get.DMatrix(data, label, missing): xgboost: label will be
## ignored.
## [1]  train-rmse:22.860065+0.313107   test-rmse:23.203033+1.363993 
## [21] train-rmse:8.786817+0.170806    test-rmse:14.307782+1.010098 
## [41] train-rmse:6.870402+0.236784    test-rmse:13.745902+0.804704 
## [61] train-rmse:6.268928+0.217738    test-rmse:13.642647+0.759232 
## [81] train-rmse:5.887121+0.185631    test-rmse:13.635882+0.735031 
## [101]    train-rmse:5.537138+0.162444    test-rmse:13.675110+0.704928 
## [121]    train-rmse:5.201229+0.132167    test-rmse:13.708503+0.699303 
## [141]    train-rmse:4.923257+0.094783    test-rmse:13.749962+0.675453 
## [161]    train-rmse:4.573969+0.057781    test-rmse:13.801161+0.641414 
## [181]    train-rmse:4.326387+0.087246    test-rmse:13.823404+0.619752 
## [201]    train-rmse:4.098101+0.123284    test-rmse:13.844243+0.609664 
## [221]    train-rmse:3.874413+0.121453    test-rmse:13.857905+0.610096 
## [241]    train-rmse:3.746157+0.082030    test-rmse:13.869389+0.604482 
## [261]    train-rmse:3.604079+0.090705    test-rmse:13.880371+0.599168 
## [281]    train-rmse:3.412400+0.060966    test-rmse:13.895630+0.600925 
## [300]    train-rmse:3.276095+0.065488    test-rmse:13.905510+0.598431

Cheching for overfitting and retrieving best number of nrounds

res_df <-
  data.frame(
    TRAINING_ERROR = bst.cv$evaluation_log$train_rmse_mean,
    VALIDATION_ERROR = bst.cv$evaluation_log$test_rmse_mean,
    ITERATION = bst.cv$evaluation_log$iter
  ) %>%
  mutate(MIN = VALIDATION_ERROR == min(VALIDATION_ERROR))

# Define best nrounds
best_nrounds <- res_df %>%
  filter(MIN) %>%
  pull(ITERATION)

res_df_longer <- pivot_longer(data = res_df, 
                              cols = c(TRAINING_ERROR, VALIDATION_ERROR), 
                              names_to = "ERROR_TYPE",
                              values_to = "ERROR")


# A plot showing errors in training and validation
ggplot(res_df_longer, aes(x = ITERATION)) + 
  geom_line(aes(y = ERROR, group = ERROR_TYPE, colour = ERROR_TYPE)) +
  geom_vline(xintercept = best_nrounds, colour = "green") +
  geom_label(aes(label = str_interp("${best_nrounds} iterations gives minimum validation error"),
                 y = 0.2, x = best_nrounds, hjust = 0.1)) +
  labs(
    x = "nrounds",
    y = "Error",
    title = "Test & Train Errors",
    subtitle = str_interp("The training error keeps decreasing after ${best_nrounds} iterations, but the validation error starts \nincreasing. This is a sign of overfitting.")
  ) +
  scale_colour_discrete("Error Type: ")

Train model

set.seed(1234)

model <- xgboost(
  data = train_matrix,
  params = params,
  nround = best_nrounds
)
model

Feature importance

importance <- xgb.importance(model = model)
#importance
xgb.plot.importance(importance)

Prediction on test data

pred <- predict(model, newdata = test_matrix)
head(pred)
## [1] 306.84030  17.70638  13.33828  17.01857  10.44378   6.49178

MAE and RMSE

mae <- caret::MAE(y2, pred)
mae
## [1] 5.191283
rmse <- caret::RMSE(y2, pred)
rmse
## [1] 12.67375

R squared

d <- tibble(pred = predict(model, newdata = test_matrix)
            , obs = y2) %>%
  mutate(resid = pred - obs,
         resid_sq = resid ^ 2)
sstot <- sum((d$pred - mean(d$obs)) ^ 2)
ssresid <- sum(d$resid_sq)
sprintf("R squared: %1.1f%%", 100 * (1 - ssresid / sstot))
## [1] "R squared: 52.0%"

Data frame: Actual and predicted values

modelEval <- cbind(y2, pred)
colnames(modelEval) <- c('Actual', 'Predicted')
modelEval <- as.data.frame(modelEval)
head(modelEval)
##   Actual Predicted
## 1  345.5 306.84030
## 2   43.0  17.70638
## 3   43.5  13.33828
## 4    9.0  17.01857
## 5   24.5  10.44378
## 6   21.0   6.49178

Plot: Actual versus predicted

ggplot(modelEval, aes(x = Actual, y = Predicted)) +
  geom_point(alpha = 0.6, color = "cadetblue") +
  geom_smooth(method = "loess", formula = "y ~ x") +
  geom_abline(intercept = 0, slope = 1, linetype = 2) +
  labs(title = "Predicted vs Actual (test data)")

Prediction on train data

pred2 <- predict(model, newdata = train_matrix)
head(pred2)
## [1]  13.681108   2.855561 121.979759  13.338276  13.688674   4.688891
mae <- caret::MAE(y, pred2)
mae
## [1] 3.404354
rmse2 <- caret::RMSE(y, pred2)
rmse2
## [1] 6.130367

R squared

d <- tibble(pred = predict(model, newdata = train_matrix)
            , obs = y) %>% 
  mutate(resid = pred - obs,
         resid_sq = resid^2)
sstot <- sum((d$pred - mean(d$obs))^2)
ssresid <- sum(d$resid_sq)
sprintf("Percent variance explained, R^2: %1.1f%%", 100 * (1 - ssresid / sstot))
## [1] "Percent variance explained, R^2: 90.3%"

Data frame: Actual and predicted values

modelEval2 <- cbind(y, pred2)
colnames(modelEval2) <- c('Actual', 'Predicted')
modelEval2 <- as.data.frame(modelEval2)
head(modelEval2)
##   Actual  Predicted
## 1   20.0  13.681108
## 2    2.5   2.855561
## 3  174.0 121.979759
## 4   31.5  13.338276
## 5   10.5  13.688674
## 6    2.0   4.688891

Plot: Actual versus predicted (train)

ggplot(modelEval2, aes(x = Actual, y = Predicted)) +
  geom_point(alpha = 0.6, color = "cadetblue") +
  geom_smooth(method = "loess", formula = "y ~ x") +
  geom_abline(intercept = 0, slope = 1, linetype = 2) +
  labs(title = "Predicted vs Actual (train data)")