module Exercise03 where

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

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [xss !! j !! i | j <- [0..length xss - 1]]

-- 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 i =  [xss !! x !! y | x <- [i `div` n * n .. (i `div` n + 1)* n-1], y <- [i `mod` n * n .. (i `mod` n + 1)* n-1] ]
  where
    n = intRoot (length xss)

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

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = and [isValidSubsection (selectRow xss i) && isValidSubsection (selectColumn xss i) && isValidSubsection (selectSquare xss i)| i <- [0 .. length xss-1]]

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

-- HA 3.1d)

{-WETT-}
solved :: [[Int]] -> Bool
solved xss = and [0 `notElem` selectRow xss i | i <- [0 .. length xss-1]] && isValidSudoku xss

notValidOutput :: Int -> [[Int]]
notValidOutput x = replicate x $ replicate x 0

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss 
  | solved xss = xss
  | otherwise = inList (solveIt (inArray xss)) (length xss)

inArray :: [[Int]] -> [Int]
inArray xss = [xss !! j !! i | j <- [0..length xss - 1],  i <- [0..length xss - 1]]

inList :: [Int] -> Int -> [[Int]]
inList [] x = notValidOutput x
inList xs x = splitEvery x xs

splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n xs = as : splitEvery n bs 
  where (as,bs) = splitAt n xs

-- Find the next blank value starting from index p on board s
-- 80 is the index of the last element in s
nextBlank :: Int -> [Int] -> Int
nextBlank p s | p == (length s -1 ) = length s -1
              | s !! (p + 1) == 0 = p + 1
              | otherwise         = nextBlank (p + 1) s

-- Recursively try and brute-force solve the board given in s, starting at p,
-- with the set of possible solutions at that point.s
-- 80 is the index of the last element in s
solve :: Int -> [Int] -> [Int] -> [Int]
solve p s (x:[])
  | p == length s -1 = tryWith (length s -1) s x
solve p s (x:_) 
  | p == length s -1 = []
solve _  s []     = []
solve p s (x:xs)  | null solvedNext = solve p s xs
                  | otherwise        = solvedNext
  where solveNext p s = solve (nextBlank p s) s (solutionsAt (nextBlank p s) s)
        solvedNext    = solveNext p (tryWith p s x)

solveIt :: [Int] -> [Int]
solveIt s = solve 0 s (solutionsAt 0 s)

-- Generate a new version of board s with value x inserted at index p
tryWith :: Int -> [Int] -> Int -> [Int]
tryWith p s x = take p s ++ [x] ++ drop (p + 1) s

-- The list of solutions at the index p of board s
solutionsAt :: Int -> [Int] -> [Int]
solutionsAt p s | p > length s  = []
                | (s !! p) == 0 = [1..n] `remove'` (columnAt p s ++ rowAt p s ++ squareAt p s)
                | otherwise     = [s !! p]
                where 
                  n = intRoot (length s )

-- Removes the elements in the second list from the first list
remove' :: [Int] -> [Int] -> [Int]
remove' [] _       = []
remove' xs []      = xs
remove' xs (y:ys)  = remove' (removeAll y xs) ys

-- Remove all occurences of a value in a list
removeAll :: Int -> [Int] -> [Int]
removeAll _ []     = []
removeAll y (x:xs) | x == y    = removeAll y xs
                   | otherwise = x : removeAll y xs

-- converts an index i into an x and y co-ordinate
itop :: Int -> Int -> (Int, Int)
itop i n = (calcX i, calcY i)
  where calcX i   = i - n * (i `div` n)
        calcY i   = i `div` n

-- Takes an x and y co-ordinate and converts it into an index
ptoi :: (Int, Int) -> Int -> Int
ptoi (x, y) n = x + y * n

-- Retrieves the vertical column of values from the board (s) at the index (p)
columnAt :: Int -> [Int] -> [Int]
columnAt p s = helperColumnAt (itop p (intRoot (length s))) s
  where helperColumnAt (x, _) s = map (\y -> s !! ptoi (x, y) (intRoot (length s))) [0..intRoot (length s)-1]

-- Retrieves the horizontal row of values from the board (s) at the index (p)
rowAt :: Int -> [Int] -> [Int]
rowAt p s = helperRowAt (itop p (intRoot (length s))) s
  where helperRowAt (_, y) s = map (\x -> s !! ptoi (x, y) (intRoot (length s))) [0..intRoot (length s)-1]

-- Retrieves the 3 x 3 square of values from the board (s) at the index (p)
squareAt :: Int -> [Int] -> [Int]
squareAt p s = helperSquareAt (itop p (intRoot (length s))) s
  where helperSquareAt (x, y) s = [ s !! ptoi (xx + sqOffsetX x, yy + sqOffsetY y) (intRoot (length s)) | xx <- [0..n-1], yy <- [0..n-1] ] 
        sqOffsetX x' = n * (x' `div` n)
        sqOffsetY y' = n * (y' `div` n)
        n = intRoot (intRoot (length s))

{-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)