Advent of Code 2022 - Day 13

open System.IO
open System
open System.Text.RegularExpressions

type Packet =
| Number of int
| PacketArray of list<Packet>

let (|Regex|_|) pattern input =
    let m = Regex.Match(input, pattern)
    if m.Success then
        Some(List.tail [ for g in m.Groups -> g.Value ])
    else
        None

let readInput =
    seq {
        use sr = new StreamReader("./input.txt")

        while not sr.EndOfStream do
            let pair = (sr.ReadLine(), sr.ReadLine())
            sr.ReadLine() |> ignore
            yield pair
    }

let rec parse (packet: list<char>) (packets: list<Packet>): list<char> * list<Packet> =
    let s = packet |> Array.ofList |> String
    match s with
    | Regex "^(\d+)" [ n:string ] -> parse (packet |> List.skip n.Length) [Number (n |> int)]
    | _ ->
        match packet with
        | [] -> packet, packets
        | '[' :: tail ->
            let x, y = parse tail []
            parse x [PacketArray y]
        | ',' :: tail ->
            let x, y = parse tail []
            x, packets@y
        | ']' :: tail -> tail, packets
        | x -> failwith $"aa {x}"

let parseS (s: string): Packet =
    (parse (s |> Seq.toList) [] |> snd)[0]

let rec compare (a: Packet) (b: Packet): Option<bool>=
    match a, b with
    | Number a, Number b when a < b -> Some(true)
    | Number a, Number b when a > b -> Some(false)
    | Number a, Number b when a = b -> None
    | PacketArray a, Number b -> compare (PacketArray a) (PacketArray [Number b])
    | Number a, PacketArray b -> compare (PacketArray [Number a]) (PacketArray b)
    | PacketArray [], PacketArray [] -> None
    | PacketArray [], PacketArray _ -> Some(true)
    | PacketArray _, PacketArray [] -> Some(false)
    | PacketArray (a::at), PacketArray (b::bt) ->
        match compare a b with
        | Some x -> Some x
        | None -> compare (PacketArray at) (PacketArray bt)
    | _ -> failwith "Should not happen"

let compareS (a: string) (b: string) =
    compare (parseS a) (parseS b)

// Part 1
readInput
|> Seq.map (fun x -> x ||> compareS)
|> Seq.indexed
|> Seq.filter (fun (_, x) ->
    match x with
    | Some true -> true
    | _ -> false)
|> Seq.sumBy (fun x -> fst x + 1)
|> printfn "%A"

// Part 2
let div2 = "[[2]]"
let div6 = "[[6]]"
let dividers = [div2; div6]
readInput
|> Seq.fold (fun acc (l, r) -> acc@[l; r]) dividers
|> Seq.sortWith (fun l r  ->
    match (compareS l r) with
    | Some true -> -1
    | _ -> 1)
|> (fun x ->
    let i2 = Seq.findIndex ((=) div2) x
    let i6 = Seq.findIndex ((=) div6) x
    (i2 + 1) * (i6 + 1))
|> printfn "%A"