Copyright(c) siers
LicenseGPL-3
Maintainerwimuan@email.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone

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

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 or deltas.
  • The Cursors in one square's distance in a direction with respect to some cursor c may also be called deltas.
  • The number of valid rotations of a piece are encoded in Choices.
  • Each Piece contains initial Choices which are bit-packed info initChoices,
  • Distinct graphs are being refered to as components and each has a distinct PartId computed by the smallest Fursor of the graph. https://en.wikipedia.org/wiki/Component_(graph_theory)
  • All 'Component''s open ends are refered to as Continues, which then later get stored in Continue to make a piece "active", making Piece information is no longer necessary.
  • The cursors are stored as flat indexes (Fursor) to make comparison computations faster (IntMap). Conversions to Cursor are possible via mazeCursor, mazeFursor.
  • Progress holds main data of the backtracker, the only mutable data is MMaze, which stores correctly solved Pix and partIds 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 IslandSolutions. 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

  • partIdorigin is a little awkward, but pipechar is even more so
  • Continues can be removed, if their old versions are added in Unwinds
  • A separate priority list could be mae for choices = 1
  • All IslandSolutions 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 the Unwinds of last solve.
  • Backtracking on IslandSolution could be implemented
  • IslandSolutions could be chosen by just checking that the icConnections 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

type Direction = Int Source #

Directions: top 0, right 1, bottom 2, left 3

type Rotation = Int Source #

The set of rotation values are the same as directions.

type Pix = Word8 Source #

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

type Cursor = (Int, Int) Source #

type Fursor = Int Source #

data MMaze Source #

Mutable maze operated on by functions in section "Maze operations"

Constructors

MMaze 

Fields

  • board :: IOVector Piece

    flat MVector with implied 2d structure via Cursor/Fursor + index computations

  • width :: Int
     
  • height :: Int
     
  • size :: Int
     
  • sizeLen :: Int

    leading char count for printf %0ni format (~logBase 10 size + 1.5)

  • level :: Int
     
  • trivials :: [Fursor]

    cursors of the edge and X pieces which have only one valid rotation

  • mazeId :: String

    boards data scrambled into a 4-byte hexadecimal field

  • time :: TimeSpec
     

Instances

Instances details
Eq MMaze Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: MMaze -> MMaze -> Bool

(/=) :: MMaze -> MMaze -> Bool

Ord MMaze Source # 
Instance details

Defined in Pipemaze

Methods

compare :: MMaze -> MMaze -> Ordering

(<) :: MMaze -> MMaze -> Bool

(<=) :: MMaze -> MMaze -> Bool

(>) :: MMaze -> MMaze -> Bool

(>=) :: MMaze -> MMaze -> Bool

max :: MMaze -> MMaze -> MMaze

min :: MMaze -> MMaze -> MMaze

Show MMaze Source #

unlawful

Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> MMaze -> ShowS

show :: MMaze -> String

showList :: [MMaze] -> ShowS

Generic MMaze Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep MMaze :: Type -> Type

Methods

from :: MMaze -> Rep MMaze x

to :: Rep MMaze x -> MMaze

type Rep MMaze Source # 
Instance details

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))))))

data Piece Source #

Constructors

Piece 

Fields

Instances

Instances details
Eq Piece Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Piece -> Piece -> Bool

(/=) :: Piece -> Piece -> Bool

Ord Piece Source # 
Instance details

Defined in Pipemaze

Methods

compare :: Piece -> Piece -> Ordering

(<) :: Piece -> Piece -> Bool

(<=) :: Piece -> Piece -> Bool

(>) :: Piece -> Piece -> Bool

(>=) :: Piece -> Piece -> Bool

max :: Piece -> Piece -> Piece

min :: Piece -> Piece -> Piece

Show Piece Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Piece -> ShowS

show :: Piece -> String

showList :: [Piece] -> ShowS

Generic Piece Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Piece :: Type -> Type

Methods

from :: Piece -> Rep Piece x

to :: Rep Piece x -> Piece

GStorable Piece Source # 
Instance details

Defined in Pipemaze

Methods

gsizeOf :: Piece -> Int

galignment :: Piece -> Int

gpeekByteOff :: Ptr b -> Int -> IO Piece

gpokeByteOff :: Ptr b -> Int -> Piece -> IO ()

ToJSON Piece Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: Piece -> Value

toEncoding :: Piece -> Encoding

toJSONList :: [Piece] -> Value

toEncodingList :: [Piece] -> Encoding

Eq (IOVector Piece) Source #

unlawful instance

Instance details

Defined in Pipemaze

Methods

(==) :: IOVector Piece -> IOVector Piece -> Bool

(/=) :: IOVector Piece -> IOVector Piece -> Bool

Ord (IOVector Piece) Source #

unlawful instance

Instance details

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

max :: IOVector Piece -> IOVector Piece -> IOVector Piece

min :: IOVector Piece -> IOVector Piece -> IOVector Piece

type Rep Piece Source # 
Instance details

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)))))

type Choices = Int Source #

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

type PartId = Fursor Source #

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 solveds. PartId in origin is only to be used through partEquate, because origin isn't being updated after components have connected.

data Continue Source #

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

Instances details
Eq Continue Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Continue -> Continue -> Bool

(/=) :: Continue -> Continue -> Bool

Ord Continue Source # 
Instance details

Defined in Pipemaze

Methods

compare :: Continue -> Continue -> Ordering

(<) :: Continue -> Continue -> Bool

(<=) :: Continue -> Continue -> Bool

(>) :: Continue -> Continue -> Bool

(>=) :: Continue -> Continue -> Bool

max :: Continue -> Continue -> Continue

min :: Continue -> Continue -> Continue

Show Continue Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Continue -> ShowS

show :: Continue -> String

showList :: [Continue] -> ShowS

Generic Continue Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Continue :: Type -> Type

Methods

from :: Continue -> Rep Continue x

to :: Rep Continue x -> Continue

ToJSON Continue Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: Continue -> Value

toEncoding :: Continue -> Encoding

toJSONList :: [Continue] -> Value

toEncodingList :: [Continue] -> Encoding

type Rep Continue Source # 
Instance details

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.

type Continues = IntMap Continue Source #

Primary storage of Continue data

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

Instances details
Eq Components Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Components -> Components -> Bool

(/=) :: Components -> Components -> Bool

Ord Components Source # 
Instance details

Defined in Pipemaze

Show Components Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Components -> ShowS

show :: Components -> String

showList :: [Components] -> ShowS

Generic Components Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Components :: Type -> Type

Methods

from :: Components -> Rep Components x

to :: Rep Components x -> Components

ToJSON Components Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: Components -> Value

toEncoding :: Components -> Encoding

toJSONList :: [Components] -> Value

toEncodingList :: [Components] -> Encoding

type Rep Components Source # 
Instance details

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))))

data Unwind Source #

For backtracking on the mutable MMaze and for extracting hints.

Constructors

UnSolve Fursor Pix Pix

Pix before, after (for deployHint)

UnEquate Fursor Bool PartId

connected, PartId after

Instances

Instances details
Eq Unwind Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Unwind -> Unwind -> Bool

(/=) :: Unwind -> Unwind -> Bool

Ord Unwind Source # 
Instance details

Defined in Pipemaze

Methods

compare :: Unwind -> Unwind -> Ordering

(<) :: Unwind -> Unwind -> Bool

(<=) :: Unwind -> Unwind -> Bool

(>) :: Unwind -> Unwind -> Bool

(>=) :: Unwind -> Unwind -> Bool

max :: Unwind -> Unwind -> Unwind

min :: Unwind -> Unwind -> Unwind

Show Unwind Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Unwind -> ShowS

show :: Unwind -> String

showList :: [Unwind] -> ShowS

Generic Unwind Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Unwind :: Type -> Type

Methods

from :: Unwind -> Rep Unwind x

to :: Rep Unwind x -> Unwind

ToJSON Unwind Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: Unwind -> Value

toEncoding :: Unwind -> Encoding

toJSONList :: [Unwind] -> Value

toEncodingList :: [Unwind] -> Encoding

type Rep Unwind Source # 
Instance details

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))))

data Progress Source #

Constructors

Progress 

Fields

  • iter :: Int

    the total number of backtracking iterations (incl. failed ones)

  • depth :: Int

    number of solves, so also the length of unwinds/space

  • priority :: Priority

    priority queue for next guesses (tree, not a heap, because reprioritizing is required)

  • continues :: Continues

    Primary continue store, pointed to by priority (all Continues within must be unique by their cursor)

  • components :: Components

    component continue counts (for quickly computing disconnected components via compAlive)

  • space :: Space

    backtracking's "rewind" + unexplored solution stack; an item per a solve. pop when (last space == [])

  • maze :: MMaze
     

Instances

Instances details
Eq Progress Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Progress -> Progress -> Bool

(/=) :: Progress -> Progress -> Bool

Ord Progress Source # 
Instance details

Defined in Pipemaze

Methods

compare :: Progress -> Progress -> Ordering

(<) :: Progress -> Progress -> Bool

(<=) :: Progress -> Progress -> Bool

(>) :: Progress -> Progress -> Bool

(>=) :: Progress -> Progress -> Bool

max :: Progress -> Progress -> Progress

min :: Progress -> Progress -> Progress

Show Progress Source #

unlawful

Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Progress -> ShowS

show :: Progress -> String

showList :: [Progress] -> ShowS

Generic Progress Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Progress :: Type -> Type

Methods

from :: Progress -> Rep Progress x

to :: Rep Progress x -> Progress

type Rep Progress Source # 
Instance details

Defined in Pipemaze

type Rep Progress

data Island Source #

Island is the patch of unsolved pieces surrounded by solved pieces, computed by flood in islands.

Constructors

Island 

Fields

Instances

Instances details
Eq Island Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: Island -> Island -> Bool

(/=) :: Island -> Island -> Bool

Ord Island Source # 
Instance details

Defined in Pipemaze

Methods

compare :: Island -> Island -> Ordering

(<) :: Island -> Island -> Bool

(<=) :: Island -> Island -> Bool

(>) :: Island -> Island -> Bool

(>=) :: Island -> Island -> Bool

max :: Island -> Island -> Island

min :: Island -> Island -> Island

Show Island Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> Island -> ShowS

show :: Island -> String

showList :: [Island] -> ShowS

Generic Island Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep Island :: Type -> Type

Methods

from :: Island -> Rep Island x

to :: Rep Island x -> Island

ToJSON Island Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: Island -> Value

toEncoding :: Island -> Encoding

toJSONList :: [Island] -> Value

toEncodingList :: [Island] -> Encoding

type Rep Island Source # 
Instance details

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

Instances details
Eq IslandSolution Source # 
Instance details

Defined in Pipemaze

Ord IslandSolution Source # 
Instance details

Defined in Pipemaze

Show IslandSolution Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> IslandSolution -> ShowS

show :: IslandSolution -> String

showList :: [IslandSolution] -> ShowS

Generic IslandSolution Source # 
Instance details

Defined in Pipemaze

Associated Types

type Rep IslandSolution :: Type -> Type

PartialOrd IslandSolution Source # 
Instance details

Defined in Pipemaze

ToJSON IslandSolution Source # 
Instance details

Defined in Pipemaze

Methods

toJSON :: IslandSolution -> Value

toEncoding :: IslandSolution -> Encoding

toJSONList :: [IslandSolution] -> Value

toEncodingList :: [IslandSolution] -> Encoding

type Rep IslandSolution Source # 
Instance details

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]))))

type Bounds = Maybe (Fursor -> Bool) Source #

data SolveMode Source #

Amalgamation of the flags "determinstic", "save history" and "deprioritize unbounded continues" (it's for parallelism, see rescoreContinue).

Instances

Instances details
Eq SolveMode Source # 
Instance details

Defined in Pipemaze

Methods

(==) :: SolveMode -> SolveMode -> Bool

(/=) :: SolveMode -> SolveMode -> Bool

Ord SolveMode Source # 
Instance details

Defined in Pipemaze

Methods

compare :: SolveMode -> SolveMode -> Ordering

(<) :: SolveMode -> SolveMode -> Bool

(<=) :: SolveMode -> SolveMode -> Bool

(>) :: SolveMode -> SolveMode -> Bool

(>=) :: SolveMode -> SolveMode -> Bool

max :: SolveMode -> SolveMode -> SolveMode

min :: SolveMode -> SolveMode -> SolveMode

Show SolveMode Source # 
Instance details

Defined in Pipemaze

Methods

showsPrec :: Int -> SolveMode -> ShowS

show :: SolveMode -> String

showList :: [SolveMode] -> ShowS

data Configuration Source #

Constructors

Configuration 

Fields

type SolverT = ReaderT Configuration IO Source #

Maze operations

parse :: String -> IO MMaze Source #

mazeStore :: MonadIO m => MMaze -> String -> m () Source #

mazeRead :: MonadIO m => MMaze -> Fursor -> m Piece Source #

mazeModify :: MonadIO m => MMaze -> (Piece -> Piece) -> Fursor -> m () Source #

mazeClone :: MonadIO m => MMaze -> m MMaze Source #

mazeSolve :: MonadIO m => MMaze -> Continue -> m Unwind Source #

mazeEquate :: MonadIO m => MMaze -> PartId -> [Fursor] -> m [Unwind] Source #

Connects PartIds on the board

mazePop :: MonadIO m => MMaze -> Unwind -> m () Source #

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.

renderStr :: MMaze -> IO String Source #

Generate uncolorized output

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

rotations :: [Rotation] Source #

directions = rotations = [0, 1, 2, 3]

charMap :: Map Char Pix Source #

pixMap :: Map Pix Char 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 #

toPix :: Char -> Pix Source #

toChar :: Pix -> Char Source #

rotate :: Rotation -> Pix -> Pix Source #

Rotates the Pix to left by n Rotations

Pixel solving

pieceChoices :: MMaze -> Cursor -> IO Choices Source #

Compute initial rotation fields for a piece's Choices

Component indexing

compCounts :: Components -> IntMap Int Source #

Continue operations

prioritizeDeltas :: Width -> Progress -> Continue -> SolverT Progress Source #

Calls prioritizeContinue on nearby pieces (delta = 1)

rescoreContinue :: Bounds -> Width -> Continue -> Continue Source #

Recalculates the Continues score, less is better (because of deleteFindMin in findContinue).

score = (0 - island << 17 + (choices << (15 - choicesCount)) + x + y) << 32 + created

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.

findContinue :: Progress -> Solver (Maybe Continue) Source #

Pops priority by score, deletes from continues.

popContinue :: Progress -> Progress Source #

Pops next Continue from queue.

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.

islands :: MonadIO m => Progress -> m [Island] Source #

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)

backtrack :: MonadIO m => Progress -> m (Maybe (Progress, Continue)) Source #

The initial Progress, space stack, Progress and MMaze backtracking operations. This returns a progress with the first available Continue from space or Nothing. If space is empty, it gets popped, mazePop gets called and it tries again until space is empty.

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.

solve :: MMaze -> SolverT MMaze Source #

Solver main, returns solved maze

Main

rotateStr :: Int -> MMaze -> MMaze -> IO [Text] Source #

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.

solveFile :: String -> IO () Source #

Run solver, likely produce trace output and complain if solve is invalid (verify).

main :: IO () Source #

Executable entry point.