module Exercise03 where

import Data.List (intercalate, minimumBy, nub, transpose, (\\))
import Data.Ord (comparing)
import Text.Printf (printf)

-- Tutorübungen

-- T 3.2 -- compare solution!!
dimensions :: [[a]] -> (Int, Int)
dimensions [] = (0, 0)
dimensions [xs] = (1, length xs)
dimensions (x : xs) = if length x == snd (dimensions xs) then (fst (dimensions xs) + 1, length x) else (-1, -1)

isSquare :: [[a]] -> Bool
isSquare xs = uncurry (==) (dimensions xs)

canAdd :: [[a]] -> [[a]] -> Bool
canAdd xs ys = fst dimx == fst dimy && snd dimx == snd dimy
  where
    dimx = dimensions xs
    dimy = dimensions ys

-- compare solution!
diagonal :: [[a]] -> [a]
diagonal [] = []
diagonal (x : xs) = head x : diagonal [tail x | x <- xs]

-- compare solution!
matrixAdd :: [[Integer]] -> [[Integer]] -> [[Integer]]
matrixAdd [] [] = []
matrixAdd (xs : xss) (ys : yss) = [x + y | (x, y) <- zip xs ys] : matrixAdd xss yss

-- compare solution!
matrixMult :: [[Integer]] -> [[Integer]] -> [[Integer]]
matrixMult [] _ = []
matrixMult (xs : xss) yss = [mulLists xs ys | ys <- transpose yss] : matrixMult xss yss

mulLists :: [Integer] -> [Integer] -> Integer
mulLists [] [] = 0
mulLists (x : xs) (y : ys) = x * y + mulLists xs ys

-- Compare solution!
mergeSort :: [Integer] -> [Integer]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort [x, y] = if x < y then [x, y] else [y, x]
mergeSort xs = merge (mergeSort (fst lists)) (mergeSort (snd lists))
  where
    lists = splitAt (div (length xs) 2) xs

merge :: [Integer] -> [Integer] -> [Integer]
merge [] [] = []
merge x [] = x
merge [] y = y
merge (x : xs) (y : ys)
  | x <= y = x : merge xs (y : ys)
  | otherwise = y : merge (x : xs) ys

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = transpose xss !! i

-- 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 = concat [take squareSize . drop sic $ xs | xs <- take squareSize . drop sir $ xss]
  where
    squareSize = intRoot (length xss)
    sir = i - mod i squareSize
    sic = mod i squareSize * squareSize

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs = length (nub elements) == length elements
  where
    elements = xs \\ [0 | _ <- [0 .. length xs]]

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = columnsAreValid xss indices && rowsAreValid xss indices && squaresAreValid xss indices
  where
    indices = [0 .. (length xss -1)]

columnsAreValid :: [[Int]] -> [Int] -> Bool
columnsAreValid xss = all (isValidSubsection . selectColumn xss)

rowsAreValid :: [[Int]] -> [Int] -> Bool
rowsAreValid xss = all (isValidSubsection . selectRow xss)

squaresAreValid :: [[Int]] -> [Int] -> Bool
squaresAreValid xss = all (isValidSubsection . selectSquare xss)

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (k, j) = set2D xss (j, k) -- opposite of my set

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss
  | isValidSudoku xss = solveSudokuRecursive xss (refinedMatrix xss)
  | otherwise = []

refinedMatrix :: [[Int]] -> [[[Int]]]
refinedMatrix sudoku = refinedMatrixHelper sudoku (0, 0) (length sudoku) allValues
  where
    allValues = replicate l (replicate l e)
    l = length sudoku
    e = [1 .. l]

refinedMatrixHelper :: [[Int]] -> (Int, Int) -> Int -> [[[Int]]] -> [[[Int]]]
refinedMatrixHelper sudoku (j, k) l current
  | k == l = current
  | j == l = refinedMatrixHelper sudoku (0, k + 1) l current
  | elementInSudoku == 0 = refinedMatrixHelper sudoku (j + 1, k) l current
  | otherwise = refinedMatrixHelper sudoku (j + 1, k) l (refineMatrixFromValue current (j, k) elementInSudoku)
  where
    elementInSudoku = get2D sudoku (j, k)

refineMatrixFromValue :: [[[Int]]] -> (Int, Int) -> Int -> [[[Int]]]
refineMatrixFromValue matrix (j, k) v = set2D (removeFromRow (removeFromColumn (removeFromSquareAtIndex matrix (j, k) v) j v) k v) (j, k) [-1]

solveSudokuRecursive :: [[Int]] -> [[[Int]]] -> [[Int]]
solveSudokuRecursive sudoku matrix
  | not (any (/= [-1]) (concat matrix)) = sudoku -- solved
  | null next = [] -- unsolvable
  | length next == 1 = fixValueFromSingleOption sudoku matrix index (head next) -- sure option: line not needed but faster like this
  | otherwise = tryAFewOptions sudoku next index matrix -- unsure options
  where
    next = minimumBy (comparing length) (filter (/= [-1]) (concat matrix))
    index = index2D matrix next

-- sets Value in Sudoku
-- refines matrix
-- calls solve sudoku recursive
fixValueFromSingleOption :: [[Int]] -> [[[Int]]] -> (Int, Int) -> Int -> [[Int]]
fixValueFromSingleOption sudoku matrix index value = solveSudokuRecursive newSudoku newMatrix
  where
    newSudoku = set2D sudoku index value
    newMatrix = refineMatrixFromValue matrix index value

-- if list is empty: unsolvable, retrun []
-- if first in list works: return it
-- if first in list doesnt work: try next
tryAFewOptions :: [[Int]] -> [Int] -> (Int, Int) -> [[[Int]]] -> [[Int]]
tryAFewOptions sudoku options index matrix
  | null options = []
  | null nextSudoku = tryAFewOptions sudoku (tail options) index matrix
  | otherwise = nextSudoku
  where
    value = head options
    nextSudoku = solveSudoku (fixValueFromSingleOption sudoku matrix index value)

-- Helpers for refining matrix
removeFromRow :: [[[Int]]] -> Int -> Int -> [[[Int]]]
removeFromRow matrix i v = set matrix i [xs \\ [v] | xs <- currentRow]
  where
    currentRow = matrix !! i

removeFromColumn :: [[[Int]]] -> Int -> Int -> [[[Int]]]
removeFromColumn matrix i v = transpose (removeFromRow (transpose matrix) i v)

removeFromSquareAtIndex :: [[[Int]]] -> (Int, Int) -> Int -> [[[Int]]]
removeFromSquareAtIndex matrix (j, k) v = setSquare matrix newSquare (sic, sir)
  where
    squareSize = intRoot (length matrix)
    sir = k - mod k squareSize
    sic = j - mod j squareSize
    newSquare = removeFromAll (getSquare matrix (sic, sir) squareSize) v

removeFromAll :: [[[Int]]] -> Int -> [[[Int]]]
removeFromAll matrix n = [removeFromAllHelper xs n | xs <- matrix]

removeFromAllHelper :: [[Int]] -> Int -> [[Int]]
removeFromAllHelper xs v = [xs \\ [v] | xs <- xs]

getSquare :: [[[Int]]] -> (Int, Int) -> Int -> [[[Int]]]
getSquare xss (sic, sir) squareSize = [take squareSize . drop sic $ xs | xs <- take squareSize . drop sir $ xss]

setSquare :: [[[Int]]] -> [[[Int]]] -> (Int, Int) -> [[[Int]]]
setSquare matrix square (sic, sir) = insertElements matrix modifiedRows sir
  where
    rowsToModify = take (length square) . drop sir $ matrix
    modifiedRows = insertMultipleElements rowsToModify square sic

insertMultipleElements :: [[a]] -> [[a]] -> Int -> [[a]]
insertMultipleElements old new i = [insertElements x y i | (x, y) <- zip old new]

insertElements :: [a] -> [a] -> Int -> [a]
insertElements old new i = start ++ new ++ end
  where
    start = take i old
    end = drop (i + length new) old

-- Zippers
get :: [a] -> Int -> a
get (x : _) 0 = x
get (_ : xs) i = get xs (i -1)

get2D :: [[a]] -> (Int, Int) -> a
get2D xss (x, y) = get (get xss y) x

index :: Eq a => [a] -> a -> Int
index xs el = indexHelper xs el 0

indexHelper :: Eq a => [a] -> a -> Int -> Int
indexHelper [] _ _ = -1
indexHelper (x : xs) a i
  | x == a = i
  | otherwise = indexHelper xs a (i + 1)

index2D :: Eq a => [[a]] -> a -> (Int, Int)
index2D xs el = index2DHelper xs el 0

index2DHelper :: Eq a => [[a]] -> a -> Int -> (Int, Int)
index2DHelper [] _ _ = (-1, -1)
index2DHelper (xs : xss) el k
  | j >= 0 = (j, k)
  | otherwise = index2DHelper xss el (k + 1)
  where
    j = index xs el

set :: [a] -> Int -> a -> [a]
set xs = setHelper (xs, [])

set2D :: [[a]] -> (Int, Int) -> a -> [[a]]
set2D xss (x, y) el = set xss y (set (get xss y) x el)

setHelper :: ([a], [a]) -> Int -> a -> [a]
setHelper (_ : xs, ys) 0 el = didSetHelper (el : xs, ys)
setHelper (x : xs, bs) n el = setHelper (xs, x : bs) (n -1) el

didSetHelper :: ([a], [a]) -> [a]
didSetHelper (xs, []) = xs
didSetHelper (xs, b : bs) = didSetHelper (b : xs, bs)

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

easyS :: [[Int]]
easyS =
  [ [1, 2, 3, 0],
    [3, 4, 0, 2],
    [0, 3, 4, 1],
    [4, 0, 0, 3]
  ]

easySZ :: [[Int]]
easySZ =
  [ [1, 2, 0, 0],
    [3, 4, 0, 2],
    [0, 0, 4, 1],
    [4, 0, 0, 3]
  ]

easySZZ :: [[Int]]
easySZZ =
  [ [1, 0, 0, 0],
    [0, 4, 0, 2],
    [0, 0, 0, 1],
    [4, 0, 0, 0]
  ]

smallH :: [[Int]]
smallH =
  [ [0, 0, 0, 0],
    [0, 0, 0, 0],
    [3, 0, 0, 0],
    [0, 0, 0, 4]
  ]

smallH2 :: [[Int]]
smallH2 =
  [ [0, 0, 0, 3],
    [0, 0, 0, 2],
    [4, 2, 3, 1],
    [0, 0, 2, 4]
  ]

smallH2W :: [[Int]]
smallH2W =
  [ [1, 4, 0, 3],
    [0, 0, 0, 2],
    [4, 2, 3, 1],
    [0, 0, 2, 4]
  ]

smallH2R :: [[Int]]
smallH2R =
  [ [2, 0, 0, 3],
    [0, 0, 0, 2],
    [4, 2, 3, 1],
    [0, 0, 2, 4]
  ]

smallS :: [[Int]]
smallS =
  [ [1, 2, 3, 4],
    [5, 6, 7, 8],
    [9, 10, 11, 12],
    [13, 14, 15, 16]
  ]

miniS :: [[Int]]
miniS = [[1, 0], [2, 1]]

miniSZ :: [[Int]]
miniSZ = [[1, 0], [0, 0]]

miniSZ2 :: [[Int]]
miniSZ2 = [[0, 0], [0, 2]]

miniSE :: [[Int]]
miniSE = [[0, 0], [0, 0]]

miniUnsolvable :: [[Int]]
miniUnsolvable = [[1, 1], [0, 0]]

testMiniS = solveSudoku miniS == [[1, 2], [2, 1]]

testMiniSZ = solveSudoku miniSZ == [[1, 2], [2, 1]]

testMiniSE = solveSudoku miniSE == [[1, 2], [2, 1]]

testMiniSZ2 = solveSudoku miniSZ2 == [[2, 1], [1, 2]]

testMiniUnsolvable = null (solveSudoku miniUnsolvable)

testAllMini :: Bool
testAllMini =
  testMiniS
    && testMiniSZ
    && testMiniSE
    && testMiniSZ2
    && testMiniUnsolvable

testHard :: Bool
testHard = solveSudoku hardSudoku == [[8, 1, 2, 7, 5, 3, 6, 4, 9], [9, 4, 3, 6, 8, 2, 1, 7, 5], [6, 7, 5, 4, 9, 1, 2, 8, 3], [1, 5, 4, 2, 3, 7, 8, 9, 6], [3, 6, 9, 8, 4, 5, 7, 2, 1], [2, 8, 7, 1, 6, 9, 5, 3, 4], [5, 2, 1, 9, 7, 4, 3, 6, 8], [4, 3, 8, 5, 2, 6, 9, 1, 7], [7, 9, 6, 3, 1, 8, 4, 5, 2]]

smallValid :: [[Int]]
smallValid =
  [ [1, 2, 3, 4],
    [3, 4, 1, 2],
    [2, 3, 4, 1],
    [4, 1, 2, 3]
  ]

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