Grid.elm

module Grid exposing
    ( Grid
    , addPosition
    , allNeighbourPositions
    , allNeighbours
    , allNeighboursOrDefault
    , at
    , atOrDefault
    , defaultFn
    , diagonalNeighbourPositions
    , diagonalNeighbours
    , diagonalNeighboursOrDefault
    , filter
    , from2DList
    , from2DListWithOrigin
    , fromDict
    , fromList
    , getByDeltas
    , getByDeltasOrDefault
    , init
    , map
    , orthogonalNeighbourPositions
    , orthogonalNeighbours
    , orthogonalNeighboursOrDefault
    , set
    , toDict
    , toList
    )

import Dict exposing (Dict)


type Grid a
    = Grid
        { default : ( Int, Int ) -> a
        , dict : Dict ( Int, Int ) a
        }


init : (( Int, Int ) -> a) -> Grid a
init default =
    Grid
        { default = default
        , dict = Dict.empty
        }


defaultFn : Grid a -> (( Int, Int ) -> a)
defaultFn (Grid g) =
    g.default


fromList : (( Int, Int ) -> a) -> List ( ( Int, Int ), a ) -> Grid a
fromList default list =
    fromDict default (Dict.fromList list)


fromDict : (( Int, Int ) -> a) -> Dict ( Int, Int ) a -> Grid a
fromDict default dict =
    Grid
        { default = default
        , dict = dict
        }


from2DList : (( Int, Int ) -> a) -> List (List a) -> Grid a
from2DList default list2D =
    from2DListWithOrigin default ( 0, 0 ) list2D


from2DListWithOrigin : (( Int, Int ) -> a) -> ( Int, Int ) -> List (List a) -> Grid a
from2DListWithOrigin default ( ox, oy ) list2D =
    list2D
        |> List.indexedMap
            (\y row ->
                row
                    |> List.indexedMap (\x cell -> ( ( ox + x, oy + y ), cell ))
            )
        |> List.concat
        |> fromList default


toList : Grid a -> List ( ( Int, Int ), a )
toList (Grid g) =
    Dict.toList g.dict


toDict : Grid a -> Dict ( Int, Int ) a
toDict (Grid g) =
    g.dict


at : ( Int, Int ) -> Grid a -> Maybe a
at pos (Grid g) =
    Dict.get pos g.dict


atOrDefault : ( Int, Int ) -> Grid a -> a
atOrDefault pos ((Grid g) as g_) =
    at pos g_
        |> Maybe.withDefault (g.default pos)


set : ( Int, Int ) -> a -> Grid a -> Grid a
set pos val (Grid g) =
    Grid { g | dict = Dict.insert pos val g.dict }


map : (( Int, Int ) -> a -> b) -> Grid a -> Grid b
map fn (Grid g) =
    Grid
        { default = \pos -> fn pos (g.default pos)
        , dict = Dict.map fn g.dict
        }


filter : (( Int, Int ) -> a -> Bool) -> Grid a -> Grid a
filter fn (Grid g) =
    Grid { g | dict = Dict.filter fn g.dict }


getByDeltasOrDefault : List ( Int, Int ) -> ( Int, Int ) -> Grid a -> List a
getByDeltasOrDefault deltas pos grid =
    deltas
        |> List.map (\delta -> atOrDefault (addPosition pos delta) grid)


getByDeltas : List ( Int, Int ) -> ( Int, Int ) -> Grid a -> List a
getByDeltas deltas pos grid =
    deltas
        |> List.filterMap (\delta -> at (addPosition pos delta) grid)


allNeighboursOrDefault : ( Int, Int ) -> Grid a -> List a
allNeighboursOrDefault =
    getByDeltasOrDefault allNeighbours_


diagonalNeighboursOrDefault : ( Int, Int ) -> Grid a -> List a
diagonalNeighboursOrDefault =
    getByDeltasOrDefault diagonalNeighbours_


orthogonalNeighboursOrDefault : ( Int, Int ) -> Grid a -> List a
orthogonalNeighboursOrDefault =
    getByDeltasOrDefault orthogonalNeighbours_


allNeighbours : ( Int, Int ) -> Grid a -> List a
allNeighbours =
    getByDeltas allNeighbours_


diagonalNeighbours : ( Int, Int ) -> Grid a -> List a
diagonalNeighbours =
    getByDeltas diagonalNeighbours_


orthogonalNeighbours : ( Int, Int ) -> Grid a -> List a
orthogonalNeighbours =
    getByDeltas orthogonalNeighbours_


allNeighbourPositions : ( Int, Int ) -> List ( Int, Int )
allNeighbourPositions pos =
    List.map (addPosition pos) allNeighbours_


diagonalNeighbourPositions : ( Int, Int ) -> List ( Int, Int )
diagonalNeighbourPositions pos =
    List.map (addPosition pos) diagonalNeighbours_


orthogonalNeighbourPositions : ( Int, Int ) -> List ( Int, Int )
orthogonalNeighbourPositions pos =
    List.map (addPosition pos) orthogonalNeighbours_


addPosition : ( Int, Int ) -> ( Int, Int ) -> ( Int, Int )
addPosition ( dx, dy ) ( x, y ) =
    ( x + dx, y + dy )


allNeighbours_ : List ( Int, Int )
allNeighbours_ =
    [ ( -1, -1 ), ( 0, -1 ), ( 1, -1 ), ( -1, 0 ), ( 1, 0 ), ( -1, 1 ), ( 0, 1 ), ( 1, 1 ) ]


diagonalNeighbours_ : List ( Int, Int )
diagonalNeighbours_ =
    [ ( -1, -1 ), ( 1, -1 ), ( -1, 1 ), ( 1, 1 ) ]


orthogonalNeighbours_ : List ( Int, Int )
orthogonalNeighbours_ =
    [ ( 0, -1 ), ( -1, 0 ), ( 1, 0 ), ( 0, 1 ) ]

Grid.Zipper.elm

module Grid.Zipper exposing
    ( Zipper
    , current
    , currentFocus
    , currentOrDefault
    , doNTimes
    , doUntil
    , doWhile
    , duplicate
    , extend
    , extract
    , filter
    , fromGrid
    , fromGridAtOrigin
    , goDown
    , goLeft
    , goRight
    , goTo
    , goUp
    , gridFn
    , map
    , mapFocus
    , set
    , toGrid
    , withCurrentOrDefault
    )

import Grid exposing (Grid)


type Zipper a
    = Zipper
        { grid : Grid a
        , focus : ( Int, Int )
        }


fromGrid : ( Int, Int ) -> Grid a -> Zipper a
fromGrid focus grid =
    Zipper
        { grid = grid
        , focus = focus
        }


fromGridAtOrigin : Grid a -> Zipper a
fromGridAtOrigin =
    fromGrid ( 0, 0 )


current : Zipper a -> Maybe a
current (Zipper z) =
    Grid.at z.focus z.grid


currentOrDefault : Zipper a -> a
currentOrDefault =
    extract


currentFocus : Zipper a -> ( Int, Int )
currentFocus (Zipper z) =
    z.focus


toGrid : Zipper a -> Grid a
toGrid (Zipper z) =
    z.grid


extract : Zipper a -> a
extract (Zipper z) =
    Grid.atOrDefault z.focus z.grid


duplicate : Zipper a -> Zipper (Zipper a)
duplicate (Zipper z) =
    Zipper
        { grid = Grid.map (\pos a -> fromGrid pos z.grid) z.grid
        , focus = z.focus
        }


extend : (Zipper a -> b) -> Zipper a -> Zipper b
extend fn =
    map (\_ zipper -> fn zipper) << duplicate


map : (( Int, Int ) -> a -> b) -> Zipper a -> Zipper b
map fn (Zipper z) =
    Zipper
        { grid = Grid.map fn z.grid
        , focus = z.focus
        }


goTo : ( Int, Int ) -> Zipper a -> Zipper a
goTo focus (Zipper z) =
    Zipper { z | focus = focus }


mapFocus : (( Int, Int ) -> ( Int, Int )) -> Zipper a -> Zipper a
mapFocus fn (Zipper z) =
    Zipper { z | focus = fn z.focus }


goLeft : Zipper a -> Zipper a
goLeft =
    mapFocus (Grid.addPosition ( -1, 0 ))


goRight : Zipper a -> Zipper a
goRight =
    mapFocus (Grid.addPosition ( 1, 0 ))


goUp : Zipper a -> Zipper a
goUp =
    mapFocus (Grid.addPosition ( 0, -1 ))


goDown : Zipper a -> Zipper a
goDown =
    mapFocus (Grid.addPosition ( 0, 1 ))


doNTimes : Int -> (Zipper a -> Zipper a) -> Zipper a -> Zipper a
doNTimes n fn zipper =
    if n <= 0 then
        zipper

    else
        doNTimes (n - 1) fn (fn zipper)


doWhile : (Zipper a -> Bool) -> (Zipper a -> Zipper a) -> Zipper a -> Zipper a
doWhile pred fn zipper =
    if pred zipper then
        doWhile pred fn (fn zipper)

    else
        zipper


doUntil : (Zipper a -> Bool) -> (Zipper a -> Zipper a) -> Zipper a -> Zipper a
doUntil pred fn zipper =
    doWhile (not << pred) fn zipper


set : a -> Zipper a -> Zipper a
set val (Zipper z) =
    Zipper { z | grid = Grid.set z.focus val z.grid }


withCurrent : (Zipper a -> b) -> Zipper a -> ( Maybe a, b )
withCurrent fn zipper =
    ( current zipper
    , fn zipper
    )


withCurrentOrDefault : (Zipper a -> b) -> Zipper a -> ( a, b )
withCurrentOrDefault fn zipper =
    ( currentOrDefault zipper
    , fn zipper
    )


filter : (( Int, Int ) -> a -> Bool) -> Zipper a -> Zipper a
filter fn (Zipper z) =
    Zipper { z | grid = Grid.filter fn z.grid }


gridFn : (( Int, Int ) -> Grid a -> b) -> Zipper a -> b
gridFn fn (Zipper z) =
    fn z.focus z.grid

Tests.elm

module Tests exposing (suite)

import Expect
import Grid exposing (Grid)
import Test exposing (Test)


suite : Test
suite =
    Test.test "Advent of Code 2021 Day 9 Part 1 example" <|
        \() ->
            let
                grid : Grid Int
                grid =
                    [ [ 2, 1, 9, 9, 9, 4, 3, 2, 1, 0 ]
                    , [ 3, 9, 8, 7, 8, 9, 4, 9, 2, 1 ]
                    , [ 9, 8, 5, 6, 7, 8, 9, 8, 9, 2 ]
                    , [ 8, 7, 6, 7, 8, 9, 6, 7, 8, 9 ]
                    , [ 9, 8, 9, 9, 9, 6, 5, 6, 7, 8 ]
                    ]
                        |> Grid.from2DList (\_ -> 9)
            in
            grid
                |> Grid.filter
                    (\pos value ->
                        Grid.orthogonalNeighboursOrDefault pos grid
                            |> List.all (\neighbour -> value < neighbour)
                    )
                |> Grid.toList
                |> List.map (\( _, value ) -> value + 1)
                |> List.sum
                |> Expect.equal 15