Copyright | (c) siers |
---|---|
License | GPL-3 |
Maintainer | wimuan@email.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Pipemaze
Description
A dynamic solver of pipe mazes with an internal priority
queue based on scores, position and priority creation order and much more.
Synopsis
- type Direction = Int
- type Rotation = Int
- type Pix = Word8
- type Cursor = (Int, Int)
- type Fursor = Int
- data MMaze = MMaze {}
- data Piece = Piece {}
- type Choices = Int
- type PartId = Fursor
- data Continue = Continue {}
- type Priority = IntMap Fursor
- type Continues = IntMap Continue
- data Components
- = Components (IntMap Int)
- | Components' (IntMap IntSet)
- data Unwind
- data Progress = Progress {}
- data Island = Island {
- iId :: Int
- iSize :: Int
- iConts :: [Continue]
- iBounds :: IntSet
- iSolutions :: [IslandSolution]
- iChoices :: Int
- data IslandSolution = IslandSolution {
- icConnections :: [Set PartId]
- icComponents :: IntMap Int
- icHints :: [Unwind]
- type Bounds = Maybe (Fursor -> Bool)
- data SolveMode
- data Configuration = Configuration {}
- type Solver = Reader Configuration
- type SolverT = ReaderT Configuration IO
- parse :: String -> IO MMaze
- mazeStore :: MonadIO m => MMaze -> String -> m ()
- mazeBounded :: MMaze -> Cursor -> Bool
- mazeCursor :: Width -> Fursor -> Cursor
- mazeFursor :: Width -> Cursor -> Fursor
- mazeRead :: MonadIO m => MMaze -> Fursor -> m Piece
- mazeModify :: MonadIO m => MMaze -> (Piece -> Piece) -> Fursor -> m ()
- mazeClone :: MonadIO m => MMaze -> m MMaze
- mazeSolve :: MonadIO m => MMaze -> Continue -> m Unwind
- mazeDelta :: Cursor -> Direction -> Cursor
- mazeFDelta :: Int -> Fursor -> Direction -> Fursor
- mazeEquate :: MonadIO m => MMaze -> PartId -> [Fursor] -> m [Unwind]
- mazePop :: MonadIO m => MMaze -> Unwind -> m ()
- partEquate :: MonadIO m => MMaze -> PartId -> m PartId
- renderColor :: MonadIO m => MMaze -> m ()
- renderStr :: MMaze -> IO String
- renderImage' :: String -> Progress -> SolverT Progress
- traceBoard :: Continue -> Progress -> SolverT Progress
- directions :: [Rotation]
- rotations :: [Rotation]
- charMap :: Map Char Pix
- pixMap :: Map Pix Char
- pixRotations :: Pix -> [Rotation]
- pixDirections :: Bits p => p -> [Direction]
- directionsPix :: Integral i => [Direction] -> i
- toPix :: Char -> Pix
- toChar :: Pix -> Char
- rotate :: Rotation -> Pix -> Pix
- pixValid :: (Pix, Pix, Rotation, Direction) -> Bool
- validateDirection :: Pix -> Rotation -> (Piece, Direction) -> Bool
- pieceChoices :: MMaze -> Cursor -> IO Choices
- compInsert :: Continue -> Components -> Components
- compRemove :: PartId -> Fursor -> Components -> Components
- compEquate :: PartId -> [PartId] -> Components -> Components
- compAlive :: PartId -> Components -> Bool
- compConnected :: PartId -> Components -> [Fursor]
- compCounts :: Components -> IntMap Int
- deltaContinue :: Continue -> Int -> Fursor -> Direction -> Piece -> Maybe Continue -> Continue
- prioritizeDeltas :: Width -> Progress -> Continue -> SolverT Progress
- rescoreContinue :: Bounds -> Width -> Continue -> Continue
- prioritizeContinue :: Progress -> Fursor -> (Maybe Continue -> Continue) -> Solver Progress
- prioritizeContinues :: Progress -> [(Fursor, Maybe Continue -> Continue)] -> Solver Progress
- pieceDead :: MonadIO m => MMaze -> Components -> Fursor -> Pix -> Choices -> m Bool
- findContinue :: Progress -> Solver (Maybe Continue)
- popContinue :: Progress -> Progress
- type FillNext m s = MMaze -> Cursor -> Piece -> [(Piece, Direction)] -> StateT s m [Cursor]
- flood :: MonadIO m => Monoid s => FillNext m s -> MMaze -> Cursor -> m (Set Cursor, s)
- islandize :: Progress -> SolverT Progress
- islandConnectivityRefinement :: [IslandSolution] -> [IslandSolution]
- islandChoices :: MMaze -> Progress -> Island -> SolverT Island
- islands :: MonadIO m => Progress -> m [Island]
- solveContinue :: Progress -> Continue -> SolverT Progress
- backtrack :: MonadIO m => Progress -> m (Maybe (Progress, Continue))
- solve' :: Progress -> SolverT (Maybe Progress)
- islandChoicesParallel :: Progress -> [MMaze] -> [Island] -> SolverT [Island]
- solveDetParallel :: Int -> MMaze -> SolverT Progress
- initProgress :: MMaze -> SolverT Progress
- solve :: MMaze -> SolverT MMaze
- verify :: MMaze -> SolverT Bool
- storeBad :: Int -> MMaze -> MMaze -> SolverT MMaze
- rotateStr :: Int -> MMaze -> MMaze -> IO [Text]
- configuration :: MMaze -> IO Configuration
- pļāpātArWebsocketu :: [Int] -> Bool -> ClientApp ()
- solveFile :: String -> IO ()
- main :: IO ()
High-level description
The goal of the solver is to find the Rotation
of each Pix
in the grid to create a connected undirected graph.
Just like in this game here: https://www.puzzle-pipes.com/
- Each cursor has four nearby cursors – top, right, bottom, left, which wil be refered to as
directions
ordeltas
. - The
Cursor
s in one square's distance in adirection
with respect to some cursorc
may also be calleddeltas
. - The number of valid rotations of a piece are encoded in
Choices
. - Each
Piece
contains initialChoices
which are bit-packed infoinitChoices
, - Distinct graphs are being refered to as components and each has a distinct
PartId
computed by the smallestFursor
of the graph. https://en.wikipedia.org/wiki/Component_(graph_theory) - All 'Component''s open ends are refered to as
Continue
s, which then later get stored inContinue
to make a piece "active", makingPiece
information is no longer necessary. - The cursors are stored as flat indexes (
Fursor
) to make comparison computations faster (IntMap
). Conversions toCursor
are possible viamazeCursor
,mazeFursor
. Progress
holds main data of the backtracker, the only mutable data isMMaze
, which stores correctly solvedPix
andpartId
s which get updated as graphs become joined.
Solving each piece gives you hints about surrounding pieces,
so solving them by diagonals (rescoreContinue
) is more effective than solving in an arbitrary order.
If the connectivity of the pieces is efficiently computed (PartId
/ partEquate
),
the "open ends" (Continues
) have a good prioritization and the disconnected solves are efficiently (computed
and then) discarded (pieceDead
/ compAlive
), you can solve around 98% of the level 6 maze determinstically.
Islands
Island is a patch of unsolved pieces, each one has its own number of solutions.
Solving it by backtracking makes the search space multiply after guessing one island after another in a single Progress
.
Instead, you can force the backtracker to only count the solutions of a single island with cBounds
.
If you group the solutions (islandConnectivityRefinement
), many islands have a single best or equivalent solution.
solveTrivialIslands
runs the backtracker for all "simple" islands, then recomputes all islands, then repeats.
The even simpler solveIslandStatic
solves all the pieces that remain the same in all IslandSolution
s.
Running either solves level 6 very fast and solveIslandStatic
(+ solve
) is a little faster.
Grouping in islandConnectivityRefinement
takes place in two steps: group by equal Components
,
refine icConnections
by their partition PartialOrd
.
Bugs and improvements
partId
origin
is a little awkward, butpipe
char
is even more soContinue
s can be removed, if their old versions are added inUnwind
s- A separate priority list could be mae for choices = 1
- All
IslandSolution
s are getting recomputed after each determinstic solve, which can be fixed, but it's already very fast IslandSolution
could be recomputable without running main solver, just by checking that nothing gets disconnected after running it through all theUnwind
s of last solve.- Backtracking on
IslandSolution
could be implemented IslandSolution
s could be chosen by just checking that theicConnections
connect some graph constructed from islands.IslandSolution
could have a heuristic for the number of solutions without solving all solutions by solving in breadth-wise first choices – '[Progress]' and only then depth-wise.
Types
The maze symbol (has four edges) bit-packed in charMap
as 2^d
per direction, mirrored in shiftL 4
to help bit rotation
X – ╋ -- 4 edges I – ━, ┃ -- 2 edges L – ┏, ┛, ┓, ┗ -- 2 edges T – ┣, ┫, ┳, ┻ -- 3 edges i – ╸, ╹, ╺, ╻ -- 1 edge
Mutable maze operated on by functions in section "Maze operations"
Constructors
MMaze | |
Fields
|
Instances
Eq MMaze Source # | |
Ord MMaze Source # | |
Show MMaze Source # | unlawful |
Generic MMaze Source # | |
type Rep MMaze Source # | |
Defined in Pipemaze type Rep MMaze = D1 ('MetaData "MMaze" "Pipemaze" "main" 'False) (C1 ('MetaCons "MMaze" 'PrefixI 'True) (((S1 ('MetaSel ('Just "board") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IOVector Piece)) :*: S1 ('MetaSel ('Just "width") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :*: (S1 ('MetaSel ('Just "height") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "size") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int))) :*: ((S1 ('MetaSel ('Just "sizeLen") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "level") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :*: (S1 ('MetaSel ('Just "trivials") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Fursor]) :*: (S1 ('MetaSel ('Just "mazeId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 String) :*: S1 ('MetaSel ('Just "time") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 TimeSpec)))))) |
Constructors
Piece | |
Instances
Eq Piece Source # | |
Ord Piece Source # | |
Show Piece Source # | |
Generic Piece Source # | |
GStorable Piece Source # | |
Defined in Pipemaze Methods galignment :: Piece -> Int gpeekByteOff :: Ptr b -> Int -> IO Piece gpokeByteOff :: Ptr b -> Int -> Piece -> IO () | |
ToJSON Piece Source # | |
Defined in Pipemaze Methods toEncoding :: Piece -> Encoding toJSONList :: [Piece] -> Value toEncodingList :: [Piece] -> Encoding | |
Eq (IOVector Piece) Source # | unlawful instance |
Ord (IOVector Piece) Source # | unlawful instance |
Defined in Pipemaze Methods compare :: IOVector Piece -> IOVector Piece -> Ordering (<) :: IOVector Piece -> IOVector Piece -> Bool (<=) :: IOVector Piece -> IOVector Piece -> Bool (>) :: IOVector Piece -> IOVector Piece -> Bool (>=) :: IOVector Piece -> IOVector Piece -> Bool | |
type Rep Piece Source # | |
Defined in Pipemaze type Rep Piece = D1 ('MetaData "Piece" "Pipemaze" "main" 'False) (C1 ('MetaCons "Piece" 'PrefixI 'True) ((S1 ('MetaSel ('Just "pipe") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Pix) :*: S1 ('MetaSel ('Just "solved") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool)) :*: (S1 ('MetaSel ('Just "partId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 PartId) :*: (S1 ('MetaSel ('Just "connected") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "initChoices") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Choices))))) |
Choices
is bit-packed info related to the valid rotations of a picce.
In MSB order: (valid) rotation count 2b, invalid rotation directions 4b (unused), solved requirements 4b, solved neighbours 4b
PartId
distinguishes the graph component by their smallest known Cursor
by its Ord
(unique),
so it is the same as its cursor initially. They're marked in origin
ahead of solved
s.
PartId
in origin
is only to be used through partEquate
, because origin
isn't being
updated after components have connected.
Continue represents the piece that should be solved next according to Priority
, which is an open end of a component
(or starts one). Created in initProgress
or deltaContinue
.
Constructors
Continue | |
Fields
|
Instances
Eq Continue Source # | |
Ord Continue Source # | |
Show Continue Source # | |
Generic Continue Source # | |
ToJSON Continue Source # | |
Defined in Pipemaze Methods toEncoding :: Continue -> Encoding toJSONList :: [Continue] -> Value toEncodingList :: [Continue] -> Encoding | |
type Rep Continue Source # | |
Defined in Pipemaze type Rep Continue = D1 ('MetaData "Continue" "Pipemaze" "main" 'False) (C1 ('MetaCons "Continue" 'PrefixI 'True) (((S1 ('MetaSel ('Just "cursor") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Fursor) :*: S1 ('MetaSel ('Just "char") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Pix)) :*: (S1 ('MetaSel ('Just "origin") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 PartId) :*: S1 ('MetaSel ('Just "score") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int))) :*: ((S1 ('MetaSel ('Just "created") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "island") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)) :*: (S1 ('MetaSel ('Just "area") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "choices") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Choices))))) |
type Priority = IntMap Fursor Source #
Continue
priority queue, inserted by prioritizeContinue
, found by findContinue
, popped by popContinue
.
data Components Source #
The index of components' continues by their PartId
(which are always up-to-date).
Constructors
Components (IntMap Int) | marginally faster, but less info |
Components' (IntMap IntSet) |
Instances
Eq Components Source # | |
Defined in Pipemaze | |
Ord Components Source # | |
Defined in Pipemaze Methods compare :: Components -> Components -> Ordering (<) :: Components -> Components -> Bool (<=) :: Components -> Components -> Bool (>) :: Components -> Components -> Bool (>=) :: Components -> Components -> Bool max :: Components -> Components -> Components min :: Components -> Components -> Components | |
Show Components Source # | |
Defined in Pipemaze Methods showsPrec :: Int -> Components -> ShowS show :: Components -> String showList :: [Components] -> ShowS | |
Generic Components Source # | |
Defined in Pipemaze Associated Types type Rep Components :: Type -> Type | |
ToJSON Components Source # | |
Defined in Pipemaze Methods toJSON :: Components -> Value toEncoding :: Components -> Encoding toJSONList :: [Components] -> Value toEncodingList :: [Components] -> Encoding | |
type Rep Components Source # | |
Defined in Pipemaze type Rep Components = D1 ('MetaData "Components" "Pipemaze" "main" 'False) (C1 ('MetaCons "Components" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IntMap Int))) :+: C1 ('MetaCons "Components'" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IntMap IntSet)))) |
For backtracking on the mutable MMaze
and for extracting hints.
Instances
Eq Unwind Source # | |
Ord Unwind Source # | |
Show Unwind Source # | |
Generic Unwind Source # | |
ToJSON Unwind Source # | |
Defined in Pipemaze Methods toEncoding :: Unwind -> Encoding toJSONList :: [Unwind] -> Value toEncodingList :: [Unwind] -> Encoding | |
type Rep Unwind Source # | |
Defined in Pipemaze type Rep Unwind = D1 ('MetaData "Unwind" "Pipemaze" "main" 'False) (C1 ('MetaCons "UnSolve" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Fursor) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Pix) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Pix))) :+: C1 ('MetaCons "UnEquate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Fursor) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 PartId)))) |
Constructors
Progress | |
Fields
|
Constructors
Island | |
Fields
|
Instances
Eq Island Source # | |
Ord Island Source # | |
Show Island Source # | |
Generic Island Source # | |
ToJSON Island Source # | |
Defined in Pipemaze Methods toEncoding :: Island -> Encoding toJSONList :: [Island] -> Value toEncodingList :: [Island] -> Encoding | |
type Rep Island Source # | |
Defined in Pipemaze type Rep Island = D1 ('MetaData "Island" "Pipemaze" "main" 'False) (C1 ('MetaCons "Island" 'PrefixI 'True) ((S1 ('MetaSel ('Just "iId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "iSize") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "iConts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Continue]))) :*: (S1 ('MetaSel ('Just "iBounds") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 IntSet) :*: (S1 ('MetaSel ('Just "iSolutions") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [IslandSolution]) :*: S1 ('MetaSel ('Just "iChoices") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int))))) |
data IslandSolution Source #
IslandSolution represent a solution for an island with a representative progress.
The icConnections
are a partition of the components the island joined.
Partitions have a partial ordering called _refinement_ with which you can group iSolutions
.
https://en.wikipedia.org/wiki/Partition_of_a_set#Refinement_of_partitions
Constructors
IslandSolution | |
Fields
|
Instances
Eq IslandSolution Source # | |
Defined in Pipemaze Methods (==) :: IslandSolution -> IslandSolution -> Bool (/=) :: IslandSolution -> IslandSolution -> Bool | |
Ord IslandSolution Source # | |
Defined in Pipemaze Methods compare :: IslandSolution -> IslandSolution -> Ordering (<) :: IslandSolution -> IslandSolution -> Bool (<=) :: IslandSolution -> IslandSolution -> Bool (>) :: IslandSolution -> IslandSolution -> Bool (>=) :: IslandSolution -> IslandSolution -> Bool max :: IslandSolution -> IslandSolution -> IslandSolution min :: IslandSolution -> IslandSolution -> IslandSolution | |
Show IslandSolution Source # | |
Defined in Pipemaze Methods showsPrec :: Int -> IslandSolution -> ShowS show :: IslandSolution -> String showList :: [IslandSolution] -> ShowS | |
Generic IslandSolution Source # | |
Defined in Pipemaze Associated Types type Rep IslandSolution :: Type -> Type | |
PartialOrd IslandSolution Source # | |
Defined in Pipemaze Methods leq :: IslandSolution -> IslandSolution -> Bool comparable :: IslandSolution -> IslandSolution -> Bool | |
ToJSON IslandSolution Source # | |
Defined in Pipemaze Methods toJSON :: IslandSolution -> Value toEncoding :: IslandSolution -> Encoding toJSONList :: [IslandSolution] -> Value toEncodingList :: [IslandSolution] -> Encoding | |
type Rep IslandSolution Source # | |
Defined in Pipemaze type Rep IslandSolution = D1 ('MetaData "IslandSolution" "Pipemaze" "main" 'False) (C1 ('MetaCons "IslandSolution" 'PrefixI 'True) (S1 ('MetaSel ('Just "icConnections") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Set PartId]) :*: (S1 ('MetaSel ('Just "icComponents") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (IntMap Int)) :*: S1 ('MetaSel ('Just "icHints") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Unwind])))) |
Amalgamation of the flags "determinstic", "save history" and "deprioritize unbounded continues"
(it's for parallelism, see rescoreContinue
).
data Configuration Source #
type Solver = Reader Configuration Source #
type SolverT = ReaderT Configuration IO Source #
Maze operations
mazeBounded :: MMaze -> Cursor -> Bool Source #
mazeCursor :: Width -> Fursor -> Cursor Source #
mazeFursor :: Width -> Cursor -> Fursor Source #
mazeEquate :: MonadIO m => MMaze -> PartId -> [Fursor] -> m [Unwind] Source #
Connects PartId
s on the board
partEquate :: MonadIO m => MMaze -> PartId -> m PartId Source #
Looks up the fixed point of PartId
(i.e. when it points to itself)
Tracing and rendering
renderColor :: MonadIO m => MMaze -> m () Source #
Print unicode maze with colorized ANSI escape sequences to stdout.
renderImage' :: String -> Progress -> SolverT Progress Source #
The output format is: images/lvl%i-%s-%0*i-%s.png level mazeId (sizeLen iter) name
traceBoard :: Continue -> Progress -> SolverT Progress Source #
Tracing at each freq=
step with debug=
environment variables.
Modes: 1. print stats / 2. print maze with terminal escape code codes / 3. as 2., but with clear-screen before / 4. as 1., but with image output / 5. as 4., but only after islands have started
Pixel model
directions :: [Rotation] Source #
pixRotations :: Pix -> [Rotation] Source #
This accounts for some piece's rotational symmetry
pixDirections :: Bits p => p -> [Direction] Source #
directionsPix :: Integral i => [Direction] -> i Source #
Pixel solving
pieceChoices :: MMaze -> Cursor -> IO Choices Source #
Compute initial rotation fields for a piece's Choices
Component indexing
compInsert :: Continue -> Components -> Components Source #
compRemove :: PartId -> Fursor -> Components -> Components Source #
compEquate :: PartId -> [PartId] -> Components -> Components Source #
compAlive :: PartId -> Components -> Bool Source #
compConnected :: PartId -> Components -> [Fursor] Source #
compCounts :: Components -> IntMap Int Source #
Continue operations
deltaContinue :: Continue -> Int -> Fursor -> Direction -> Piece -> Maybe Continue -> Continue Source #
prioritizeDeltas :: Width -> Progress -> Continue -> SolverT Progress Source #
Calls prioritizeContinue
on nearby pieces (delta = 1)
rescoreContinue :: Bounds -> Width -> Continue -> Continue Source #
Recalculates the Continue
s score, less is better (because of deleteFindMin
in findContinue
).
score = (0 - island << 17 + (choices << (15 - choicesCount)) + x + y) << 32 + created
prioritizeContinue :: Progress -> Fursor -> (Maybe Continue -> Continue) -> Solver Progress Source #
prioritizeContinues :: Progress -> [(Fursor, Maybe Continue -> Continue)] -> Solver Progress Source #
Inserts or reprioritizes Continue
pieceDead :: MonadIO m => MMaze -> Components -> Fursor -> Pix -> Choices -> m Bool Source #
Check if Continue
is about to become separated from the rest of the graph.
Island computations
type FillNext m s = MMaze -> Cursor -> Piece -> [(Piece, Direction)] -> StateT s m [Cursor] Source #
The generic paint of the flood
fill.
flood :: MonadIO m => Monoid s => FillNext m s -> MMaze -> Cursor -> m (Set Cursor, s) Source #
Four-way flood fill with FillNext
as the "paint". The initial piece is assumed to be valid FillNext.
islandize :: Progress -> SolverT Progress Source #
Set low priority to all continues with island = 1.
islandChoices :: MMaze -> Progress -> Island -> SolverT Island Source #
Computes and set iChoices
/iSolutions
for the island, but also modifies maze with icHints
if len choices == 1.
Backtracker
solveContinue :: Progress -> Continue -> SolverT Progress Source #
Solves a valid piece, mutates the maze and sets unwind. Inefficient access: partEquate reads the same data as islands reads. (All functions within this function are inlined)
solve' :: Progress -> SolverT (Maybe Progress) Source #
Solves pieces by backtracking, stops when the maze is solved or constraints met.
Metasolver
solveDetParallel :: Int -> MMaze -> SolverT Progress Source #
Sovles deterministic parts of the maze in parallel.
Main
configuration :: MMaze -> IO Configuration Source #
Create Configuration
from environment variables, create image output directory.
pļāpātArWebsocketu :: [Int] -> Bool -> ClientApp () Source #
Gets passwords for solved levels from the maze server.