Day 19 part 10 not working

day19.fsx

open System.IO
type Beacon = {
    X: int
    Y: int
    Z: int
}

type Scanner = {
    Id: int
    Beacons: Beacon Set
}

let parseInput (input: string) =
    let parseScanner (scannerText: string) = 
        let lines = scannerText.Split("\n")
        let id = lines[0].Substring(12, lines[0].Length - 16) |> int
        let beacons = 
            lines 
            |> Array.skip 1
            |> Array.map (fun (s:string) -> 
                let [|x;y;z|] = s.Split(",") |> Array.map int
                { X = x; Y = y; Z = z}
            )
            |> Set.ofArray
        {
            Id = id
            Beacons = beacons
        }
    input.Split("\n\n")
    |> Array.map parseScanner
    |> List.ofArray

let transform transformation beacons =
    beacons
    |> Set.map transformation

let align (b1,b2) beacons =
    let (dX, dY, dZ) = (b1.X - b2.X, b1.Y - b2.Y, b1.Z - b2.Z)
    let transformation = fun beacon -> 
            { 
                X = beacon.X + dX
                Y = beacon.Y + dY
                Z = beacon.Z + dZ
            }
    transformation,
        beacons
        |> Set.map transformation

let transformations = 
        [
            
            // (v.X, v.Y, v.Z), 
            // (v.X, -v.Z, v.Y),
            // (v.X, v.Z, -v.Y), 
            // (v.X, -v.Y, -v.Z)
            (fun (b:Beacon) -> { X = b.X; Y = b.Y; Z = b.Z })
            (fun (b:Beacon) -> { X = b.X; Y = -b.Z; Z = b.Y })
            (fun (b:Beacon) -> { X = b.X; Y = b.Z; Z = -b.Y })
            (fun (b:Beacon) -> { X = b.X; Y = -b.Y; Z = -b.Z })
            
            // (-v.X, v.Z, v.Y)
            // (-v.X, v.Y, -v.Z),
            // (-v.X, -v.Y, v.Z),
            // (-v.X, -v.Z, -v.Y),
            (fun (b:Beacon) -> { X = -b.X; Y = b.Z; Z = b.Y })
            (fun (b:Beacon) -> { X = -b.X; Y = b.Y; Z = -b.Z })
            (fun (b:Beacon) -> { X = -b.X; Y = -b.Y; Z = b.Z })
            (fun (b:Beacon) -> { X = -b.X; Y = -b.Z; Z = -b.Y })
            
            // (v.Y, v.Z, v.X), 
            // (v.Y, -v.X, v.Z), 
            // (v.Y, -v.Z, -v.X), 
            // (v.Y, v.X, -v.Z),
            (fun (b:Beacon) -> { X = b.Y; Y = b.Z; Z = b.X })
            (fun (b:Beacon) -> { X = b.Y; Y = -b.X; Z = b.Z })
            (fun (b:Beacon) -> { X = b.Y; Y = -b.Z; Z = -b.X })
            (fun (b:Beacon) -> { X = b.Y; Y = b.X; Z = -b.Z })

            // (-v.Y, v.X, v.Z), 
            // (-v.Y, -v.X, -v.Z), 
            // (-v.Y, -v.Z, v.X),
            // (-v.Y, v.Z, -v.X), 
            (fun (b:Beacon) -> { X = -b.Y; Y = b.X; Z = b.Z })
            (fun (b:Beacon) -> { X = -b.Y; Y = -b.X; Z = -b.Z })
            (fun (b:Beacon) -> { X = -b.Y; Y = -b.Z; Z = b.X })
            (fun (b:Beacon) -> { X = -b.Y; Y = b.Z; Z = -b.X })
        
            // (v.Z, v.Y, -v.X), 
            // (v.Z, v.X, v.Y), 
            // (v.Z, -v.Y, v.X),
            // (v.Z, -v.X, -v.Y)
            (fun (b:Beacon) -> { X = b.Z; Y = b.Y; Z = -b.X })
            (fun (b:Beacon) -> { X = b.Z; Y = b.X; Z = b.Y })
            (fun (b:Beacon) -> { X = b.Z; Y = -b.Y; Z = b.X })
            (fun (b:Beacon) -> { X = b.Z; Y = -b.X; Z = -b.Y })
            
            // (-v.Z, v.Y, v.X), 
            // (-v.Z, v.X, -v.Y), 
            // (-v.Z, -v.Y, -v.X)
            // (-v.Z, -v.X, v.Y),
            (fun (b:Beacon) -> { X = -b.Z; Y = b.Y; Z = b.X })
            (fun (b:Beacon) -> { X = -b.Z; Y = b.X; Z = -b.Y })
            (fun (b:Beacon) -> { X = -b.Z; Y = -b.Y; Z = -b.X })
            (fun (b:Beacon) -> { X = -b.Z; Y = -b.X; Z = b.Y })
        ]

let intersect (s1, s2) =
    let result = 
        // (transformations, transformations)
        transformations
        |> Seq.choose (fun transformation ->
            let b2Transformed = s2.Beacons |> transform transformation
            let allPairs = (s1.Beacons, b2Transformed) ||> Seq.allPairs
            allPairs
            |> Seq.tryPick (fun (b1, b2) -> 
                let (alignTransformation, b2Aligned) = align (b1, b2) b2Transformed
                let intersection = Set.intersect s1.Beacons b2Aligned
                if intersection.Count >= 12 
                then Some ((s1, s2), transformation>>alignTransformation, intersection)
                else None
            )
        )
        |> Seq.tryHead
    result

let createPairs (list: 'a list) =
    [ 
        for i in 0 .. list.Length - 1 do
            for j in i .. list.Length - 1 do
                if i <> j then yield (list[i],list[j])
    ]

let log prefix data = printfn "==> %s: %A" prefix data; data

let solve1 useSample =
    let input = if useSample then File.ReadAllText("19-sample.data") else File.ReadAllText("19-input.data")
    let scanners =
        input
        |> parseInput

    let rec inner toProcess processed transformations =
        match toProcess with
        | [] -> transformations
        | scanner::rest ->
            let processed' = scanner.Id::processed
            let missingScanners = 
                scanners
                |> List.filter (
                    fun s ->  processed' |> List.contains s.Id |> not
                )
            let pairs =
                ([scanner], missingScanners)
                ||> Seq.allPairs

            let intersectResult = pairs |> Seq.choose intersect |> List.ofSeq
            let newToProcess = intersectResult |> List.map (fun ((_,s2),_,_) -> s2)
            let transformations' = 
                intersectResult
                |> List.fold (fun transMap ((s1, s2), (transformation: Beacon -> Beacon), _) ->
                    if transMap |> Map.containsKey s2.Id
                    then
                        printfn "==> Existing transform: %A" (transMap[s2.Id] {X = 0; Y = 0; Z = 0})
                        printfn "==> New transform: %A" (transformation {X = 0; Y = 0; Z = 0} |> transMap[s1.Id])
                    let tm = transMap |> Map.add s2.Id (fun b -> b |> transformation |> transMap[s1.Id])
                    printfn "==> Added scanner %A" (s2.Id)
                    tm
                ) transformations
            let rest' = (rest @ newToProcess) |> List.distinct
            inner rest' processed' transformations'

    let initTransform = Map.empty |> Map.add (scanners[0].Id) (fun (b:Beacon) -> b)
    let transformations = inner [scanners[0]] [] initTransform

    let beacons = 
        scanners
        |> List.map (fun s ->
            s.Beacons 
                |> Set.map (fun b -> transformations[s.Id] b))
        |> Set.unionMany
        |> Set.toList
        |> List.distinct
        |> List.sortBy (fun b -> b.X)

    let scanners = 
        scanners
        |> List.map (fun s -> transformations[s.Id] {X = 0; Y = 0; Z = 0})
    beacons, scanners

let distance ((b1:Beacon),(b2:Beacon)) =
    (b1,b2),b1.X-b2.X + b1.Y-b2.Y + b1.Z-b2.Z

let beacons, scanners = solve1 true
let result1 = beacons |> (fun r -> r.Length)
let result2 =
    (scanners, scanners)
    ||> Seq.allPairs
    |> Seq.map distance
    |> Seq.maxBy snd