load (sprintf ("%s/data/lsmr_global_tuning.Rdata", Sys.getenv ("ABS_TOP_SRCDIR")))

#' Compute the Friedman + Nemenyi analysis with the tsutils package.
#' 
#' @return the tsutils analysis.
#' @export
cd_analysis <- function () {
    `%>%` <- magrittr::`%>%`
    data <- (global_tuning_data
        %>% dplyr::select (`LSMR local` = lsmr_local, dplyr::everything ())
        %>% dplyr::select (-dataset))
    colnames (data) <- toupper (colnames (data))
    colnames (data) <- gsub ("LOCAL", "local", colnames (data))
    tsutils::nemenyi (as.matrix (data), plottype = "vmcb")
}

## Expects that higher is better.  Returns -1 if the first is better,
## +1 if the second is better, and 0 otherwise.
paired_test_aux <- function (algo1, algo2) {
    diff <- algo2 - algo1
    magnitude <- abs (diff)
    sorted_magnitude <- sort (magnitude)
    get_rank <- function (diff) {
	m <- abs (diff)
	ok <- which (sorted_magnitude == m)
	mean (ok)
    }
    ranks <- sapply (diff, get_rank)
    positives <- which (diff > 0)
    negatives <- which (diff < 0)
    ties <- which (diff == 0)
    Rplus <- sum (ranks[positives]) + sum (ranks[ties]) / 2
    Rminus <- sum (ranks[negatives]) + sum (ranks[ties]) / 2
    ret <- 0
    if (Rplus < Rminus) {
	ret <- -1
    } else {
	ret <- +1
    }
    T <- min (Rplus, Rminus)
    N <- length (diff)
    znum <-         (T - (1 / 4) * N * (N + 1))
    ##             ------------------------------
    zdenom <- sqrt ((1 / 24) * N * (N + 1) * (2 * N + 1))
    z <- znum / zdenom
    alpha <- 0.1
    crit <- qnorm (1 - alpha / 2)
    if (z >= -crit) {
	ret <- 0
    }
    ret
}

paired_test <- function (algo1, algo2) {
    data <- global_tuning_data
    algo1 <- data[, algo1 + 1][[1]]
    algo2 <- data[, algo2 + 1][[1]]
    paired_test_aux (-algo1, -algo2)
}

#' Compute the win / lose / tie matrix for all pairs of algorithms.
#' @return the matrix with row and column names set to the names of
#'     the algorithms.
#' @export
win_lose_tie_paired_tests <- function () {
    data <- global_tuning_data
    M <- matrix (0, ncol (data) - 1, ncol (data) - 1)
    colnames (M) <- toupper (gsub ("_", "\n", colnames (data)[2:ncol (data)], fixed = TRUE))
    colnames (M) <- gsub ("LOCAL", "local", colnames (M))
    row.names (M) <- colnames (M)
    colnames (M) <- gsub ("LSMR\nlocal", "LSMR (l)", colnames (M), fixed = TRUE)
    for (i in seq_len (ncol (data) - 1)) {
	for (j in seq_len (ncol (data) - 1)) {
	    M[i, j] <- paired_test (i, j)
	}
    }
    M
}

#' Print the plot of the win / lose / tie matrix
#' @return Org-mode code
#' @export
print_win_lose_tie_plot <- function () {
    M <- win_lose_tie_paired_tests ()
    data <- reshape2::melt (M, na.rm = TRUE)
    (ggplot2::ggplot (data = data,
                      ggplot2::aes (Var2, Var1, fill = value))
	+ ggplot2::geom_tile (color = "white")
	+ ggplot2::scale_fill_gradient2 (low = "blue", high = "red", mid = "#FFFFFF00",
					 midpoint = 0, limit = c (-1, 1), name = "significant test")
	+ ggplot2::theme (legend.position = "none")
	+ ggplot2::theme (axis.title = ggplot2::element_blank ())
	+ ggplot2::theme (axis.text.x = ggplot2::element_text (angle=45, hjust=1)))
}