Sudoku Solver in F#

open System

let input = 
    Array.map (fun _ -> Console.ReadLine().Split [| ' ' |]) [| 0 .. 8 |]
    |> Array.map (fun b -> Array.map (fun x -> Convert.ToInt32 (x:string)) b )

let display x = 
    x |> Array.iter (fun b -> 
                    Array.iter (fun x -> printf "%d " x) b; 
                    printfn "";
                 )
                 

let verify1 (grid:int[][]) x y c = 
    [0 .. 8] |> List.forall (fun i -> grid.[i].[y] <> c && grid.[x].[i]<> c)

let verify2 (grid:int[][]) x y c = 
          let xs = (x/3)*3 in
          let ys = (y/3)*3 in   
            [xs .. (xs+2)] |> List.forall (fun i -> 
                [ys .. (ys+2)] |> List.forall (fun j -> (grid.[i].[j] <> c)))

let verify grid x y c = 
    if (verify1 grid x y c) then (verify2 grid x y c) else false


let rec solve x y (grid:int[][]) =
   if grid.[x].[y] <> 0 then
      if (x = 8) && ( y = 8) then
         display grid
      else
         solve ((x+1) % 9) (if x = 8 then (y+1) else y) grid
   else
         [1..9] |> List.iter  (fun c ->
            if (verify grid x y c) then
               Array.set grid.[x] y c;
               solve x y grid;
            else
               ()
            Array.set grid.[x] y 0;
          )               
          
solve 0 0 input

A Imperative Style Haskell Sudoku Solver

Here is the Haskell equivalent of the Sudoku solver in C. I tried to do a line-by-line translation from C to Haskell. I hope the program shows that Haskell is a better imperative language than the imperative languages :-)

import List
import Array
import Control.Monad.State

strToArray :: String -> Array (Int, Int) Int
strToArray s = array ((0,0), (8,8)) $ zip [(m,n) | m <- [0 .. 8], n <- [0 ..8]] $
                 map read (concat (map words $ lines s))

display :: Array (Int, Int) Int -> IO()
display grid = do {
   forM_ [0..8] $ \m -> do {
      forM_ [0..8] $ \n -> do {
         putStr $ show (grid!(m, n)) ++ " ";
      };
      putStrLn "";
   };
   putStrLn "";
}

solve :: Int->Int->StateT (Array (Int, Int) Int) IO ()
solve x y = do {
   grid <- get;
   if grid!(x,y) /= 0 then
      if (x == 8) && ( y == 8) then
         lift (display grid)
      else
         solve ((x+1) `mod` 9) (if x == 8 then (y+1) else y)
   else
      do {
         forM_ [1..9] $ \c -> do {
            if (verify grid x y c) then
               put (grid //[((x,y),c)]) >> solve x y
            else
               return ()
         };
         put (grid //[((x,y),0)]);
      }
}

main :: IO ()
main = do {
   s <- getContents;
   evalStateT (solve 0 0) (strToArray s);
}

loopUntil :: [Int]->(Int->Bool)->Bool
loopUntil s f = 
   case s of
    x:xs -> if (f x) then (loopUntil xs f) else False
    []   -> True

verify1 :: Array (Int, Int) Int -> Int -> Int -> Int -> Bool
verify1 grid x y c = loopUntil [0 .. 8] $ \i -> 
                       not (grid!(i,y) == c || grid!(x,i) == c)

verify2 :: Array (Int, Int) Int -> Int -> Int -> Int -> Bool
verify2 grid x y c =
  let { xs = (x `quot` 3)*3} in
  let { ys = (y `quot` 3)*3} in   
    loopUntil [xs .. xs+2] $ \i -> 
       loopUntil [ys .. ys+2]  $ \j -> not (grid!(i,j) == c)

verify :: Array (Int, Int) Int -> Int -> Int -> Int -> Bool
verify grid x y c = (verify1 grid x y c) && (verify2 grid x y c)

Haskell Exception Handling

import IO
                
foo :: Int -> IO()    
foo n = do
 x <- try readLn
 case x of
     Left  ioerr -> if (n > 1) 
                     then putStrLn "Not a number!" >> foo(n-1) 
                     else putStrLn "Try too many times!"
     Right num   -> print (num + 12)
                            
main = foo 3