Pairings average difference calculation

pairings.hs

module Main where

import Data.List

monkeys = [{-2416, -} 2117, 2085, 2018, 2013, 2010, 2006, 1929, 1749, 1746, 1678, 1622, 1622, 1586, 1543, 1497, 1487, 1445]

bishops = [2064, 2052, 2031, 1965, 1935, 1930, 1904, 1808, 1772, 1760, 1732, 1730, 1715, 1676, 1656, 1599, 1550, 1523, 1410]

diff :: Num a => [a] -> [a] -> [a]
diff = zipWith (-)

avg :: Fractional a => [a] -> a
avg xs = sum xs / genericLength xs

absAvgDiff :: Fractional a => [a] -> [a] -> a
absAvgDiff xs ys = avg . map abs $ diff xs ys

avgDiff :: Fractional a => [a] -> [a] -> a
avgDiff xs ys = abs . avg $ diff xs ys

merge :: Fractional a => Int -> [a] -> [a]
merge pos xs = take pos xs ++ merged : drop (pos + 2) xs
  where merged = (xs !! pos + xs !! (pos + 1)) / 2

multiMerge :: Fractional a => [Int] -> [a] -> [a]
multiMerge positions xs = foldr ($) xs (map merge positions)

mergeIndexes :: Int -> Int -> [[Int]]
mergeIndexes 0 n = [[]]
mergeIndexes 1 n = [[i] | i <- [0 .. n - 2]]
mergeIndexes 2 n = [[i, j] | i <- [0 .. n - 2], j <- [0 .. n - 2], i + 1 < j]
mergeIndexes 3 n = [[i, j, k] | i <- [0 .. n - 2], j <- [0 .. n - 2], k <- [0 .. n - 2], i + 1 < j, j + 1 < k]

findMerges bestCriteria mainMetric secondaryMetrics maxXMerges maxYMerges xs ys = bestCriteria
    [let mx = multiMerge ixs1 xs
         my = multiMerge ixs2 ys in
     (mainMetric mx my, secondaryMetrics mx my, ixs1, ixs2, mx, my, diff mx my)
    | ixs1 <- mergeIndexes maxXMerges (length xs),
      ixs2 <- mergeIndexes maxYMerges (length ys)]

m x y = findMerges minimum absAvgDiff avgDiff x y monkeys bishops
m' x y = findMerges minimum avgDiff absAvgDiff x y monkeys bishops

-- Output used for current pairings:
--
-- *Main> m 1 3
-- (36.40625,6.71875,[14],[7,9,11],[2117.0,2085.0,2018.0,2013.0,2010.0,2006.0,1929.0,1749.0,1746.0,1678.0,1622.0,1622.0,158
-- 6.0,1543.0,1492.0,1445.0],[2064.0,2052.0,2031.0,1965.0,1935.0,1930.0,1904.0,1790.0,1746.0,1722.5,1676.0,1656.0,1599.0,15
-- 50.0,1523.0,1410.0],[53.0,33.0,-13.0,48.0,75.0,76.0,25.0,-41.0,0.0,-44.5,-54.0,-34.0,-13.0,-7.0,-31.0,35.0])

-- Output description:
--
-- m 1 3 -- ask for merges: 1 merge for MonkeyClub, 3 merges for ArchBishops (as they have 2 more players registered).
-- 36.40625 -- minimal average absolute value of rating differences.
-- 6.71875 -- average value of rating differences (non-absolute). The second metric used, less valuable.
-- [14] -- merge index for the first team (MC), indices are 0-based, that means we should merge 15th player
--         with his next neighbour (16th).
-- [7,9,11] -- merge indices for the second team (AB), again indices are 0-based. This means that we merge 8th with 9th,
--             10th with 11th and 12th with 13th.
-- the rest -- final average ratings and their differences.