Add gen to solve

Author: leynier

app/Main.hs

@@ -1,10 +1,16 @@
 module Main where
 
+import System.Random
+
 import Structures
 import Algorithms
 
 
 main = do 
+        let rand = randomIO :: IO Int
+        seed <- rand
+        let gen = mkStdGen seed
+
         let m = generate
-        let sol = solve m
+        let sol = solve m gen
         print sol

hidato.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1adf0231ee1c9c3fa35bb688d8f64a8891b7f4ed5a43a7f6bad46e2a7c24f6c1
+-- hash: 8990a2fc1a1f4fa5cf6bcf0dc27fc8585348d19663dd6d611e9d1f7fb613dc4c
 
 name:           hidato
 version:        0.1.0.0
@@ -35,6 +35,7 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
+    , random
   default-language: Haskell2010
 
 executable hidato-exe
@@ -48,6 +49,7 @@ executable hidato-exe
       base >=4.7 && <5
     , containers
     , hidato
+    , random
   default-language: Haskell2010
 
 test-suite hidato-test
@@ -62,4 +64,5 @@ test-suite hidato-test
       base >=4.7 && <5
     , containers
     , hidato
+    , random
   default-language: Haskell2010

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://https://github.
 dependencies:
 - base >= 4.7 && < 5
 - containers
+- random
 
 library:
   source-dirs: src

src/Algorithms.hs

@@ -4,6 +4,7 @@ module Algorithms
 , solveAll
 ) where
 
+import System.Random
 import Structures
 import Data.Set (Set, lookupMin, lookupMax)
 import qualified Data.Set as Set
@@ -14,10 +15,10 @@ import qualified Data.Map as Map
 generate :: Matrix
 generate = read "{. x x x x x x x x \n . 8 x x x x x x x \n . . 11 x x x x x x \n 29 . 10 . x x x x x \n 30 . . . . x x x x \n . 31  1 38  .  . x x x \n . 32 . . 39 41 . x x \n . . . 22 . . 42 . x \n . . . . . . . 44 45}" :: Matrix
 
-stepMatrix :: Int -> Matrix -> Cell -> Map Int Cell -> [(Matrix, Cell)]
-stepMatrix step m@(Matrix rs cs ma) prevCell map = if Map.notMember step map
+stepMatrix :: Int -> Matrix -> Cell -> Map Int Cell -> StdGen -> [(Matrix, Cell)]
+stepMatrix step m@(Matrix rs cs ma) prevCell map gen = if Map.notMember step map
                         then [
-                              (Matrix rs cs (Set.insert cell ma), cell) | cell <- getAdjacents prevCell rs cs step,
+                              (Matrix rs cs (Set.insert cell ma), cell) | cell <- getAdjacents prevCell rs cs step gen,
                               let actCell = Set.elemAt (Set.findIndex cell $ ma) ma,
                               value actCell == 0
                         ]
@@ -35,16 +36,16 @@ buildMap ma@(Matrix r c m) = Set.foldl (\acc cell -> Map.insert (value cell) cel
 --                                                       | matrix <- stepMatrix step actualMatrix]
 --                                      in solveRecursiveBFS (queue ++ toAdd)
 
-solveRecursiveDFS :: Matrix -> Int -> Cell -> Int -> Map Int Cell -> [Matrix]
-solveRecursiveDFS actualMatrix step prevCell obs map
+solveRecursiveDFS :: Matrix -> Int -> Cell -> Int -> Map Int Cell -> StdGen -> [Matrix]
+solveRecursiveDFS actualMatrix step prevCell obs map gen
       | step == obs + 1 = [actualMatrix]
-      | otherwise = let toAdd = stepMatrix step actualMatrix prevCell map
-                    in concat [ solveRecursiveDFS matrix (step + 1) prevCell obs map | (matrix, prevCell) <- toAdd ]
+      | otherwise = let toAdd = stepMatrix step actualMatrix prevCell map gen
+                    in concat [ solveRecursiveDFS matrix (step + 1) prevCell obs map gen | (matrix, prevCell) <- toAdd ]
 
-solveAll :: Matrix -> [Matrix]
-solveAll m = solveRecursiveDFS m 1 (Cell 0 0 0) ((rows m) * (columns m)  - countObstacles m) $ buildMap m
+solveAll :: Matrix -> StdGen -> [Matrix]
+solveAll m gen = solveRecursiveDFS m 1 (Cell 0 0 0) ((rows m) * (columns m)  - countObstacles m) (buildMap m) gen
 
-solve :: Matrix -> Matrix
-solve m = let solves = solveAll m
+solve :: Matrix -> StdGen -> Matrix
+solve m gen = let solves = solveAll m gen
           in case solves of [] -> error "Solve not found"
                             (x: xs) -> x

src/Structures.hs

@@ -16,6 +16,7 @@ import Data.Char (isDigit)
 import Data.List
 import Data.Set (Set, lookupMin, lookupMax)
 import qualified Data.Set as Set
+import System.Random
 
 data Cell = Cell { row :: Int
                 , column :: Int
@@ -50,8 +51,8 @@ instance Read Cell where
             [(Cell row column value, rest7) | 
                 opar == '(' && comma1 == comma2 && comma2 == ',' && cpar == ')']
 
-getAdjacents :: Cell -> Int -> Int -> Int -> [Cell]
-getAdjacents (Cell r c v) rs cs s = [Cell nr nc s | dr <- [-1, 0, 1], dc <- [-1, 0, 1], let (nr, nc) = (r + dr, c + dc), nr > 0, nr <= rs, nc > 0, nc <= cs]
+getAdjacents :: Cell -> Int -> Int -> Int -> StdGen -> [Cell]
+getAdjacents (Cell r c v) rs cs s gen = [Cell nr nc s | dr <- [-1, 0, 1], dc <- [-1, 0, 1], let (nr, nc) = (r + dr, c + dc), nr > 0, nr <= rs, nc > 0, nc <= cs]
 
 isAdjacent :: Cell -> Cell -> Bool
 isAdjacent (Cell f1 c1 v1) (Cell f2 c2 v2)