{-|
Module      : AOC
Description : Utility functions commonly used while solving Advent of Code puzzles
Copyright   : (c) M1n3c4rt, 2025
License     : BSD-3-Clause
Maintainer  : vedicbits@gmail.com
Stability   : stable
-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

module Utility.AOC (
    -- * Pathfinding algorithms

    -- $cat1

    shortestDistance,
    shortestPaths,
    shortestDistanceOnMagma,
    shortestPathsOnMagma,
    -- * Neighbour functions

    neighbours4,
    neighbours8,
    neighbours6,
    neighbours26,
    -- * Taxicab (Manhattan) distance

    taxicab2,
    taxicab3,
    -- * Grid enumeration

    -- $cat2

    enumerate,
    enumerateRead,
    enumerateHM,
    enumerateReadHM,
    enumerateFilter,
    enumerateFilterSet,
    -- * Flood fill

    floodFill,
    floodFillWith,
    -- * List selection

    choose,
    permute,
    -- * Extrapolation

    extrapolate,
    -- * Miscellaneous

    range,
    rangeIntersect,
    binToDec
) where

import qualified Data.HashMap.Strict as HM
import Data.Hashable (Hashable)
import qualified Data.Set as S
import qualified Data.Heap as H
import Data.List (permutations, genericIndex)

createMinPrioHeap :: Ord a1 => (a1,a) -> H.MinPrioHeap a1 a
createMinPrioHeap :: forall a1 a. Ord a1 => (a1, a) -> MinPrioHeap a1 a
createMinPrioHeap = (a1, a) -> Heap FstMinPolicy (a1, a)
forall pol item. HeapItem pol item => item -> Heap pol item
H.singleton

-- $cat1

-- All of the following functions return distances as a @Maybe Int@, where @Nothing@ is returned if no path is found.

-- The graph is a @HashMap@ mapping each node to a sequence of (neighbour, edge weight) pairs.


-- | Returns the shortest distance between two nodes in a graph.

shortestDistance :: (Foldable t, Hashable n, Ord a, Num a)
    => HM.HashMap n (t (n, a)) -- ^ Graph

    -> n -- ^ Start node

    -> n -- ^ End node

    -> Maybe a
shortestDistance :: forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
HashMap n (t (n, a)) -> n -> n -> Maybe a
shortestDistance HashMap n (t (n, a))
graph = [HashMap n (t (n, a))] -> n -> n -> Maybe a
forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
[HashMap n (t (n, a))] -> n -> n -> Maybe a
shortestDistanceOnMagma (HashMap n (t (n, a)) -> [HashMap n (t (n, a))]
forall a. a -> [a]
repeat HashMap n (t (n, a))
graph)

-- | Returns the shortest distance between two nodes in a graph and a list of all possible paths from the ending node to the starting node.

-- The starting node is not included in each path.

shortestPaths :: (Foldable t, Hashable n, Ord a, Num a)
    => HM.HashMap n (t (n, a)) -- ^ Graph

    -> n -- ^ Start node

    -> n -- ^ End node

    -> (Maybe a, [[n]])
shortestPaths :: forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
HashMap n (t (n, a)) -> n -> n -> (Maybe a, [[n]])
shortestPaths HashMap n (t (n, a))
graph = [HashMap n (t (n, a))] -> n -> n -> (Maybe a, [[n]])
forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
[HashMap n (t (n, a))] -> n -> n -> (Maybe a, [[n]])
shortestPathsOnMagma (HashMap n (t (n, a)) -> [HashMap n (t (n, a))]
forall a. a -> [a]
repeat HashMap n (t (n, a))
graph)

-- | Returns the shortest distance between two nodes in a list of graphs where the neighbours of a node in any given graph all lie in the succeeding graph. The ending node must be present in each graph.

-- This precondition is not checked.

shortestDistanceOnMagma :: (Foldable t, Hashable n, Ord a, Num a)
    => [HM.HashMap n (t (n, a))] -- ^ Graphs

    -> n -- ^ Start node

    -> n -- ^ End node

    -> Maybe a
shortestDistanceOnMagma :: forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
[HashMap n (t (n, a))] -> n -> n -> Maybe a
shortestDistanceOnMagma [HashMap n (t (n, a))]
graphs n
start n
end = (Maybe a, [[n]]) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, [[n]]) -> Maybe a) -> (Maybe a, [[n]]) -> Maybe a
forall a b. (a -> b) -> a -> b
$ [HashMap n (t (n, a))] -> n -> n -> (Maybe a, [[n]])
forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
[HashMap n (t (n, a))] -> n -> n -> (Maybe a, [[n]])
shortestPathsOnMagma [HashMap n (t (n, a))]
graphs n
start n
end

-- | Returns the shortest distance between two nodes in a list of graphs and a list of all possible paths from the ending node to the starting node. The ending node must be present in each graph.

-- This precondition is not checked.

-- The starting node is not included in each path.

shortestPathsOnMagma :: (Foldable t, Hashable n, Ord a, Num a)
    => [HM.HashMap n (t (n, a))] -- ^ Graphs

    -> n -- ^ Start node

    -> n -- ^ End node

    -> (Maybe a, [[n]])
shortestPathsOnMagma :: forall (t :: * -> *) n a.
(Foldable t, Hashable n, Ord a, Num a) =>
[HashMap n (t (n, a))] -> n -> n -> (Maybe a, [[n]])
shortestPathsOnMagma [HashMap n (t (n, a))]
graphs n
start n
end =
    let initQueue :: MinPrioHeap a n
initQueue = (a, n) -> MinPrioHeap a n
forall a1 a. Ord a1 => (a1, a) -> MinPrioHeap a1 a
createMinPrioHeap (a
0,n
start)
        initPaths :: HashMap n (a, [[a]])
initPaths = n -> (a, [[a]]) -> HashMap n (a, [[a]])
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton n
start (a
0,[[]])
        helper :: (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
helper (HashMap n (a, [[n]])
paths,HeapT (Prio pol (a, n)) (Val pol (a, n))
queue) = case HeapT (Prio pol (a, n)) (Val pol (a, n))
-> Maybe ((a, n), HeapT (Prio pol (a, n)) (Val pol (a, n)))
forall pol item.
HeapItem pol item =>
Heap pol item -> Maybe (item, Heap pol item)
H.view HeapT (Prio pol (a, n)) (Val pol (a, n))
queue of
            Maybe ((a, n), HeapT (Prio pol (a, n)) (Val pol (a, n)))
Nothing -> (HashMap n (a, [[n]])
paths,HeapT (Prio pol (a, n)) (Val pol (a, n))
queue)
            Just ((a
_,n
n),HeapT (Prio pol (a, n)) (Val pol (a, n))
ns) ->
                let Just (a
currentDistance,[[n]]
currentPaths) = n -> HashMap n (a, [[n]]) -> Maybe (a, [[n]])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
n HashMap n (a, [[n]])
paths
                    Just t (n, a)
neighbours = n -> HashMap n (t (n, a)) -> Maybe (t (n, a))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
n ([HashMap n (t (n, a))]
graphs [HashMap n (t (n, a))] -> Int -> HashMap n (t (n, a))
forall a. HasCallStack => [a] -> Int -> a
!! [n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[n]] -> [n]
forall a. HasCallStack => [a] -> a
head [[n]]
currentPaths))
                    updateNeighbour :: (n, a)
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
updateNeighbour (n
n',a
d') (HashMap n (a, [[n]])
p',HeapT (Prio pol (a, n)) (Val pol (a, n))
q') = case n -> HashMap n (a, [[n]]) -> Maybe (a, [[n]])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
n' HashMap n (a, [[n]])
p' of
                        Maybe (a, [[n]])
Nothing -> (n -> (a, [[n]]) -> HashMap n (a, [[n]]) -> HashMap n (a, [[n]])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert n
n' (a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d',([n] -> [n]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (n
n'n -> [n] -> [n]
forall a. a -> [a] -> [a]
:) [[n]]
currentPaths) HashMap n (a, [[n]])
p', (a, n)
-> HeapT (Prio pol (a, n)) (Val pol (a, n))
-> HeapT (Prio pol (a, n)) (Val pol (a, n))
forall pol item.
HeapItem pol item =>
item -> Heap pol item -> Heap pol item
H.insert (a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d',n
n') HeapT (Prio pol (a, n)) (Val pol (a, n))
q')
                        Just (a
d'',[[n]]
ps'') ->
                            if a
d'' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d' then
                                (HashMap n (a, [[n]])
p',HeapT (Prio pol (a, n)) (Val pol (a, n))
q')
                            else if a
d'' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d' then
                                (n -> (a, [[n]]) -> HashMap n (a, [[n]]) -> HashMap n (a, [[n]])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert n
n' (a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d',([n] -> [n]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (n
n'n -> [n] -> [n]
forall a. a -> [a] -> [a]
:) [[n]]
currentPaths) HashMap n (a, [[n]])
p', (a, n)
-> HeapT (Prio pol (a, n)) (Val pol (a, n))
-> HeapT (Prio pol (a, n)) (Val pol (a, n))
forall pol item.
HeapItem pol item =>
item -> Heap pol item -> Heap pol item
H.insert (a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d',n
n') HeapT (Prio pol (a, n)) (Val pol (a, n))
q')
                            else
                                (n -> (a, [[n]]) -> HashMap n (a, [[n]]) -> HashMap n (a, [[n]])
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert n
n' (a
currentDistancea -> a -> a
forall a. Num a => a -> a -> a
+a
d',[[n]]
ps'' [[n]] -> [[n]] -> [[n]]
forall a. [a] -> [a] -> [a]
++ ([n] -> [n]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (n
n'n -> [n] -> [n]
forall a. a -> [a] -> [a]
:) [[n]]
currentPaths) HashMap n (a, [[n]])
p', HeapT (Prio pol (a, n)) (Val pol (a, n))
q')
                in (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
helper ((HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
 -> (HashMap n (a, [[n]]),
     HeapT (Prio pol (a, n)) (Val pol (a, n))))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
forall a b. (a -> b) -> a -> b
$ ((n, a)
 -> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
 -> (HashMap n (a, [[n]]),
     HeapT (Prio pol (a, n)) (Val pol (a, n))))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> t (n, a)
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (n, a)
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
forall {pol}.
HeapItem pol (a, n) =>
(n, a)
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
updateNeighbour (HashMap n (a, [[n]])
paths,HeapT (Prio pol (a, n)) (Val pol (a, n))
ns) t (n, a)
neighbours

    in case n -> HashMap n (a, [[n]]) -> Maybe (a, [[n]])
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup n
end (HashMap n (a, [[n]]) -> Maybe (a, [[n]]))
-> HashMap n (a, [[n]]) -> Maybe (a, [[n]])
forall a b. (a -> b) -> a -> b
$ (HashMap n (a, [[n]]), HeapT (Prio FstMinPolicy (a, n)) n)
-> HashMap n (a, [[n]])
forall a b. (a, b) -> a
fst ((HashMap n (a, [[n]]), MinPrioHeap a n)
-> (HashMap n (a, [[n]]), MinPrioHeap a n)
forall {pol}.
HeapItem pol (a, n) =>
(HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
-> (HashMap n (a, [[n]]), HeapT (Prio pol (a, n)) (Val pol (a, n)))
helper (HashMap n (a, [[n]])
forall {a}. HashMap n (a, [[a]])
initPaths,HeapT (Prio FstMinPolicy (a, n)) n
MinPrioHeap a n
initQueue)) of
        Maybe (a, [[n]])
Nothing -> (Maybe a
forall a. Maybe a
Nothing, [])
        Just (a
d,[[n]]
ps) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
d, [[n]]
ps)

-- | Returns the 4 points orthogonally adjacent to the given point.

neighbours4 :: (Num a, Num b) => (a, b) -> [(a, b)]
neighbours4 :: forall a b. (Num a, Num b) => (a, b) -> [(a, b)]
neighbours4 (a
x,b
y) = [(a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1,b
y),(a
x,b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
1),(a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
1,b
y),(a
x,b
yb -> b -> b
forall a. Num a => a -> a -> a
-b
1)]

-- | Returns the 8 points orthogonally or diagonally adjacent to the given point.

neighbours8 :: (Enum a, Enum b, Eq a, Eq b, Num a, Num b) => (a, b) -> [(a, b)]
neighbours8 :: forall a b.
(Enum a, Enum b, Eq a, Eq b, Num a, Num b) =>
(a, b) -> [(a, b)]
neighbours8 (a
x,b
y) = [(a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
p,b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
q) | a
p <- [-a
1..a
1], b
q <- [-b
1..b
1], a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
|| b
q b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
0]

-- | Returns the 6 points orthogonally adjacent to the given point in 3D space.

neighbours6 :: (Num a, Num b, Num c) => (a, b, c) -> [(a, b, c)]
neighbours6 :: forall a b c. (Num a, Num b, Num c) => (a, b, c) -> [(a, b, c)]
neighbours6 (a
x,b
y,c
z) = [(a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1,b
y,c
z),(a
x,b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
1,c
z),(a
x,b
y,c
zc -> c -> c
forall a. Num a => a -> a -> a
+c
1),(a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
1,b
y,c
z),(a
x,b
yb -> b -> b
forall a. Num a => a -> a -> a
-b
1,c
z),(a
x,b
y,c
zc -> c -> c
forall a. Num a => a -> a -> a
-c
1)]

-- | Returns the 26 points orthogonally or diagonally adjacent to the given point in 3D space.

neighbours26 :: (Enum a, Enum b, Enum c, Eq a, Eq b, Eq c, Num a, Num b, Num c) => (a, b, c) -> [(a, b, c)]
neighbours26 :: forall a b c.
(Enum a, Enum b, Enum c, Eq a, Eq b, Eq c, Num a, Num b, Num c) =>
(a, b, c) -> [(a, b, c)]
neighbours26 (a
x,b
y,c
z) = [(a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
p,b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
q,c
zc -> c -> c
forall a. Num a => a -> a -> a
+c
r) | a
p <- [-a
1..a
1], b
q <- [-b
1..b
1], c
r <- [-c
1..c
1], a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
|| b
q b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
0 Bool -> Bool -> Bool
|| c
r c -> c -> Bool
forall a. Eq a => a -> a -> Bool
/= c
0]

-- | Returns the Taxicab/Manhattan distance between two points in 2D space.

taxicab2 :: Num a => (a, a) -> (a, a) -> a
taxicab2 :: forall a. Num a => (a, a) -> (a, a) -> a
taxicab2 (a
a,a
b) (a
c,a
d) = a -> a
forall a. Num a => a -> a
abs (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
c) a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Num a => a -> a
abs (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
d)

-- | Returns the Taxicab/Manhattan distance between two points in 3D space.

taxicab3 :: Num a => (a, a, a) -> (a, a, a) -> a
taxicab3 :: forall a. Num a => (a, a, a) -> (a, a, a) -> a
taxicab3 (a
a,a
b,a
c) (a
d,a
e,a
f) = a -> a
forall a. Num a => a -> a
abs (a
aa -> a -> a
forall a. Num a => a -> a -> a
-a
d) a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Num a => a -> a
abs (a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
e) a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Num a => a -> a
abs (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
f)

enumerateBase :: (Num y, Num x, Enum y, Enum x) => String -> [((x, y), Char)]
enumerateBase :: forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase String
s =
    let ss :: [String]
ss = String -> [String]
lines String
s
        ys :: [[(y, Char)]]
ys = (y -> String -> [(y, Char)]) -> [y] -> [String] -> [[(y, Char)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\y
n String
l -> (Char -> (y, Char)) -> String -> [(y, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (y
n,) String
l) [y
0..] [String]
ss
        xs :: [[((x, y), Char)]]
xs = ([(y, Char)] -> [((x, y), Char)])
-> [[(y, Char)]] -> [[((x, y), Char)]]
forall a b. (a -> b) -> [a] -> [b]
map ((x -> (y, Char) -> ((x, y), Char))
-> [x] -> [(y, Char)] -> [((x, y), Char)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x
x (y
y,Char
c) -> ((x
x,y
y),Char
c)) [x
0..]) [[(y, Char)]]
ys
    in [[((x, y), Char)]] -> [((x, y), Char)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[((x, y), Char)]]
xs

-- $cat2

-- The following functions operate on a grid of characters as a string with a newline after each row (as seen in several Advent of Code puzzle inputs).


-- | Converts a grid to a list of triples @(x,y,c)@ representing xy coordinates and the character at that location.

enumerate :: (Num y, Num x, Enum y, Enum x) => String -> [(x, y, Char)]
enumerate :: forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [(x, y, Char)]
enumerate = (((x, y), Char) -> (x, y, Char))
-> [((x, y), Char)] -> [(x, y, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\((x
x,y
y),Char
c) -> (x
x,y
y,Char
c)) ([((x, y), Char)] -> [(x, y, Char)])
-> (String -> [((x, y), Char)]) -> String -> [(x, y, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((x, y), Char)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase

-- | Enumerates a grid along with reading the characters (usually as integers).

enumerateRead :: (Read c, Num y, Num x, Enum y, Enum x) => String -> [(x, y, c)]
enumerateRead :: forall c y x.
(Read c, Num y, Num x, Enum y, Enum x) =>
String -> [(x, y, c)]
enumerateRead = (((x, y), Char) -> (x, y, c)) -> [((x, y), Char)] -> [(x, y, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\((x
x,y
y),Char
c) -> (x
x,y
y,String -> c
forall a. Read a => String -> a
read [Char
c])) ([((x, y), Char)] -> [(x, y, c)])
-> (String -> [((x, y), Char)]) -> String -> [(x, y, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((x, y), Char)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase

-- | Enumerates a grid and stores it in a @HashMap@ where points are mapped to the character at that location.

enumerateHM :: (Num x, Num y, Enum x, Enum y, Hashable x, Hashable y) => String -> HM.HashMap (x, y) Char
enumerateHM :: forall x y.
(Num x, Num y, Enum x, Enum y, Hashable x, Hashable y) =>
String -> HashMap (x, y) Char
enumerateHM = [((x, y), Char)] -> HashMap (x, y) Char
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([((x, y), Char)] -> HashMap (x, y) Char)
-> (String -> [((x, y), Char)]) -> String -> HashMap (x, y) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((x, y), Char)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase

-- | Enumerates a grid and stores it in a @HashMap@ along with reading the characters (usually as integers).

enumerateReadHM :: (Num x, Num y, Enum x, Enum y, Hashable x, Hashable y, Read c) => String -> HM.HashMap (x, y) c
enumerateReadHM :: forall x y c.
(Num x, Num y, Enum x, Enum y, Hashable x, Hashable y, Read c) =>
String -> HashMap (x, y) c
enumerateReadHM = [((x, y), c)] -> HashMap (x, y) c
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([((x, y), c)] -> HashMap (x, y) c)
-> (String -> [((x, y), c)]) -> String -> HashMap (x, y) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((x, y), Char) -> ((x, y), c))
-> [((x, y), Char)] -> [((x, y), c)]
forall a b. (a -> b) -> [a] -> [b]
map (\((x
x,y
y),Char
c) -> ((x
x,y
y),String -> c
forall a. Read a => String -> a
read [Char
c])) ([((x, y), Char)] -> [((x, y), c)])
-> (String -> [((x, y), Char)]) -> String -> [((x, y), c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((x, y), Char)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase

-- | Returns a list of points on a grid for which a certain condition is met.

enumerateFilter :: (Num y, Num x, Enum y, Enum x) => (Char -> Bool) -> String -> [(x, y)]
enumerateFilter :: forall y x.
(Num y, Num x, Enum y, Enum x) =>
(Char -> Bool) -> String -> [(x, y)]
enumerateFilter Char -> Bool
f = (((x, y), Char) -> (x, y)) -> [((x, y), Char)] -> [(x, y)]
forall a b. (a -> b) -> [a] -> [b]
map ((x, y), Char) -> (x, y)
forall a b. (a, b) -> a
fst ([((x, y), Char)] -> [(x, y)])
-> (String -> [((x, y), Char)]) -> String -> [(x, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((x, y), Char) -> Bool) -> [((x, y), Char)] -> [((x, y), Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Bool
f (Char -> Bool)
-> (((x, y), Char) -> Char) -> ((x, y), Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y), Char) -> Char
forall a b. (a, b) -> b
snd) ([((x, y), Char)] -> [((x, y), Char)])
-> (String -> [((x, y), Char)]) -> String -> [((x, y), Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [((x, y), Char)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
String -> [((x, y), Char)]
enumerateBase

-- | Returns a set of points on a grid for which a certain condition is met.

enumerateFilterSet :: (Ord x, Ord y, Num y, Num x, Enum y, Enum x) => (Char -> Bool) -> String -> S.Set (x, y)
enumerateFilterSet :: forall x y.
(Ord x, Ord y, Num y, Num x, Enum y, Enum x) =>
(Char -> Bool) -> String -> Set (x, y)
enumerateFilterSet Char -> Bool
f = [(x, y)] -> Set (x, y)
forall a. Ord a => [a] -> Set a
S.fromList ([(x, y)] -> Set (x, y))
-> (String -> [(x, y)]) -> String -> Set (x, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [(x, y)]
forall y x.
(Num y, Num x, Enum y, Enum x) =>
(Char -> Bool) -> String -> [(x, y)]
enumerateFilter Char -> Bool
f

floodFill' :: Ord a => (a -> [a]) -> S.Set a -> S.Set a -> S.Set a -> S.Set a
floodFill' :: forall a. Ord a => (a -> [a]) -> Set a -> Set a -> Set a -> Set a
floodFill' a -> [a]
neighbours Set a
finished Set a
frontier Set a
blocks
    | Set a -> Bool
forall a. Set a -> Bool
S.null Set a
frontier = Set a
finished
    | Bool
otherwise = (a -> [a]) -> Set a -> Set a -> Set a -> Set a
forall a. Ord a => (a -> [a]) -> Set a -> Set a -> Set a -> Set a
floodFill' a -> [a]
neighbours (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
frontier Set a
finished) Set a
newfrontier Set a
blocks
    where
        newfrontier :: Set a
newfrontier = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\a
n -> a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
finished Bool -> Bool -> Bool
|| a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
frontier Bool -> Bool -> Bool
|| a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
blocks) (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set (Set a) -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (Set (Set a) -> Set a) -> Set (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Set a) -> Set a -> Set (Set a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> (a -> [a]) -> a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
neighbours) Set a
frontier

floodFillWith' :: Ord a => (a -> a -> Bool) -> (a -> [a]) -> S.Set a -> S.Set a -> S.Set a
floodFillWith' :: forall a.
Ord a =>
(a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a -> Set a
floodFillWith' a -> a -> Bool
cond a -> [a]
neighbours Set a
finished Set a
frontier
    | Set a -> Bool
forall a. Set a -> Bool
S.null Set a
frontier = Set a
finished
    | Bool
otherwise = (a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a -> Set a
forall a.
Ord a =>
(a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a -> Set a
floodFillWith' a -> a -> Bool
cond a -> [a]
neighbours (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
frontier Set a
finished) Set a
newfrontier
    where
        newfrontier :: Set a
newfrontier = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\a
n -> a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
finished Bool -> Bool -> Bool
|| a
n a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
frontier) (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set (Set a) -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (Set (Set a) -> Set a) -> Set (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Set a) -> Set a -> Set (Set a)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> (a -> [a]) -> a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a
c -> (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
cond a
c) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
neighbours a
c)) Set a
frontier

-- | Applies a flood fill algorithm given a function to generate a point's neighbours, a starting set of points, and a set of points to avoid. Returns a set of all points covered.

floodFill :: Ord a
    => (a -> [a]) -- ^ Neighbour function

    -> S.Set a -- ^ Initial set of points

    -> S.Set a -- ^ Set of points to avoid

    -> S.Set a
floodFill :: forall a. Ord a => (a -> [a]) -> Set a -> Set a -> Set a
floodFill a -> [a]
neighbours = (a -> [a]) -> Set a -> Set a -> Set a -> Set a
forall a. Ord a => (a -> [a]) -> Set a -> Set a -> Set a -> Set a
floodFill' a -> [a]
neighbours Set a
forall a. Set a
S.empty

-- | Applies a flood fill algorithm given a function to generate a point's neighbours, a condition that filters out points generated by said function, and a starting set of points. Returns a set of all points covered.

-- The condition is of the form @a -> a -> Bool@, which returns @True@ if the second point is a valid neighbour of the first point and @False@ otherwise.

floodFillWith :: Ord a
    => (a -> a -> Bool) -- ^ Condition

    -> (a -> [a]) -- ^ Neighbour function

    -> S.Set a -- ^ Initial set of points

    -> S.Set a
floodFillWith :: forall a. Ord a => (a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a
floodFillWith a -> a -> Bool
cond a -> [a]
neighbours = (a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a -> Set a
forall a.
Ord a =>
(a -> a -> Bool) -> (a -> [a]) -> Set a -> Set a -> Set a
floodFillWith' a -> a -> Bool
cond a -> [a]
neighbours Set a
forall a. Set a
S.empty

-- | Generates a list of all possible lists of length n by taking elements from the provided list of length l.

-- Relative order is maintained, and the length of the returned list is \(_{n}C_{l}\).

choose :: (Num n, Eq n) => n -> [a] -> [[a]]
choose :: forall n a. (Num n, Eq n) => n -> [a] -> [[a]]
choose n
n (a
x:[a]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (n -> [a] -> [[a]]
forall n a. (Num n, Eq n) => n -> [a] -> [[a]]
choose (n
nn -> n -> n
forall a. Num a => a -> a -> a
-n
1) [a]
xs) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ n -> [a] -> [[a]]
forall n a. (Num n, Eq n) => n -> [a] -> [[a]]
choose n
n [a]
xs
choose n
0 [a]
_ = [[]]
choose n
_ [] = []

-- | Generates a list of all possible lists of length n by taking elements from the provided list of length l.

-- The length of the returned list is \(_{n}P_{l}\).

permute :: (Num n, Eq n) => n -> [a] -> [[a]]
permute :: forall n a. (Num n, Eq n) => n -> [a] -> [[a]]
permute n
n = ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [a] -> [[a]]
forall a. [a] -> [[a]]
permutations ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [a] -> [[a]]
forall n a. (Num n, Eq n) => n -> [a] -> [[a]]
choose n
n

-- | Gets the nth element of an infinite list, assuming that each element in the list can be generated using the previous element, for example, a list generated with @iterate@.

extrapolate :: (Integral b, Ord a) => b -> [a] -> a
extrapolate :: forall b a. (Integral b, Ord a) => b -> [a] -> a
extrapolate b
n [a]
ls = let (b
o,b
p) = b -> Set (b, a) -> [a] -> (b, b)
forall {b} {b}.
(Num b, Ord b, Ord b) =>
b -> Set (b, b) -> [b] -> (b, b)
helper b
0 Set (b, a)
forall a. Set a
S.empty [a]
ls in [a]
ls [a] -> b -> a
forall i a. Integral i => [a] -> i -> a
`genericIndex` (((b
nb -> b -> b
forall a. Num a => a -> a -> a
-b
o) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
p) b -> b -> b
forall a. Num a => a -> a -> a
+ b
o)
    where
        helper :: b -> Set (b, b) -> [b] -> (b, b)
helper b
k Set (b, b)
finished (b
l:[b]
ls')
            | Set (b, b) -> Bool
forall a. Set a -> Bool
S.null Set (b, b)
matches = b -> Set (b, b) -> [b] -> (b, b)
helper (b
kb -> b -> b
forall a. Num a => a -> a -> a
+b
1) ((b, b) -> Set (b, b) -> Set (b, b)
forall a. Ord a => a -> Set a -> Set a
S.insert (b
k,b
l) Set (b, b)
finished) [b]
ls'
            | Bool
otherwise = let o :: b
o = (b, b) -> b
forall a b. (a, b) -> a
fst ((b, b) -> b) -> (b, b) -> b
forall a b. (a -> b) -> a -> b
$ Int -> Set (b, b) -> (b, b)
forall a. Int -> Set a -> a
S.elemAt Int
0 Set (b, b)
matches in (b
o,b
kb -> b -> b
forall a. Num a => a -> a -> a
-b
o)
            where matches :: Set (b, b)
matches = ((b, b) -> Bool) -> Set (b, b) -> Set (b, b)
forall a. (a -> Bool) -> Set a -> Set a
S.filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==b
l) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> b
snd) Set (b, b)
finished

-- | Generates a range with @[x..y]@, but reverses the list instead of returning an empty range if x > y.

range :: (Ord a, Enum a) => a -> a -> [a]
range :: forall a. (Ord a, Enum a) => a -> a -> [a]
range a
x a
y = if a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x then [a
x,a -> a
forall a. Enum a => a -> a
pred a
x..a
y] else [a
x..a
y]

-- | Takes (a,b) and (c,d) as arguments and returns the intersection of the ranges [a..b] and [c..d] as another pair if it is not empty.

rangeIntersect :: Ord b => (b, b) -> (b, b) -> Maybe (b, b)
rangeIntersect :: forall b. Ord b => (b, b) -> (b, b) -> Maybe (b, b)
rangeIntersect (b
a,b
b) (b
c,b
d)
    | b
b b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
c Bool -> Bool -> Bool
|| b
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
d = Maybe (b, b)
forall a. Maybe a
Nothing
    | Bool
otherwise = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b -> b -> b
forall a. Ord a => a -> a -> a
max b
a b
c, b -> b -> b
forall a. Ord a => a -> a -> a
min b
b b
d)

-- | Converts a list of booleans (parsed as a binary number) to an integer.

binToDec :: Num a => [Bool] -> a
binToDec :: forall a. Num a => [Bool] -> a
binToDec = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> ([Bool] -> [a]) -> [Bool] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(*) ((Integer -> a) -> [Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
2a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^) [Integer
0..]) ([a] -> [a]) -> ([Bool] -> [a]) -> [Bool] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> a) -> [Bool] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Bool -> Int) -> Bool -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) ([Bool] -> [a]) -> ([Bool] -> [Bool]) -> [Bool] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse