AdventOfCode 2020, December 19

AdventOfCode2020.12.19.fsx

module Nineteen =

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

    type RuleContent =
        | Char of string
        | Rules of int array array

    type Rule = {
        RuleId : int
        Content : RuleContent
    }

    let splitRulesAndMessages (lines : string array) =
        let ndx = lines |> Array.findIndex String.IsNullOrEmpty
        lines.[0..ndx-1], lines.[ndx+1..]

    let tryParseReferenceRule line =
        let m = Regex.Match(line, @"^(\d+):(.+)$")
        if m.Success && m.Groups.Count = 3 then Some {
            RuleId = Int32.Parse m.Groups.[1].Value
            Content = 
                m.Groups.[2].Value.Split('|', StringSplitOptions.RemoveEmptyEntries)
                |> Array.map (fun s -> s.Split(' ', StringSplitOptions.RemoveEmptyEntries) |> Array.map Int32.Parse)
                |> Rules }
        else None

    let tryParseCharRule line =
        let m = Regex.Match(line, @"^(\d+):\s\""([a|b])\""$")
        if m.Success && m.Groups.Count = 3 then Some {
            RuleId = Int32.Parse m.Groups.[1].Value
            Content = Char m.Groups.[2].Value }
        else None

    let parseRules (line : string) =
        tryParseCharRule line
        |> function
        | Some rule -> rule
        | None -> 
        tryParseReferenceRule line
        |> function
        | Some rule -> rule
        | None -> failwithf "Unable to parse the rule %s" line

    let replaceRule (rules : int array array) (resolvedRules : Map<int,string Set>) : (string Set) =
        (Array.collect Set.toArray (rules 
        |> Array.map (fun ruleIds -> 
            ruleIds 
            |> Array.map (fun ruleId -> resolvedRules |> Map.find ruleId)
            |> Array.reduce (fun acc elt -> 
                acc |> Set.map (fun (x:string) -> 
                    elt |> Set.toArray |> Array.map (fun y -> x + y)) |> Array.concat |> Set
                ))))
        |> Set

    let rec resolveRules stashed resolved (unresolved : Rule list) =
        match unresolved with
        | [] -> resolved
        | rule :: unresolved ->
            match rule.Content with
            | Char c -> 
                resolveRules [] (resolved |> Map.add rule.RuleId (Set [c])) (unresolved @ stashed)
            | Rules rules -> 
                let allResolved = 
                    rules 
                    |> Array.concat 
                    |> Array.distinct 
                    |> Array.forall (fun x -> resolved |> Map.containsKey x)
                if allResolved then
                    resolveRules [] (resolved |> Map.add rule.RuleId (replaceRule rules resolved)) (unresolved @ stashed)
                else
                    resolveRules (rule :: stashed) resolved unresolved

    let rulesLines, messages =
        File.ReadAllLines "Data/input.txt"
        |> splitRulesAndMessages

    let rules =
        rulesLines 
        |> Array.map parseRules
        |> Array.toList
        |> resolveRules [] Map.empty

    messages
    |> Array.filter (fun msg -> rules.[0] |> Set.contains msg)
    |> Array.length