import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set

readInput :: String -> Map (Int, Int) Char
readInput s = Map.fromList [((i, j), c) | (i, l) <- zip [0 ..] (lines s), (j, c) <- zip [0 ..] l]

bestPath :: Map (Int, Int) Char -> (Int, Set (Int, Int))
bestPath maze = go (Map.singleton start (0, Set.singleton startPos)) (Set.singleton start)
  where
    start = (startPos, (0, 1))
    walls = Map.keysSet $ Map.filter (== '#') maze
    [Just startPos, Just endPos] = map (\c -> fst <$> find ((== c) . snd) (Map.assocs maze)) ['S', 'E']
    go best edge
      | Set.null edge = Map.mapKeysWith mergePaths fst best Map.! endPos
      | otherwise =
          let nodes' =
                filter (\(x, (c, _)) -> maybe True ((c <=) . fst) $ best Map.!? x) $
                  concatMap (step . (\x -> (x, best Map.! x))) (Set.elems edge)
              best' = foldl' (flip $ uncurry $ Map.insertWith mergePaths) best nodes'
           in go best' $ Set.fromList (map fst nodes')
    step ((p@(i, j), d@(di, dj)), (cost, path)) =
      let rots = [((p, d'), (cost + 1000, path)) | d' <- [(-dj, di), (dj, -di)]]
          moves =
            [ ((p', d), (cost + 1, Set.insert p' path))
              | let p' = (i + di, j + dj),
                p `Set.notMember` walls
            ]
       in moves ++ rots
    mergePaths a@(c1, p1) b@(c2, p2) =
      case compare c1 c2 of
        LT -> a
        GT -> b
        EQ -> (c1, Set.union p1 p2)

main = do
  (score, visited) <- bestPath . readInput <$> readFile "input16"
  print score
  print (Set.size visited)

  

    
using System.Collections.Immutable;
using System.Diagnostics;
using Common;

namespace Day16;

static class Program
{
    static void Main()
    {
        var start = Stopwatch.GetTimestamp();

        var smallInput = Input.Parse("smallsample.txt");
        var sampleInput = Input.Parse("sample.txt");
        var programInput = Input.Parse("input.txt");

        Console.WriteLine($"Part 1 small: {Solve(smallInput)}");
        Console.WriteLine($"Part 1 sample: {Solve(sampleInput)}");
        Console.WriteLine($"Part 1 input: {Solve(programInput)}");

        Console.WriteLine($"That took about {Stopwatch.GetElapsedTime(start)}");
    }

    static (int part1, int part2) Solve(Input i)
    {
        State? endState = null;
        Dictionary<(Point, int), int> lowestScores = new();

        var queue = new Queue<State>();
        queue.Enqueue(new State(i.Start, 1, 0, ImmutableHashSet<Point>.Empty));
        while (queue.TryDequeue(out var state))
        {
            if (ElementAt(i.Map, state.Location) is '#')
            {
                continue;
            }

            if (lowestScores.TryGetValue((state.Location, state.DirectionIndex), out var lowestScoreSoFar))
            {
                if (state.Score > lowestScoreSoFar) continue;
            }

            lowestScores[(state.Location, state.DirectionIndex)] = state.Score;

            var nextStatePoints = state.Points.Add(state.Location);

            if (state.Location == i.End)
            {
                if ((endState is null) || (state.Score < endState.Score))
                    endState = state with { Points = nextStatePoints };
                else if (state.Score == endState.Score)
                    endState = state with { Points = nextStatePoints.Union(endState.Points) };
                continue;
            }

            // Walk forward
            queue.Enqueue(state with
            {
                Location = state.Location.Move(CardinalDirections[state.DirectionIndex]),
                Score = state.Score + 1,
                Points = nextStatePoints,
            });

            // Turn clockwise
            queue.Enqueue(state with
            {
                DirectionIndex = (state.DirectionIndex + 1) % CardinalDirections.Length,
                Score = state.Score + 1000,
                Points = nextStatePoints,
            });

            // Turn counter clockwise
            queue.Enqueue(state with
            {
                DirectionIndex = (state.DirectionIndex + CardinalDirections.Length - 1) % CardinalDirections.Length,
                Score = state.Score + 1000,
                Points = nextStatePoints, 
            });
        }

        if (endState is null) throw new Exception("No end state found!");
        return (endState.Score, endState.Points.Count);
    }

    public static void DumpMap(Input i, ISet<Point>? points, Point current)
    {
        for (int row = 0; row < i.Bounds.Row; row++)
        {
            for (int col = 0; col < i.Bounds.Col; col++)
            {
                var p = new Point(row, col);
                Console.Write(
                    (p == current) ? 'X' :
                    (points?.Contains(p) ?? false) ? 'O' :
                    ElementAt(i.Map, p));
            }

            Console.WriteLine();
        }

        Console.WriteLine();
    }

    public static char ElementAt(string[] map, Point location) => map[location.Row][location.Col];

    public record State(Point Location, int DirectionIndex, int Score, ImmutableHashSet<Point> Points);

    public static readonly Direction[] CardinalDirections =
        [Direction.Up, Direction.Right, Direction.Down, Direction.Left];
}

public class Input
{
    public string[] Map { get; init; } = [];
    public Point Start { get; init; } = new(-1, -1);
    public Point End { get; init; } = new(-1, -1);
    public Point Bounds => new(this.Map.Length, this.Map[0].Length);

    public static Input Parse(string file)
    {
        var map = File.ReadAllLines(file);
        Point start = new(-1, -1), end = new(-1, -1);
        foreach (var p in map
            .SelectMany((line, i) => new []
            {
                 new Point(i, line.IndexOf('S')),
                 new Point(i, line.IndexOf('E')),
            })
            .Where(p => p.Col >= 0)
            .Take(2))
        {
            if (map[p.Row][p.Col] is 'S') start = p;
            else end = p;
        }

        return new Input()
        {
            Map = map,
            Start = start,
            End = end,
        };
    }
}

  

 haskell

    
import Control.Arrow
import Control.Monad
import Control.Monad.RWS
import Control.Monad.Trans.Maybe
import Data.Array.Unboxed
import Data.List
import Data.Map qualified as M
import Data.Maybe
import Data.Set qualified as S

data Dir = N | S | W | E deriving (Show, Eq, Ord)
type Maze = UArray Pos Char
type Pos = (Int, Int)
type Node = (Pos, Dir)
type CostNode = (Int, Node)
type Problem = RWS Maze [(Node, [Node])] (M.Map Node Int, S.Set (CostNode, Maybe Node))

parse = toMaze . lines

toMaze :: [String] -> Maze
toMaze b = listArray ((0, 0), (n - 1, m - 1)) $ concat b
  where
    n = length b
    m = length $ head b

next :: Int -> (Pos, Dir) -> Problem [CostNode]
next c (p, d) = do
    m <- ask

    let straigth = fmap ((1,) . (,d)) . filter ((/= '#') . (m !)) . return $ move d p
        turn = (1000,) . (p,) <$> rot d

    return $ first (+ c) <$> straigth ++ turn

move N = first (subtract 1)
move S = first (+ 1)
move W = second (subtract 1)
move E = second (+ 1)

rot d
    | d `elem` [N, S] = [E, W]
    | otherwise = [N, S]

dijkstra :: MaybeT Problem ()
dijkstra = do
    m <- ask
    visited <- gets fst
    Just (((cost, vertex@(p, _)), father), queue) <- gets (S.minView . snd)

    let (prevCost, visited') = M.insertLookupWithKey (\_ a _ -> a) vertex cost visited

    case prevCost of
        Nothing -> do
            queue' <- lift $ foldr S.insert queue <$> (fmap (,Just vertex) <$> next cost vertex)
            put (visited', queue')
            tell [(vertex, maybeToList father)]
        Just c -> do
            if c == cost
                then tell [(vertex, maybeToList father)]
                else guard $ m ! p /= 'E'
            put (visited, queue)
    dijkstra

solve b = do
    start <- getStart b
    end <- getEnd b
    let ((m, _), w) = execRWS (runMaybeT dijkstra) b (M.empty, S.singleton (start, Nothing))
        parents = M.fromListWith (++) w
        endDirs = (end,) <$> [N, S, E, W]
        min = minimum $ mapMaybe (`M.lookup` m) endDirs
        ends = filter ((== Just min) . (`M.lookup` m)) endDirs
        part2 =
            S.size . S.fromList . fmap fst . concat . takeWhile (not . null) $
                iterate (>>= flip (M.findWithDefault []) parents) ends
    return (min, part2)

getStart :: Maze -> Maybe CostNode
getStart = fmap ((0,) . (,E) . fst) . find ((== 'S') . snd) . assocs

getEnd :: Maze -> Maybe Pos
getEnd = fmap fst . find ((== 'E') . snd) . assocs

main = getContents >>= print . solve . parse

  

    
import 'dart:math';
import 'package:collection/collection.dart';
import 'package:more/more.dart';

List<Point<num>> d4 = [Point(1, 0), Point(-1, 0), Point(0, 1), Point(0, -1)];

/// Returns cost to destination, plus list of routes to destination.
/// Does Dijkstra/A* search depending on whether heuristic returns 1 or
/// something better.
(num, List<List<T>>) aStarSearch<T>(T start, Map<T, num> Function(T) fNext,
    int Function(T) fHeur, bool Function(T) fAtEnd) {
  var cameFrom = SetMultimap<T, T>.fromEntries([MapEntry(start, start)]);

  var ends = <T>{};
  var front = PriorityQueue<T>((a, b) => fHeur(a).compareTo(fHeur(b)))
    ..add(start);
  var cost = <T, num>{start: 0};
  while (front.isNotEmpty) {
    var here = front.removeFirst();
    if (fAtEnd(here)) {
      ends.add(here);
      continue;
    }
    var ns = fNext(here);
    for (var n in ns.keys) {
      var nCost = cost[here]! + ns[n]!;
      if (!cost.containsKey(n) || nCost < cost[n]!) {
        cost[n] = nCost;
        front.add(n);
        cameFrom.removeAll(n);
      }
      if (cost[n] == nCost) cameFrom[n].add(here);
    }
  }

  Iterable<List<T>> routes(T h) sync* {
    if (h == start) {
      yield [h];
      return;
    }
    for (var p in cameFrom[h]) {
      yield* routes(p).map((e) => e + [h]);
    }
  }

  var minCost = ends.map((e) => cost[e]!).min;
  ends = ends.where((e) => cost[e]! == minCost).toSet();
  return (minCost, ends.fold([], (s, t) => s..addAll(routes(t).toList())));
}

typedef PP = (Point, Point);

(num, List<List<PP>>) solve(List<String> lines) {
  var grid = {
    for (var r in lines.indexed())
      for (var c in r.value.split('').indexed().where((e) => e.value != '#'))
        Point<num>(c.index, r.index): c.value
  };
  var start = grid.entries.firstWhere((e) => e.value == 'S').key;
  var end = grid.entries.firstWhere((e) => e.value == 'E').key;
  var dir = Point<num>(1, 0);

  fHeur(PP pd) => 1; // faster than euclidean distance.
  fNextAndCost(PP pd) => <PP, int>{
        for (var n in d4
            .where((n) => n != pd.last * -1 && grid.containsKey(pd.first + n)))
          (pd.first + n, n): ((n == pd.last) ? 1 : 1001) // (Point, Dir) : Cost
      };
  fAtEnd(PP pd) => pd.first == end;

  return aStarSearch<PP>((start, dir), fNextAndCost, fHeur, fAtEnd);
}

part1(List<String> lines) => solve(lines).first;

part2(List<String> lines) => solve(lines)
    .last
    .map((l) => l.map((e) => e.first).toSet())
    .flattenedToSet
    .length;


  

    
 ###### 11043 ######
 10041  10042 ######
 ###### 11041 ######