A bit

Estinen.cabal

@@ -6,12 +6,12 @@ cabal-version:      3.4
 -- Starting from the specification version 2.2, the cabal-version field must be
 -- the first thing in the cabal file.
 
--- Initial package description 'Estinien' generated by
+-- Initial package description 'Estinen' generated by
 -- 'cabal init'. For further documentation, see:
 --   http://haskell.org/cabal/users-guide/
 --
 -- The name of the package.
-name:               Estinien
+name:               Estinen
 
 -- The package version.
 -- See the Haskell package versioning policy (PVP) for standards
@@ -50,14 +50,12 @@ extra-doc-files:    CHANGELOG.md
 -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
 -- extra-source-files:
 
-common default
+common warnings
     ghc-options: -Wall
-                 -threaded
-                 -rtsopts
 
 library
     -- Import common warning flags.
-    import:           default
+    import:           warnings
 
     -- Modules exported by the library.
     exposed-modules:  Sudoku
@@ -73,7 +71,6 @@ library
                     , matrix
                     , vector
                     , parallel
-                    , deepseq
 
     -- Directories containing source files.
     hs-source-dirs:   src
@@ -81,9 +78,9 @@ library
     -- Base language which the package is written in.
     default-language: GHC2024
 
-executable Estinien
+executable Estinen
     -- Import common warning flags.
-    import:           default
+    import:           warnings
 
     -- .hs or .lhs file containing the Main module.
     main-is:          Main.hs
@@ -97,7 +94,7 @@ executable Estinien
     -- Other library packages from which modules are imported.
     build-depends:
         base >=4.19.2.0,
-        Estinien
+        Estinen
 
     -- Directories containing source files.
     hs-source-dirs:   app

LICENSE

@@ -219,7 +219,7 @@ If you develop a new program, and you want it to be of the greatest possible use
 
 To do so, attach the following notices to the program.  It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
 
-     Estinien
+     Estinen
      Copyright (C) 2025  pingu
 
      This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

README.md

@@ -1,4 +1,4 @@
-# Estinien
+# Estinen
 
 Sudoku solver written in haskell
 

app/Main.hs

@@ -7,5 +7,5 @@ import System.Environment (getArgs)
 
 main :: IO ()
 main = getArgs >>= \case
-  [filename] -> readFile filename >>= print . solve . parseStringToGrid
+  [filename] -> readFile filename >>= print . parseStringToGrid
   _ -> error "Usage: Estinen filename"

easy.sudoku

@@ -1,9 +0,0 @@
-X X 3 1 6 5 7 9 8
-6 1 9 X X X 2 4 5
-5 8 7 X 4 X 1 X 6
-4 X 6 X 1 2 9 8 3
-X 9 X 8 X 4 6 X 2
-X X X 6 X 3 4 X 1
-9 X 2 5 X 7 8 X X
-8 X X 4 2 1 3 X 9
-1 X X X X 6 5 2 7

flake.nix

@@ -1,5 +1,5 @@
 {
-  description = "Estinien goes flakes";
+  description = "Estinen goes flakes";
 
   inputs = {
     nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
@@ -34,12 +34,12 @@
         in
         {
           packages = rec {
-            default = estinien;
-            estinien = pkgs.haskell.packages.${ghcVer}.estinien;
+            default = estinen;
+            estinen = pkgs.haskell.packages.${ghcVer}.estinen;
           };
 
           checks = {
-            inherit (self.packages.${system}) estinien;
+            inherit (self.packages.${system}) estinen;
           };
 
           # for debugging
@@ -49,7 +49,7 @@
             let haskellPackages = pkgs.haskell.packages.${ghcVer};
             in
             haskellPackages.shellFor {
-              packages = p: [ self.packages.${system}.estinien ];
+              packages = p: [ self.packages.${system}.estinen ];
               withHoogle = true;
               buildInputs =
                 (with pkgs; [
@@ -70,7 +70,7 @@
         default = makeHaskellOverlay (prev: hfinal: hprev:
           let hlib = prev.haskell.lib; in
           {
-            estinien = hprev.callCabal2nix "estinien" ./. { };
+            estinen = hprev.callCabal2nix "estinen" ./. { };
 
             rando = hlib.dontCheck hprev.rando;
           });

fucky.sudoku

@@ -1,9 +0,0 @@
-X 7 3 X X X X X 8
-X 5 4 X 3 X X X X
-2 8 X X 9 X X X X
-X X X 5 6 X 4 X X
-X X X X X 4 7 X X
-X 6 X 8 X X 9 X X
-X 3 X X 8 X X X 2
-X 9 X X 5 3 X X X
-X 4 X X 7 1 X 9 X

full.sudoku

@@ -1,9 +0,0 @@
-1 2 3 4 5 6 7 8 9
-4 5 6 7 8 9 1 2 3
-7 8 9 1 2 3 4 5 6
-2 3 4 5 6 7 8 9 1
-5 6 7 8 9 1 2 3 4
-8 9 1 2 3 4 5 6 7
-6 7 8 9 1 2 3 4 5
-9 1 2 3 4 5 6 7 8
-3 4 5 6 7 8 9 1 2

src/Sudoku.hs

@@ -1,27 +1,19 @@
 {-# LANGUAGE OverloadedStrings, LambdaCase, MultiWayIf #-}
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module Sudoku ( isValid
               , Cell(..)
               , Grid(..)
               , updateCell
               , emptyGrid
               , parseStringToGrid
-              , solve
-              , getSquare
               ) where
 
-import Data.Matrix hiding (getRow, getCol, trace)
+import Data.Matrix hiding (getRow, getCol)
 import Data.Matrix qualified as M
 import Data.Vector (Vector)
 import Data.Vector qualified as V
 import Data.Coerce
 import Control.Parallel
 import Control.Parallel.Strategies
-import Text.Printf
-import Data.List
-import Control.Monad
-import Control.DeepSeq
-import GHC.Generics (Generic)
 
 data Cell where
   One :: Cell
@@ -34,7 +26,7 @@ data Cell where
   Eight :: Cell
   Nine :: Cell
   Unknown :: Cell
-  deriving (Eq, Generic, NFData)
+  deriving (Eq)
 
 instance Show Cell where
   show One = "1"
@@ -46,7 +38,7 @@ instance Show Cell where
   show Seven = "7"
   show Eight = "8"
   show Nine = "9"
-  show Unknown = "_"
+  show Unknown = " "
 
 cellFromChar :: String -> Cell
 cellFromChar "1" = One
@@ -68,12 +60,8 @@ newtype Column = Column (Vector Cell)
 newtype Row = Row (Vector Cell)
 -- Square is 3x3 
 newtype Square = Square (Matrix Cell)
-instance Show Square where
-  show (Square m) = prettyMatrix m
-
 -- Grid is 9x9
 newtype Grid = Grid (Matrix Cell)
-  deriving (Eq, Generic, NFData)
 
 instance Show Grid where
   show (Grid m) = prettyMatrix m
@@ -94,9 +82,6 @@ parseStringToGrid str =
 isValidVector :: Vector Cell -> Bool
 isValidVector = V.all (<= 1) . (numbers >>=) . (((pure . V.length) .) . (. (==)) . flip V.filter)
 
-hasNoUnknownVector :: Vector Cell -> Bool
-hasNoUnknownVector = V.all (/= Unknown)
-
 isValidColumn :: Column -> Bool
 isValidColumn = isValidVector . coerce
 
@@ -106,23 +91,11 @@ isValidRow = isValidVector . coerce
 isValidSquare :: Square -> Bool
 isValidSquare = isValidVector . getMatrixAsVector . coerce
 
-hasNoUnknownColumn :: Column -> Bool
-hasNoUnknownColumn = hasNoUnknownVector . coerce
-
-hasNoUnknownRow :: Row -> Bool
-hasNoUnknownRow = hasNoUnknownVector . coerce
-
-hasNoUnknownSquare :: Square -> Bool
-hasNoUnknownSquare = hasNoUnknownVector . getMatrixAsVector . coerce
-
 getRow :: Int -> Grid -> Row
 getRow n
   | n > 0 && n <= 9 = Row . M.getRow n . coerce
   | otherwise       = error "Indexing row outside of grid"
 
-getRows :: Grid -> [Row]
-getRows = (getRow <$> [1..9] <*>) . pure
-
 getColumn :: Int -> Grid -> Column
 getColumn n
   | n > 0 && n <= 9 = Column . M.getCol n . coerce
@@ -130,29 +103,20 @@ getColumn n
 
 getSquare :: Int -> Grid -> Square
 getSquare n
-  | n > 0 && n <= 9 = let !sr = ((n-1) `div` 3) * 3 + 1
+  | n > 0 && n <= 9 = let !sr = (n+2) `div` 3
                           !er = sr + 2
-                          !sc = ((n-1) `mod` 3) * 3 + 1
+                          !sc = (n+2) `mod` 3 + 1
                           !ec = sc + 2
                       in Square . submatrix sr er sc ec . coerce
   | otherwise       = error "Indexing square outside of grid"
 
 isValid :: Grid -> Bool
-isValid g = and $ flip map [1..9]
+isValid g = and $ flip (parMap rpar) [1..9]
                    (\i ->
                       let row = isValidRow (getRow i g)
                           col = isValidColumn (getColumn i g)
                           square = isValidSquare (getSquare i g)
-                      in row && col && square
-                   )
-            
-hasNoUnknown :: Grid -> Bool
-hasNoUnknown g = and $ flip map [1..9]
-                   (\i ->
-                      let row = hasNoUnknownRow (getRow i g)
-                          col = hasNoUnknownColumn (getColumn i g)
-                          square = hasNoUnknownSquare (getSquare i g)
-                      in row && col && square
+                      in col `par` square `par` row && col && square
                    )
 
 updateCell :: Int -> Int -> Cell -> Grid -> Grid
@@ -164,38 +128,4 @@ updateCell n m
         error "Updating non unkown value"
   | otherwise = error "Updating cell outside of grid"
   
-leftToPlace :: Grid -> [Cell]
-leftToPlace =
-  V.toList .
-  (\v -> numbers >>= \i -> flip V.replicate i . (9-) . V.length $ V.elemIndices i v) .
-  getMatrixAsVector .
-  coerce
 
-leftToPlaceRow :: Row -> [Cell]
-leftToPlaceRow =
-  ((V.toList numbers) \\ ) .
-  V.toList .
-  coerce
-
-findEmptyRow :: Row -> [(Int)]
-findEmptyRow = V.toList . ((+1) <$>) . V.findIndices (== Unknown) . coerce
-
-findEmpty :: Grid -> [(Int,Int)]
-findEmpty = V.toList . ((\n -> ((n) `div` 9 + 1, n `mod` 9 + 1)) <$>) . V.findIndices (== Unknown) . getMatrixAsVector . coerce
-
-place :: Cell -> (Int,Int) -> Grid -> Grid
-place c pos g = coerce $ setElem c pos (coerce g)
-  
-solve :: Grid -> Grid
-solve = runEval . go . pure
-  where go :: [Grid] -> Eval Grid
-        go gs =
-          case filter hasNoUnknown gs of
-            [] -> 
-                parList rpar (gs >>= \g -> zip [(1 :: Int)..9] (getRows g) >>= \(i,v) -> findEmptyRow v >>= \j -> leftToPlaceRow v >>= pure . (i,j,,g)) >>=
-                parList rdeepseq . (>>= \(i,j,c,g) -> pure $ place c (i,j) g) >>=
-                filterM (pure . isValid) >>= \case
-                [] -> error "Uhoh"
-                xs -> go xs
-
-            (x:_) -> () `pseq` pure x

valid.sudoku

@@ -1,9 +1,9 @@
-1 2 3 4 5 X 7 8 9
-4 5 6 7 X 9 1 2 3
-7 8 X 1 2 X 4 5 6
-2 X 4 5 6 7 X 9 1
-5 6 X 8 9 X 2 3 4
-8 9 X 2 X 4 5 6 7
-6 7 X 9 1 2 X 4 5
-9 X 2 3 4 5 X X 8
-3 4 5 6 7 8 X 1 2
+1 2 3 4 5 6 X 8 9
+2 X 4 5 6 X 8 X 1
+3 4 5 X 7 8 9 1 2
+4 5 6 7 8 X 1 2 3
+5 X X 8 9 1 2 3 4
+6 7 8 9 X 2 3 X X
+7 X 9 1 2 3 X X X
+8 9 1 X 3 4 5 6 X
+9 1 2 3 4 5 6 7 8