library(data.table)
library(Matrix)
library(caret)

library(xgboost)

to_sparse <- function(d_table){
  
  i_list <- lapply(d_table, function(x) which(x != 0))
  counts <- unlist(lapply(i_list, length), use.names = F)
  
  sparseMatrix(
    i = unlist(i_list, use.names = F),
    j = rep(1:ncol(d_table), counts),
    x = unlist(lapply(d_table, function(x) x[x != 0]), use.names = F),
    dims = dim(d_table),
    dimnames = list(NULL, names(d_table)))
}

# Quick rinse

# Run xgboost on the first [200,000] rows of the numeric data to identify important 
# columns. There is, of course, no guarantee this would always be a good idea, but with 
# this dataset the first chunk of rows seem to be representative.

# Once the numeric data has been read, all the values are offset by +2 to allow the 
# na’s to be set to zero.

dt <- fread("../input/train_numeric.csv", drop = "Id", nrows = 200000)


Y  <- dt$Response
dt[ , Response := NULL]

for(col in names(dt)) set(dt, j = col, value = dt[[col]] + 2)
for(col in names(dt)) set(dt, which(is.na(dt[[col]])), col, 0)

X <- to_sparse(dt)
gc()

rm(dt)


dtCat <- fread("../input/train_categorical.csv", drop = "Id", colClasses = "character",
               nrows = 200000, na.strings = "")

# loop for converting categorical into integer
cont <- 0
for (f in names(dtCat)) {
  cont <- cont + 1
  if (cont%%100 == 0) print(cont)
  if (class(dtCat[[f]])=="character") {
    levels <- unique(c(dtCat[[f]]))
    dtCat[[f]] <- as.numeric(factor(dtCat[[f]], levels=levels))
  }
}

for(col in names(dtCat)) set(dtCat, which(is.na(dtCat[[col]])), col, 0)

xCat <- to_sparse(dtCat)

rm(dtCat)

X <- cbind(X,xCat)


# Join numerical and categorical

folds <- createFolds(as.factor(Y), k = 6)
valid <- folds$Fold1
model <- c(1:length(Y))[-valid]


param <- list(objective = "binary:logistic",
              eval_metric = "auc",
              eta = 0.01,
              base_score = 0.005,
              col_sample = 0.5) 

dmodel <- xgb.DMatrix(X[model,], label = Y[model])
dvalid <- xgb.DMatrix(X[valid,], label = Y[valid])

m1 <- xgb.train(data = dmodel, param, nrounds = 20,
                watchlist = list(mod = dmodel, val = dvalid))

imp <- xgb.importance(model = m1, feature_names = colnames(X))

cols <- imp$Feature
length(cols)

head(cols, 10)

# intersect(cols,names(dtCat))

rm(list = setdiff(ls(), c("cols", "to_sparse")))

# Filter to the good stuff
# 
# Read all the data for the best numeric features.

dt <- fread("../input/train_numeric.csv", select = c(cols, "Response"))

Y  <- dt$Response
dt[ , Response := NULL]

for(col in names(dt)) set(dt, j = col, value = dt[[col]] + 2)
for(col in names(dt)) set(dt, which(is.na(dt[[col]])), col, 0)

X <- to_sparse(dt)
rm(dt)

dtCat <- fread("../input/train_categorical.csv", colClasses = "character", 
               na.strings = "", select = cols)

# loop for converting categorical into integer
cont <- 0
for (f in names(dtCat)) {
  cont <- cont + 1
  if (cont%%100 == 0) print(cont)
  if (class(dtCat[[f]])=="character") {
    levels <- unique(c(dtCat[[f]]))
    dtCat[[f]] <- as.numeric(factor(dtCat[[f]], levels=levels))
  }
}

for(col in names(dtCat)) set(dtCat, which(is.na(dtCat[[col]])), col, 0)

xCat <- to_sparse(dtCat)

rm(dtCat)

X <- cbind(X,xCat)

# Bathe in xgboost
# 
# The base_score parameter helps with the imbalanced classes.

set.seed(0)
folds <- createFolds(as.factor(Y), k = 6)
valid <- folds$Fold3
model <- c(1:length(Y))[-valid]

param <- list(objective = "binary:logistic",
              eval_metric = "auc",
              eta = 0.01,
              max_depth = 7,
              colsample_bytree = 0.5,
              base_score = 0.005) 

dmodel <- xgb.DMatrix(X[model,], label = Y[model])
dvalid <- xgb.DMatrix(X[valid,], label = Y[valid])

set.seed(0)
m1 <- xgb.train(data = dmodel, param, nrounds = 20,
                watchlist = list(mod = dmodel, val = dvalid))

pred <- predict(m1, dvalid)

summary(pred)

imp <- xgb.importance(model = m1, feature_names = colnames(X))

head(imp, 30)


# Gauge Matthews Coefficient
# 
# Try a few thresholds and select best for Matthews Coefficient.

mc <- function(actual, predicted) {
  
  tp <- as.numeric(sum(actual == 1 & predicted == 1))
  tn <- as.numeric(sum(actual == 0 & predicted == 0))
  fp <- as.numeric(sum(actual == 0 & predicted == 1))
  fn <- as.numeric(sum(actual == 1 & predicted == 0))
  
  numer <- (tp * tn) - (fp * fn)
  denom <- ((tp + fp) * (tp + fn) * (tn + fp) * (tn + fn)) ^ 0.5
  
  numer / denom
}

matt <- data.table(thresh = seq(0.990, 0.999, by = 0.001))

matt$scores <- sapply(matt$thresh, FUN =
                        function(x) mc(Y[valid], (pred > quantile(pred, x)) * 1))

print(matt)


best <- matt$thresh[which(matt$scores == max(matt$scores))]


# Test cycle
# 
# This time, also select the Id to be used in the submission.

dt  <- fread("../input/test_numeric.csv", select = c("Id", cols))

Id  <- dt$Id
dt[ , Id := NULL]

for(col in names(dt)) set(dt, j = col, value = dt[[col]] + 2)
for(col in names(dt)) set(dt, which(is.na(dt[[col]])), col, 0)

# X <- Matrix(as.matrix(dt), sparse = T)
X <- to_sparse(dt)
rm(dt)

dtCat <- fread("../input/test_categorical.csv", colClasses = "character", 
               na.strings = "", select = cols)

# loop for converting categorical into integer
cont <- 0
for (f in names(dtCat)) {
  cont <- cont + 1
  if (cont%%100 == 0) print(cont)
  if (class(dtCat[[f]])=="character") {
    levels <- unique(c(dtCat[[f]]))
    dtCat[[f]] <- as.numeric(factor(dtCat[[f]], levels=levels))
  }
}

for(col in names(dtCat)) set(dtCat, which(is.na(dtCat[[col]])), col, 0)

xCat <- to_sparse(dtCat)

rm(dtCat)

X <- cbind(X,xCat)

# Submission emission
# 
# Without re-training model on all data.

dtest <- xgb.DMatrix(X)
pred  <- predict(m1, dtest)

summary(pred)

sub   <- data.table(Id = Id,
                    Response = (pred > quantile(pred, best)) * 1)

write.csv(sub, "sub_bish_bash_xgb_with_categorical.csv", row.names = F)

gc()



# Results -----------------------------------------------------------------

# - With train_numeric.csv only, using the main variables selected by the XGB: 
# [19]	mod-auc:0.727556	val-auc:0.704858 in the train and validation sets respectively.
# In the leaderboard: 0.20203

# - with selected (only one selected) categorical columns: 
# [19]	mod-auc:0.717500	val-auc:0.696989. In the leaderboard: 0.21538 (top 28.5192 %)