DLakomy · April 26, 2021 07:30
diff --git a/sudoku.hs b/sudoku.hs
 -- inspired by https://gist.github.com/pathikrit/a32e17832296befd6b94
 -- it works with the sample;
 -- if it doesn't work in general... it's a pity, but I've had enough :D I prefer Scala
 -- it's my first Haskell program

 -- Exercises for the reader
 -- change List to Sequence, it can be more efficient for index-based access
 -- guarantee that the board is 9x9 via its type

 import Data.List
 import Data.Maybe
 import Data.Either

 type BoardRow = [Int]
 type Board = [BoardRow]
 type BoardOrError = Either String Board

 greeting = "Type 81 digits (a Sudoku representation, 0 means empty): "
 invalidBoard = "This string doesn't represent a board correctly"
 size = 3*subGridSize
 lastFieldNo = size*size
 subGridSize = 3

 sample :: [Char]
 sample = "530070000600195000098000060800060003400803001700020006060000280000419005000080079"
 sampleBrd = fromRight undefined $ stringToBoard sample

 -- yup, I like Scala :) --TODO could be better, there is a function to do that OOTB I think
 headOption :: [Maybe a] -> Maybe a
 headOption x = if null collected then Nothing else Just $ head collected
  where collected = catMaybes x

 -- Really suboptimal for lists, u know? This is why a set would be better
 replaceNth :: Int -> a -> [a] -> [a]
 replaceNth _ _ [] = []
 replaceNth n newVal (x:xs)
  | n == 0 = newVal:xs
  | otherwise = x:replaceNth (n-1) newVal xs

 updateBoard :: Int -> Int -> Int -> [[Int]] -> [[Int]]
 updateBoard x y val brd = replaceNth x (replaceNth y val $ brd!!x) brd 

 partitionByN :: Int -> [a] -> [[a]]
 partitionByN _ [] = []
 partitionByN n l
  | n > 0 = (take n l) : (partitionByN n (drop n l))
  | otherwise = error "Negative or zero n"

 isBoard :: String -> Bool
 isBoard str = onlyDigits && (length str) == lastFieldNo
  where onlyDigits = isNothing $ find notADigit str
        notADigit c = not ('0' <= c && c <= '9')

 stringToBoard :: String -> BoardOrError
 stringToBoard str
  | isBoard str = Right (partitionByN size $ conv str)
  | otherwise = Left invalidBoard
  where conv xs = map (read . (:"")) xs

 boardToString :: Board -> String
 boardToString = g.u.d
  where g = unlines
        d = map (map show)
        u = map $ intercalate " "

 solve :: Board -> BoardOrError
 solve brd = f $ solve' brd 0
  where f Nothing = Left "Unsolvable"
        f (Just x) = Right x

 solve' :: Board -> Int -> Maybe Board
 solve' brd n
  | (n == lastFieldNo) = Just brd
  | (brd!!row!!col > 0) = solve' brd (n+1)
  | otherwise = headOption $ map (\a -> solve' (brdUpdatedWith a) (n+1) ) available
  where col = n `mod` size
        row = n `div` size
        available = [1..size]\\(used brd col row)
        brdUpdatedWith x = updateBoard row col x brd

 coordsToCheck :: Int -> [Int]
 coordsToCheck n = [x+q|q<-[0..(subGridSize-1)]]
  where x = n - (n `mod` subGridSize)

 -- gets numbers used in the same row/col/subgrid
 used :: Board -> Int -> Int -> [Int]
 used brd x y = sameRow++sameColumn++sameSubgrid
  where sameRow = brd!!y
        sameColumn = map (!!x) brd
        sameSubgrid = map (\(x,y)->brd!!y!!x) $ sgridCoords x y
          where sgridCoords a b = [(x,y)| x <- coordsToCheck a, y <- coordsToCheck b]
                
 main = do
  putStrLn greeting
  line <- getLine
  boardOrError <- return $ stringToBoard line
  solvedOrError <- return $ boardOrError >>= solve
  putStrLn $ either id boardToString solvedOrError
	-- inspired by https://gist.github.com/pathikrit/a32e17832296befd6b94
	-- it works with the sample;
	-- if it doesn't work in general... it's a pity, but I've had enough :D I prefer Scala
	-- it's my first Haskell program

	-- Exercises for the reader
	-- change List to Sequence, it can be more efficient for index-based access
	-- guarantee that the board is 9x9 via its type

	import Data.List
	import Data.Maybe
	import Data.Either

	type BoardRow = [Int]
	type Board = [BoardRow]
	type BoardOrError = Either String Board

	greeting = "Type 81 digits (a Sudoku representation, 0 means empty): "
	invalidBoard = "This string doesn't represent a board correctly"
	size = 3*subGridSize
	lastFieldNo = size*size
	subGridSize = 3

	sample :: [Char]
	sample = "530070000600195000098000060800060003400803001700020006060000280000419005000080079"
	sampleBrd = fromRight undefined $ stringToBoard sample

	-- yup, I like Scala :) --TODO could be better, there is a function to do that OOTB I think
	headOption :: [Maybe a] -> Maybe a
	headOption x = if null collected then Nothing else Just $ head collected
	where collected = catMaybes x

	-- Really suboptimal for lists, u know? This is why a set would be better
	replaceNth :: Int -> a -> [a] -> [a]
	replaceNth _ _ [] = []
	replaceNth n newVal (x:xs)
	\| n == 0 = newVal:xs
	\| otherwise = x:replaceNth (n-1) newVal xs

	updateBoard :: Int -> Int -> Int -> [[Int]] -> [[Int]]
	updateBoard x y val brd = replaceNth x (replaceNth y val $ brd!!x) brd

	partitionByN :: Int -> [a] -> [[a]]
	partitionByN _ [] = []
	partitionByN n l
	\| n > 0 = (take n l) : (partitionByN n (drop n l))
	\| otherwise = error "Negative or zero n"

	isBoard :: String -> Bool
	isBoard str = onlyDigits && (length str) == lastFieldNo
	where onlyDigits = isNothing $ find notADigit str
	notADigit c = not ('0' <= c && c <= '9')

	stringToBoard :: String -> BoardOrError
	stringToBoard str
	\| isBoard str = Right (partitionByN size $ conv str)
	\| otherwise = Left invalidBoard
	where conv xs = map (read . (:"")) xs

	boardToString :: Board -> String
	boardToString = g.u.d
	where g = unlines
	d = map (map show)
	u = map $ intercalate " "

	solve :: Board -> BoardOrError
	solve brd = f $ solve' brd 0
	where f Nothing = Left "Unsolvable"
	f (Just x) = Right x

	solve' :: Board -> Int -> Maybe Board
	solve' brd n
	\| (n == lastFieldNo) = Just brd
	\| (brd!!row!!col > 0) = solve' brd (n+1)
	\| otherwise = headOption $ map (\a -> solve' (brdUpdatedWith a) (n+1) ) available
	where col = n `mod` size
	row = n `div` size
	available = [1..size]\\(used brd col row)
	brdUpdatedWith x = updateBoard row col x brd

	coordsToCheck :: Int -> [Int]
	coordsToCheck n = [x+q\|q<-[0..(subGridSize-1)]]
	where x = n - (n `mod` subGridSize)

	-- gets numbers used in the same row/col/subgrid
	used :: Board -> Int -> Int -> [Int]
	used brd x y = sameRow++sameColumn++sameSubgrid
	where sameRow = brd!!y
	sameColumn = map (!!x) brd
	sameSubgrid = map (\(x,y)->brd!!y!!x) $ sgridCoords x y
	where sgridCoords a b = [(x,y)\| x <- coordsToCheck a, y <- coordsToCheck b]

	main = do
	putStrLn greeting
	line <- getLine
	boardOrError <- return $ stringToBoard line
	solvedOrError <- return $ boardOrError >>= solve
	putStrLn $ either id boardToString solvedOrError