From 0b0a55516fcee00121bf30c30f718e96cbcbbfa4 Mon Sep 17 00:00:00 2001 From: Danilo Reyes Date: Wed, 2 Apr 2025 21:44:39 -0600 Subject: [PATCH] sudoku solver haskell first itteration --- src/sudoku-hs/flake.lock | 61 +++++++++++++++++++++ src/sudoku-hs/flake.nix | 26 +++++++++ src/sudoku-hs/src/Main.hs | 88 +++++++++++++++++++++++++++++++ src/sudoku-hs/sudoku-solver.cabal | 13 +++++ 4 files changed, 188 insertions(+) create mode 100644 src/sudoku-hs/flake.lock create mode 100644 src/sudoku-hs/flake.nix create mode 100644 src/sudoku-hs/src/Main.hs create mode 100644 src/sudoku-hs/sudoku-solver.cabal diff --git a/src/sudoku-hs/flake.lock b/src/sudoku-hs/flake.lock new file mode 100644 index 0000000..14cf232 --- /dev/null +++ b/src/sudoku-hs/flake.lock @@ -0,0 +1,61 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1743576891, + "narHash": "sha256-vXiKURtntURybE6FMNFAVpRPr8+e8KoLPrYs9TGuAKc=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "44a69ed688786e98a101f02b712c313f1ade37ab", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-24.11", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/src/sudoku-hs/flake.nix b/src/sudoku-hs/flake.nix new file mode 100644 index 0000000..8f00d97 --- /dev/null +++ b/src/sudoku-hs/flake.nix @@ -0,0 +1,26 @@ +{ + description = "A Haskell Sudoku solver using CSV input"; + inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-24.11"; + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = + { + self, + nixpkgs, + flake-utils, + }: + flake-utils.lib.eachDefaultSystem ( + system: + let + pkgs = import nixpkgs { inherit system; }; + hsPkgs = pkgs.haskellPackages; + in + { + packages.default = hsPkgs.callCabal2nix "sudoku-solver" ./. { }; + apps.default = { + type = "app"; + program = "${self.packages.${system}.default}/bin/sudoku-solver"; + }; + } + ); +} diff --git a/src/sudoku-hs/src/Main.hs b/src/sudoku-hs/src/Main.hs new file mode 100644 index 0000000..6fb34c4 --- /dev/null +++ b/src/sudoku-hs/src/Main.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Char (isSpace) +import Data.List (transpose, dropWhileEnd) +import Data.Maybe (isNothing, listToMaybe) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Vector as V +import qualified Data.Csv as CSV +import System.Environment (getArgs) +import Text.Read (readMaybe) + +type Cell = Maybe Int +type Grid = [[Cell]] + +parseCell :: String -> Cell +parseCell s = readMaybe (trim s) + where trim = dropWhileEnd isSpace . dropWhile isSpace + +readCSV :: FilePath -> IO Grid +readCSV path = do + csvData <- BL.readFile path + case CSV.decode CSV.NoHeader csvData of + Left err -> error ("CSV parse error: " ++ err) + Right v -> return $ map (map (parseCell . trimQuotes) . V.toList) (V.toList v) + where trimQuotes = filter (/= '"') + +printGrid :: Grid -> IO () +printGrid = putStrLn . unlines . map (unwords . map showCell) + where showCell = maybe "." show + +solve :: Grid -> Maybe Grid +solve grid = solve' grid + +solve' :: Grid -> Maybe Grid +solve' g = case findEmpty g of + Nothing -> Just g + Just (r, c) -> + listToMaybe [ g' + | n <- [1..9] + , isSafe g r c n + , let g' = updateGrid g r c (Just n) + , Just _ <- [solve' g'] ] + +findEmpty :: Grid -> Maybe (Int, Int) +findEmpty g = listToMaybe + [ (r, c) + | (r, row) <- zip [0..] g + , (c, cell) <- zip [0..] row + , isNothing cell ] + +isSafe :: Grid -> Int -> Int -> Int -> Bool +isSafe g r c n = + notElem (Just n) (getRow r g) && + notElem (Just n) (getCol c g) && + notElem (Just n) (getBox r c g) + +getRow :: Int -> Grid -> [Cell] +getRow r g = g !! r + +getCol :: Int -> Grid -> [Cell] +getCol c g = map (!! c) g + +getBox :: Int -> Int -> Grid -> [Cell] +getBox r c g = + [ g !! r' !! c' + | r' <- brange, c' <- crange ] + where + brange = let b = r - r `mod` 3 in [b..b+2] + crange = let b = c - c `mod` 3 in [b..b+2] + +updateGrid :: Grid -> Int -> Int -> Cell -> Grid +updateGrid g r c val = + take r g ++ + [take c (g !! r) ++ [val] ++ drop (c + 1) (g !! r)] ++ + drop (r + 1) g + +main :: IO () +main = do + args <- getArgs + case args of + [filePath] -> do + grid <- readCSV filePath + case solve grid of + Nothing -> putStrLn "No solution found." + Just g -> printGrid g + _ -> putStrLn "Usage: sudoku-solver " diff --git a/src/sudoku-hs/sudoku-solver.cabal b/src/sudoku-hs/sudoku-solver.cabal new file mode 100644 index 0000000..cc15b54 --- /dev/null +++ b/src/sudoku-hs/sudoku-solver.cabal @@ -0,0 +1,13 @@ +cabal-version: >=1.10 +name: sudoku-solver +version: 0.1.0.0 +build-type: Simple + +executable sudoku-solver + main-is: Main.hs + hs-source-dirs: src + build-depends: base >=4.12 && <5, + bytestring, + cassava, + vector + default-language: Haskell2010