module Exercise03 where

import Text.Printf (printf)
import Data.List
import Data.Ord

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow = (!!)

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss = selectRow $ transpose xss

select :: [[Int]] -> Int -> Int -> Int
select a i j = a !! i !! j
selectColumn2 :: [[Int]] -> Int -> [Int]
selectColumn2 xss j = [select xss i j | i <- [0..n-1]] where n = length xss

-- HA 3.1a) iii
intRoot :: Int -> Int
intRoot = floor . sqrt . fromIntegral

--return numbers in square as a list. squares are numbered  from left to right and top to bottom
--e.g. :
--[0,1,2]
--[3,4,5]
--[6,7,8]
selectSquare :: [[Int]] -> Int -> [Int]
selectSquare xss k = [select xss i j | i <- [x*m..x*m+m-1], j <- [y*m..y*m+m-1]]
    where m = intRoot $ length xss
          x = k `div` m
          y = k `mod` m

-- HA 3.1b)
isValidSubsection :: Int -> [Int] -> Bool
isValidSubsection n [] = True
isValidSubsection n (x:xs) = (x == 0 || x > 0 && x <= n && x `notElem` xs) && isValidSubsection n xs

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = all ((== length xss) . length) xss && all (isValidSubsection (length xss)) (map (selectColumn xss) n ++ map (selectRow xss) n ++ map (selectSquare xss) n) where n = [0..length xss-1] 

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = take j xss ++ (take k xs ++ x : drop (k + 1) xs) : drop (j + 1) xss
    where xs = selectRow xss j

setCell2 :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell2 xss (k, l) x = [[if i == k && l == j then x else xss !! i !! j | i <- [0..n-1]] | j <- [0..n-1]] where n = length xss

main = s hardSudoku
s xss = putStr $ showSudoku $ solveSudoku xss
s2 xss = isValidSudoku $ solveSudoku xss

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss 
  | isValidSudoku xss = solve xss $ reorderOpen $ initOpen xss
  | otherwise = []

solve :: [[Int]] -> [((Int, Int, Int), [Int])] -> [[Int]]
solve xss [] = xss
solve xss ys
    | null (snd y) = []
    | otherwise = uncurry (tryValues xss ys') y
    where y = minimumBy (comparing $ length . snd) ys
          ys' = delete y ys

tryValues :: [[Int]] -> [((Int, Int, Int), [Int])] -> (Int, Int, Int) -> [Int] -> [[Int]]
tryValues _ _ _ [] = []
tryValues xss ys (i, j, k) (z:zs) 
    | null sol = tryValues xss ys (i, j, k) zs
    | otherwise = setCell sol (i, j) z
    where sol = solve xss (map (updateOpen (i, j, k) z) ys)

initOpen :: [[Int]] -> [((Int, Int, Int), [Int])]
initOpen xss = [((j, i, j `div` m * m + i `div` m), (([1..n] \\ selectRow xss j) \\ selectRow xss' i) \\ selectSquare2 i j) | i <- [0..n-1], j <- [0..n-1], xss !! j !! i == 0]
    where n = length xss
          m = intRoot n
          xss' = transpose xss
          squares = map (selectSquare xss) [0..n-1]
          selectSquare2 i j = squares !! (j `div` m * m + i `div` m)

reorderOpen ::  [((Int, Int, Int), [Int])] -> [((Int, Int, Int), [Int])]
reorderOpen xs = map f xs
    where reordered = map head (sortOn (Down . length) (group (sort $ concatMap snd xs)))
          f (p, vs) = (p, reordered `intersect` vs)

updateOpen :: (Int, Int, Int) -> Int -> ((Int, Int, Int), [Int]) -> ((Int, Int, Int), [Int])
updateOpen (i, j, k) v ((i2, j2, k2), vs)
    | i == i2 || j == j2 || k == k2 = ((i2, j2, k2), delete v vs) 
    | otherwise                     = ((i2, j2, k2), vs) 

{-TTEW-}

hardSudoku :: [[Int]]
hardSudoku = [[8,0,0, 0,0,0, 0,0,0],
              [0,0,3, 6,0,0, 0,0,0],
              [0,7,0, 0,9,0, 2,0,0],

              [0,5,0, 0,0,7, 0,0,0],
              [0,0,0, 0,4,5, 7,0,0],
              [0,0,0, 1,0,0 ,0,3,0],

              [0,0,1, 0,0,0, 0,6,8],
              [0,0,8, 5,0,0, 0,1,0],
              [0,9,0, 0,0,0, 4,0,0]]

-- Utility method to show a sudoku
-- show sudoku with
-- >>> putStr (showSudoku sudoku)
showSudoku :: [[Int]] -> String
showSudoku xss = unlines $ intercalate [showDivider] $ chunksOf squareSize $ map showRow xss
  where
    size = length xss
    squareSize = intRoot size 
    numberSize = size `div` 10 + 1

    showRowSection xs = unwords $ map (printf ("%0" ++ show numberSize ++ "d")) xs
    showRow xs = intercalate "|" $ map showRowSection $ chunksOf squareSize xs
    showDivider = intercalate "+" $ replicate squareSize $ replicate ((numberSize + 1) * squareSize - 1) '-'

    chunksOf :: Int -> [e] -> [[e]]
    chunksOf i [] = []
    chunksOf i ls = take i ls : chunksOf i (drop i ls)