module Exercise05 where

import Data.List
import qualified Data.Map as Map

-- May or may not be useful: computes the logarithm base 2 (rounded down) of the given number.
-- You don't have to move this into the WETT tags if you want to use it.
log2 :: (Integral a, Num b) => a -> b
log2 = let go acc n = if n <= 1 then acc else go (acc + 1) (n `div` 2) in go 0

{-WETT-}
decompose :: [Integer] -> [Integer]
decompose [] = []
decompose ds
    | 0 `elem` ds   = []
    | otherwise     = map snd $ Map.toAscList $ greedyDecompose q r 1 n (tail incDs)
    where   incDs = sort ds
            n = length ds
            a1 = head incDs
            q = toReversedBinaryMap a1 0
            r = log2 a1

-- TODO: Use Maps instead of Lists for better running Time.
greedyDecompose :: Map.Map Int Integer -> Int -> Int -> Int -> [Integer] -> Map.Map Int Integer
greedyDecompose q r k n tailedDs
    | k >= n    = q
    | otherwise = greedyDecompose newQ r (succ k) n (tail tailedDs)
    where   currLength = head tailedDs                      -- Length of current dimension
            currBinary = toReversedBinaryMap currLength 0   -- Binary representation of currLength
            factor = div currLength $ 2^r                   -- How many cubes of maximal size can fit in this dimension
            p = [factor * 2^(r - i) * (q Map.! i)| i <- [0..r]]
            -- s = replicate (r + 1) 0 
            s = foldl (zipWith (+)) (replicate (r + 1) 0)
                              [[if j > i then 0             -- There is no space left for cubes of length > i
                                else if j == i then sum [(2^(l - j))^k * (q Map.! l) | l <- [j .. r]]  -- Replace all bigger cubes by 2^(k - 1) * (#Blocks fitting in one site)
                                                                                                    -- cubes of size j
                                else 2^(i - j) * (q Map.! j)   -- Otherwise the blocks stay the same, only the dimension is filled up.
                                | j <- [0..r]]
                | i <- [0 .. r-1], currBinary Map.! i == 1]
            newQList = zipWith (+) p s
            newQ = Map.fromAscList $ zip [0..] newQList

toReversedBinaryMap :: Integer -> Int -> Map.Map Int Integer
toReversedBinaryMap 0 i = Map.fromAscList [(i,0)]
toReversedBinaryMap 1 i = Map.fromAscList [(i,1)]
toReversedBinaryMap n i = Map.insert i (mod n 2) $ toReversedBinaryMap (div n 2) (succ i)
{-TTEW-}

----------------------------------------------- Old Stuff ----------------------------------------------

decomposeList :: [Integer] -> [Integer]
decomposeList [] = []
decomposeList ds
    | 0 `elem` ds   = []
    | otherwise     = greedyDecomposeList q r 1 n (tail incDs)
    where   incDs = sort ds
            n = length ds
            a1 = head incDs
            q = toReversedBinaryList a1
            r = log2 a1

greedyDecomposeList :: [Integer] -> Int -> Int -> Int -> [Integer] -> [Integer]
greedyDecomposeList q r k n tailedDs
    | k >= n    = q
    | otherwise = greedyDecomposeList newQ r (succ k) n (tail tailedDs)
    where   currLength = head tailedDs                  -- Length of current dimension
            currBinary = toReversedBinaryList currLength    -- Binary representation of currLength
            factor = div currLength $ 2^r               -- How many cubes of maximal size can fit in this dimension
            p = [factor * 2^(r - i) * (q !! i)| i <- [0..r]]
            -- s = replicate (r + 1) 0 
            s = foldl (zipWith (+)) (replicate (r + 1) 0)
                              [[if j > i then 0             -- There is no space left for cubes of length > i
                                else if j == i then sum [(2^(l - j))^k * (q !! l) | l <- [j .. r]]  -- Replace all bigger cubes by 2^(k - 1) * (#Blocks fitting in one site)
                                                                                                    -- cubes of size j
                                else 2^(i - j) * (q !! j)   -- Otherwise the blocks stay the same, only the dimension is filled up.
                                | j <- [0..r]]
                | i <- [0 .. r-1], currBinary !! i == 1]
            newQ = zipWith (+) p s

toReversedBinaryList :: Integer -> [Integer]
toReversedBinaryList 0 = [0]
toReversedBinaryList 1 = [1]
toReversedBinaryList n = mod n 2 : toReversedBinaryList (div n 2)