library(data.table) library(xgboost) # Raju's code ------------------------------------------------------------- # Calculate Predecessors or Successors of every group, from kills, killPlace and groupId addPredecessors <- function(subDT, pred_mode=1) { stopifnot(pred_mode == 1 | pred_mode == -1) # Construct the relevant graph from the groups of the input data subDT[, level:= as.numeric(as.factor(groupkillsMin)), by=matchId] subDT[, node:=as.numeric(as.factor(groupId))] game_dt <- subDT[, list(matchId, node, level, kills=kills, groupKillInternalPosition=pred_mode*groupKillInternalPosition, killPlace=pred_mode*killPlace, winPlacePerc)] # level is used to store the number of predecessors/successors of a node at every level from 1 to 18. level_dt <- game_dt[, list(matchId=matchId[1], level=level[1], relposition=groupKillInternalPosition[1]), by=node][order(matchId, level, relposition)] graph_dt <- game_dt[order(-killPlace), list(node, shift(node, type = "lag")), by=c("matchId", "kills")] graph_dt <- graph_dt[!is.na(V2) & node != V2][, .N, by=c("node", "V2")][, list(node1=node, node2=V2)] numNodes <- level_dt[, max(node)] oldnames <- paste0("dom", 1:18) ioldnames <- paste0("i.dom", 1:18) newnames <- paste0("ndom", 1:18) level_dt[, (oldnames) := 0] level_dt[, matchtotalold:=0] for(l in 1:18) { level_dt[level == l, (oldnames[l]):=(1:.N)-1, by="matchId"] } level_dt[, total:=rowSums(.SD), .SDcols=oldnames] level_dt[, matchtotalnew:=sum(total), by=matchId] remainingGames <- level_dt[, uniqueN(matchId)] # Iteratively update the number of predecessors/successors until convergence. while(remainingGames > 0) { graph_dt <- level_dt[graph_dt, on=c(node="node2")][, -c("matchId", "relposition", "total")] setnames(graph_dt, "node", "node2") graph_dt[, (newnames):=0] graph_dt[level == 1 & matchtotalold != matchtotalnew, `:=`(ndom1 = max(c(0, dom1), na.rm=T)+1, ndom2 = max(c(0, dom2), na.rm=T), ndom3 = max(c(0, dom3), na.rm=T), ndom4=max(c(0, dom4), na.rm=T), ndom5=max(c(0, dom5), na.rm=T), ndom6=max(c(0, dom6), na.rm=T), ndom7 = max(c(0, dom7), na.rm=T), ndom8 = max(c(0, dom8), na.rm=T), ndom9 = max(c(0, dom9), na.rm=T), ndom10=max(c(0, dom10), na.rm=T), ndom11=max(c(0, dom11), na.rm=T), ndom12=max(c(0, dom12), na.rm=T), ndom13 = max(c(0, dom13), na.rm=T), ndom14 = max(c(0, dom14), na.rm=T), ndom15 = max(c(0, dom15), na.rm=T), ndom16=max(c(0, dom16), na.rm=T), ndom17=max(c(0, dom17), na.rm=T), ndom18=max(c(0, dom18), na.rm=T)), by=node1] graph_dt[level == 2 & matchtotalold != matchtotalnew, `:=`(ndom1 = max(c(0, dom1), na.rm=T), ndom2 = max(c(0, dom2), na.rm=T)+1, ndom3 = max(c(0, dom3), na.rm=T), ndom4=max(c(0, dom4), na.rm=T), ndom5=max(c(0, dom5), na.rm=T), ndom6=max(c(0, dom6), na.rm=T), ndom7 = max(c(0, dom7), na.rm=T), ndom8 = max(c(0, dom8), na.rm=T), ndom9 = max(c(0, dom9), na.rm=T), ndom10=max(c(0, dom10), na.rm=T), ndom11=max(c(0, dom11), na.rm=T), ndom12=max(c(0, dom12), na.rm=T), ndom13 = max(c(0, dom13), na.rm=T), ndom14 = max(c(0, dom14), na.rm=T), ndom15 = max(c(0, dom15), na.rm=T), ndom16=max(c(0, dom16), na.rm=T), ndom17=max(c(0, dom17), na.rm=T), ndom18=max(c(0, dom18), na.rm=T)), by=node1] graph_dt[level == 3 & matchtotalold != matchtotalnew, `:=`(ndom1 = max(c(0, dom1), na.rm=T), ndom2 = max(c(0, dom2), na.rm=T), ndom3 = max(c(0, dom3), na.rm=T)+1, ndom4=max(c(0, dom4), na.rm=T), ndom5=max(c(0, dom5), na.rm=T), ndom6=max(c(0, dom6), na.rm=T), ndom7 = max(c(0, dom7), na.rm=T), ndom8 = max(c(0, dom8), na.rm=T), ndom9 = max(c(0, dom9), na.rm=T), ndom10=max(c(0, dom10), na.rm=T), ndom11=max(c(0, dom11), na.rm=T), ndom12=max(c(0, dom12), na.rm=T), ndom13 = max(c(0, dom13), na.rm=T), ndom14 = max(c(0, dom14), na.rm=T), ndom15 = max(c(0, dom15), na.rm=T), ndom16=max(c(0, dom16), na.rm=T), ndom17=max(c(0, dom17), na.rm=T), ndom18=max(c(0, dom18), na.rm=T)), by=node1] graph_dt[level == 4 & matchtotalold != matchtotalnew, `:=`(ndom1 = max(c(0, dom1), na.rm=T), ndom2 = max(c(0, dom2), na.rm=T), ndom3 = max(c(0, dom3), na.rm=T), ndom4=max(c(0, dom4), na.rm=T)+1, ndom5=max(c(0, dom5), na.rm=T), ndom6=max(c(0, dom6), na.rm=T), ndom7 = max(c(0, dom7), na.rm=T), ndom8 = max(c(0, dom8), na.rm=T), ndom9 = max(c(0, dom9), na.rm=T), ndom10=max(c(0, dom10), na.rm=T), ndom11=max(c(0, dom11), na.rm=T), ndom12=max(c(0, dom12), na.rm=T), ndom13 = max(c(0, dom13), na.rm=T), ndom14 = max(c(0, dom14), na.rm=T), ndom15 = max(c(0, dom15), na.rm=T), ndom16=max(c(0, dom16), na.rm=T), ndom17=max(c(0, dom17), na.rm=T), ndom18=max(c(0, dom18), na.rm=T)), by=node1] graph_dt[level == 5 & matchtotalold != matchtotalnew, `:=`(ndom1 = max(c(0, dom1), na.rm=T), ndom2 = max(c(0, dom2), na.rm=T), ndom3 = max(c(0, dom3), na.rm=T), ndom4=max(c(0, dom4), na.rm=T), ndom5=max(c(0, dom5), na.rm=T)+1, ndom6=max(c(0, dom6), na.rm=T), ndom7 = max(c(0, dom7), na.rm=T), ndom8 = max(c(0, dom8), na.rm=T), ndom9 = max(c(0, dom9), na.rm=T), ndom10=max(c(0, dom10), na.rm=T), ndom11=max(c(0, dom11), na.rm=T), ndom12=max(c(0, dom12), na.rm=T), ndom13 = max(c(0, dom13), na.rm=T), ndom14 = max(c(0, dom14), na.rm=T), ndom15 = max(c(0, dom15), na.rm=T), ndom16=max(c(0, dom16), na.rm=T), ndom17=max(c(0, dom17), na.rm=T), ndom18=max(c(0, dom18), na.rm=T)), by=node1] for(l in 6:18) { graph_dt[level == l & matchtotalold != matchtotalnew, (newnames) := lapply(1:18, function(i) max(c(0, eval(parse(text=oldnames[i]))), na.rm=T)+ ifelse(l==i, 1, 0)), by=node1] } dom_dt <- graph_dt[, lapply(.SD, function(x) max(x)), .SDcols=newnames, by=node1][, setnames(.SD, newnames, oldnames)] setnames(dom_dt, "node1", "node") graph_dt[, (newnames):=NULL] graph_dt[, (oldnames):=NULL] updated_dom <- dom_dt[level_dt, on=c("node")][order(matchId, level, relposition), lapply(1:18, function(i) pmax(eval(parse(text=oldnames[i])), eval(parse(text=ioldnames[i])), na.rm=T))] level_dt[, (oldnames):=updated_dom] level_dt[, (oldnames) := lapply(.SD, function(x) cummax(x)), by=c("matchId", "level"), .SDcols=oldnames] level_dt[, matchtotalold:=matchtotalnew] level_dt[, total:=rowSums(.SD), .SDcols=oldnames] level_dt[, matchtotalnew:=sum(total), by=matchId] remainingGames <- level_dt[matchtotalnew != matchtotalold, uniqueN(matchId)] print(remainingGames) } level_dt[is.na(total), total:=0] subDT <- merge(subDT, level_dt[, list(node, total)], by="node") subDT[, node:=NULL] subDT[, total:=total/uniqueN(groupId), by="matchId"] if(pred_mode == 1) { setnames(subDT, "total", "predecessors") } else { setnames(subDT, "total", "successors") } rm(level_dt, graph_dt, game_dt) gc() return(subDT) } sample_submission <- fread("../input/sample_submission_V2.csv") dt <- fread("../input/train_V2.csv") test_dt <- fread("../input/test_V2.csv") transform_data <- function(subDT) { subDT[ , `:=`(groupkillsMin=min(kills), groupkillPlacemax=max(killPlace), groupkillPlacemin=min(killPlace), groupkillsMax=max(kills), groupkillsTotal=sum(kills), groupboostsTotal=sum(boosts), groupweaponsAcquiredTotal=sum(weaponsAcquired), groupdamageDealtTotal=sum(damageDealt), groupwalkDistance=mean(walkDistance), groupswimDistance=mean(swimDistance), grouprideDistance=mean(rideDistance)), by=c("matchId", "groupId")] subDT[ , `:=`(groupKillPosition=1-(groupkillPlacemax-1)/max(groupkillPlacemax)), by="matchId"] subDT[ , `:=`(groupKillInternalPosition=1-(groupkillPlacemax-min(groupkillPlacemax))/(pmax(1, max(groupkillPlacemax)-min(groupkillPlacemax)))), by=c("matchId", "groupkillsMin")] subDT[order(groupboostsTotal), groupboostsPosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[order(groupweaponsAcquiredTotal), groupweaponsAcquiredPosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[order(groupdamageDealtTotal), groupdamageDealtPosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[order(groupwalkDistance), groupwalkPosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[order(groupswimDistance), groupSwimPosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[order(grouprideDistance), groupRidePosition:=(0:(.N-1))/(.N-1), by=matchId] subDT[, groupboostsPosition:=mean(groupboostsPosition), by=c("matchId", "groupId")] subDT[, groupweaponsAcquiredPosition:=mean(groupweaponsAcquiredPosition), by=c("matchId", "groupId")] subDT[, groupdamageDealtPosition:=mean(groupdamageDealtPosition), by=c("matchId", "groupId")] subDT[, groupwalkPosition:=mean(groupwalkPosition), by=c("matchId", "groupId")] subDT[, groupSwimPosition:=mean(groupSwimPosition), by=c("matchId", "groupId")] subDT[, groupRidePosition:=mean(groupRidePosition), by=c("matchId", "groupId")] return(subDT) } # Calculating ranks w.r.t maximum/minimum walk positions of all the preceeding/succeeding nodes computeExtremalWalkPositions <- function(subDT) { subDT[, groupwalkDistance:=walkDistance] subDT[, groupWalkMaximalPosition:=NULL] subDT[, groupWalkMinimalPosition:=NULL] for(i in 1:8) { subDT[, groupwalkDistance:=max(groupwalkDistance), by=groupId] subDT[order(-killPlace), groupwalkDistance := cummax(groupwalkDistance), by=c("matchId", "kills")] subDT[, mean(groupwalkDistance)] } grpDT <- subDT[, list(matchId=matchId[1], groupwalkDistance=groupwalkDistance[1]), by=groupId] grpDT[order(groupwalkDistance), groupWalkMaximalPosition:=(0:(.N-1))/(.N-1), by=matchId] grpDT[is.na(groupWalkMaximalPosition), groupWalkMaximalPosition:=0] subDT <- merge(subDT, grpDT[, list(groupId, groupWalkMaximalPosition)], by="groupId") subDT[, groupwalkDistance:=walkDistance] for(i in 1:8) { subDT[, groupwalkDistance:=min(groupwalkDistance), by=groupId] subDT[order(killPlace), groupwalkDistance := cummin(groupwalkDistance), by=c("matchId", "kills")] subDT[, mean(groupwalkDistance)] } grpDT <- subDT[, list(matchId=matchId[1], groupwalkDistance=groupwalkDistance[1]), by=groupId] grpDT[order(groupwalkDistance), groupWalkMinimalPosition:=(0:(.N-1))/(.N-1), by=matchId] grpDT[is.na(groupWalkMinimalPosition), groupWalkMinimalPosition:=0] subDT <- merge(subDT, grpDT[, list(groupId, groupWalkMinimalPosition)], by="groupId") return(subDT) } dt <- transform_data(dt) test_dt <- transform_data(test_dt) test_dt[, winPlacePerc:=0.5] dt <- addPredecessors(dt, pred_mode = 1) dt <- addPredecessors(dt, pred_mode = -1) test_dt <- addPredecessors(test_dt, pred_mode = 1) test_dt <- addPredecessors(test_dt, pred_mode = -1) # Change Target tmp_dt <- dt[order(winPlacePerc), .(GroupNum=1), by=c("matchId", "groupId")] tmp_dt[, GroupNum:=cumsum(GroupNum), by="matchId"] dt <- merge(dt, tmp_dt, by=c("matchId", "groupId")) dt[order(winPlacePerc), winPlacePercTarget := (GroupNum-1)/(numGroups-1)] dt[is.na(winPlacePercTarget), winPlacePercTarget := 0] dt[, GroupNum:=NULL] test_dt[, winPlacePercTarget:=0.5] #Add more features dt[order(predecessors), groupWalkInternalMaximalPosition:=cummax(groupwalkPosition), by=c("matchId", "groupkillsMin")] dt <- computeExtremalWalkPositions(dt) dt[order(predecessors), groupboostsInternalMaximalPosition:=cummax(groupboostsPosition), by=c("matchId", "groupkillsMin")] dt[order(predecessors), groupdamageInternalMaximalPosition:=cummax(groupdamageDealtPosition), by=c("matchId", "groupkillsMin")] dt[order(predecessors), groupweaponsAcquiredInternalMaximalPosition:=cummax(groupweaponsAcquiredPosition), by=c("matchId", "groupkillsMin")] dt[, groupSize:=.N, by=groupId] test_dt[order(predecessors), groupWalkInternalMaximalPosition:=cummax(groupwalkPosition), by=c("matchId", "groupkillsMin")] test_dt <- computeExtremalWalkPositions(test_dt) test_dt[order(predecessors), groupboostsInternalMaximalPosition:=cummax(groupboostsPosition), by=c("matchId", "groupkillsMin")] test_dt[order(predecessors), groupdamageInternalMaximalPosition:=cummax(groupdamageDealtPosition), by=c("matchId", "groupkillsMin")] test_dt[order(predecessors), groupweaponsAcquiredInternalMaximalPosition:=cummax(groupweaponsAcquiredPosition), by=c("matchId", "groupkillsMin")] test_dt[, groupSize:=.N, by=groupId] matchTypes <- list("squad-fpp", "duo-fpp", "squad", "solo-fpp", "duo", "solo", c("normal-squad-fpp", "crashfpp", "normal-duo-fpp", "flaretpp", "normal-solo-fpp", "flarefpp", "normal-squad","crashtpp", "normal-solo", "normal-duo")) for(mtype in matchTypes) { print(mtype) xgb_train <- dt[!is.na(winPlacePerc) & matchType %in% mtype, list(winPlacePercTarget, predecessors, successors, predecessors-successors, 1-predecessors-successors, groupKillPosition, groupWalkMaximalPosition, groupWalkMinimalPosition, groupWalkInternalMaximalPosition, groupSwimPosition, groupRidePosition, groupKillInternalPosition, groupkillsMin, groupkillsTotal, groupSize, groupboostsTotal, groupboostsPosition, groupweaponsAcquiredPosition, groupdamageDealtPosition, groupboostsInternalMaximalPosition, groupdamageInternalMaximalPosition, groupweaponsAcquiredInternalMaximalPosition)] xgb_test <- test_dt[!is.na(winPlacePerc) & matchType %in% mtype, list(winPlacePercTarget, predecessors, successors, predecessors-successors, 1-predecessors-successors, groupKillPosition, groupWalkMaximalPosition, groupWalkMinimalPosition, groupWalkInternalMaximalPosition, groupSwimPosition, groupRidePosition, groupKillInternalPosition, groupkillsMin, groupkillsTotal, groupSize, groupboostsTotal, groupboostsPosition, groupweaponsAcquiredPosition, groupdamageDealtPosition, groupboostsInternalMaximalPosition, groupdamageInternalMaximalPosition, groupweaponsAcquiredInternalMaximalPosition)] train_data <- xgb.DMatrix(data = as.matrix(xgb_train[, -c("winPlacePercTarget"), with=FALSE]), label = xgb_train$winPlacePercTarget) test_data <- xgb.DMatrix(data = as.matrix(xgb_test[, -c("winPlacePercTarget"), with=FALSE]), label=xgb_test$winPlacePercTarget) max_depth <- 7 nrounds <- 750 eta <- 0.015 if(length(mtype) > 1) { max_depth <- 5 nrounds <- 400 eta <- 0.02 } fit <- xgboost(data=train_data, max_depth = max_depth, nthread=4, nrounds = nrounds, eta=eta, objective = "reg:linear", eval_metric = "rmse", verbose = 0) test_dt[matchType %in% mtype, winPlacePerc2:=predict(fit, test_data)] rm(fit) gc() } tmp_dt <- test_dt[order(winPlacePerc2), .(GroupNum=1), by=c("matchId", "groupId")] tmp_dt[, GroupNum:=cumsum(GroupNum), by="matchId"] tmp_dt[, meanGroupNum:=mean(GroupNum), by="matchId"] test_dt <- merge(test_dt, tmp_dt, by=c("matchId", "groupId")) test_dt[order(winPlacePerc2), winPlacePerc3 := (GroupNum-1)/(maxPlace-1) ] test_dt[GroupNum > meanGroupNum, winPlacePerc3 := (maxPlace-numGroups+GroupNum-1)/(maxPlace-1) ] test_dt[, winPlacePerc:=winPlacePerc3] win_predictions <- test_dt[, list(Id, winPlacePerc)] # Blake's DAG ------------------------------------------------------------- load_tiebreaker_predictions <- function(tiebreaker_predictions) { raw_test <- copy(test)[, .(Id, groupId)] tiebreaker_predictions <- merge(tiebreaker_predictions, raw_test, by = "Id") tiebreaker_predictions[, winPlacePerc := mean(winPlacePerc), by = groupId] tiebreaker_predictions <- unique(tiebreaker_predictions[, .(winPlacePerc, groupId)]) setkey(tiebreaker_predictions, "groupId") return(tiebreaker_predictions) } test <- fread("../input/test_V2.csv") win_predictions <- load_tiebreaker_predictions(win_predictions) # Construct a DAG, and perform a topological sort. Tiebreak using Raju's predictions # Win predictions --------------------------------------------------------- get_predictions <- function(win_predictions) { kp_summary <- test[, .(groupKp = max(killPlace)), by = .(groupId, kills, matchId)] kp_summary <- merge(kp_summary, win_predictions, by = "groupId") kp_summary <- kp_summary[order(matchId, kills, groupKp)] dag_games <- unique(test[numGroups != 1][["matchId"]]) rank_predictions <- data.table() # Can we parallelise this inside Kaggle kernel? z <- Sys.time() for(i in 1:length(dag_games)) { if(i %% 1000 == 0) { print(i) } game <- kp_summary[matchId == dag_games[i], -'matchId'] ranks <- predict_game(game) rank_predictions <- rbind(rank_predictions, ranks) } print(Sys.time() - z) return(rank_predictions) } # We want to use a modified topological sort on a DAG, because we would only prefer one defined order # Where there is ambiguity between nodes (i.e. team A is not clearly better than team B, or vice versa, we will # use the tiebreaker predictions to distinguish) predict_game <- function(game) { kill_hierarchies <- lapply(unique(game[["kills"]]), function(x) game[["groupId"]][game[["kills"]] == x]) tiebreak_ordered <- unique(game[order(-winPlacePerc)][["groupId"]]) # Use this to sort tiebreaks in the DAG # Initialise DAG: 1 = the team on the row dominates the team on the column dag <- initialise_dag(game, kill_hierarchies) ranking <- c() # Sort DAG, and add to our 'ranking' predictions as we go while(nrow(dag) > 1) { queue <- colnames(dag)[which(colSums(dag) == 0)] if(length(queue) == 1) { # We have a clear team that is next in the ranking ranking <- c(ranking, queue) # Remove that team from the dag dag <- dag[-which(rownames(dag) == queue), ] if(!is.matrix(dag)) { # If we only have 1 row left, this will be false last <- names(dag)[names(dag) != queue] ranking <- c(ranking, last) break } dag <- dag[, -which(colnames(dag) == queue)] } else { # Sort queue, best team first queue <- tiebreak_ordered[tiebreak_ordered %in% queue] # Update the DAG with our new edges / 'dominance' knowledge for(i in 1:(length(queue) - 1)) { edges <- queue[(i+1):length(queue)] dag[queue[i], edges] <- 1 } # we can remove the best team now ranking <- c(ranking, queue[1]) # Remove that team from the dag dag <- dag[-which(rownames(dag) == queue[1]), ] if(!is.matrix(dag)) { # If we only have 1 row left, this will be false last <- names(dag)[names(dag) != queue[1]] ranking <- c(ranking, last) break } dag <- dag[, -which(colnames(dag) == queue[1])] } } return(data.table(groupId = ranking, groupRank = 1:length(ranking))) } initialise_dag <- function(game, kill_hierarchies) { groups <- sort(unique(game[["groupId"]])) dag <- matrix(0, nrow = length(groups), ncol = length(groups)) rownames(dag) <- groups colnames(dag) <- groups for(hierarchy in kill_hierarchies) { if(length(hierarchy) > 1) { for(i in 1:(length(hierarchy)-1)) { edges <- hierarchy[(i+1):length(hierarchy)] dag[hierarchy[i], edges] <- 1 } } } return(dag) } add_fake_groups_and_normalise <- function(dt) { # Insert fake groups at even divisors dt[, groupDiff := maxPlace - numGroups] dt[groupDiff == 0, addedRanks := 0] for(i in 1:30) { tryCatch(dt[groupDiff == i, addedRanks := as.double(cut(groupRank, i+1, labels = F) - 1), by = matchId], error = function(e) NULL, warning = function(w) NULL) } dt[!is.na(addedRanks), groupRank := groupRank + addedRanks] dt[, pred2 := (groupRank - max(groupRank)) / (min(groupRank) - max(groupRank)), by = matchId] dt[numGroups == 1, pred2 := 0] return(dt) } predictions <- get_predictions(win_predictions) test <- merge(test, predictions, by = "groupId", all.x = T, sort = F) normalised_predictions <- add_fake_groups_and_normalise(copy(test)) # Sanity check all.equal(normalised_predictions[["Id"]], sample_submission[["Id"]]) sample_submission[, winPlacePerc := normalised_predictions[["pred2"]]] fwrite(sample_submission, "dagfeatures_topsort_Jan29.csv", row.names = FALSE)