Advent of Code 2020 day 20

aoc2020day20.fsx

#time "on"

let txt = System.IO.File.ReadAllText( __SOURCE_DIRECTORY__ + "/input.txt").Trim()

type Image = char [,]
type Tile = { Image: Image; Title: string }

module Image =
    let size (img:Image) = img.[0.. ,0].Length
    let rotate (img:Image) =
        let s = size img
        Array2D.init s s (fun x y -> img.[s - 1 - y, x])
    let flipY (img:Image) =
        let s = size img
        Array2D.init s s (fun x y -> img.[x, s - 1 - y])
    let flipX (img:Image) =
        let s = size img
        Array2D.init s s (fun x y -> img.[s - 1 - x, y])
    let isMatch (img1:Image) (img2:Image) =
        if img1.[0..9,0] = img2.[0..9, 9] then Some (0,-1)
        elif img1.[9, 0..9] = img2.[0, 0..9] then Some (1,0)
        elif img1.[0..9, 9] = img2.[0..9, 0] then Some (0,1)
        elif img1.[0, 0..9] = img2.[9, 0..9] then Some (-1,0)
        else None
    let transforms =
        [id; flipY; flipX; rotate; rotate >> rotate; rotate >> rotate >> rotate; flipY >> rotate; flipX >> rotate] 
    let isMatchT (img1:Image) (img2:Image) =
        transforms 
        |> Seq.map(fun fn -> fn img2)
        |> Seq.choose(fun img2' -> isMatch img1 img2' |> Option.map(fun p -> p, img2') )
        |> Seq.tryHead

module Tile =
    let image t = t.Image
     
let pars (s:string) =
    s.Split("\n\n") |> Array.map(fun s -> 
    let (title :: rest) = s.Split("\n") |> Array.toList
    let resty = rest |> List.map(Seq.toList)
    {Title=title; Image = Array2D.init 10 10 (fun x y -> resty.[y].[x])})
    |> Array.toList

let rec ass tout tin =
    match tin with 
    | [] -> tout
    | h::t when tout |> List.isEmpty -> 
        ass [(0,0), h] t
    | ti -> 
        let found, (p, transformed)  =
            ti
            |> Seq.choose(fun tile ->        
                tout 
                |> Seq.choose (fun (p,t) ->
                    Image.isMatchT (t.Image) (tile.Image) 
                    |> Option.map(fun (p1, img) -> (fst p1 + fst p, snd p1 + snd p), img ))
                |> Seq.map(fun r -> tile, r)
                |> Seq.tryHead)
            |> Seq.head
        let tout' = (p, {found with Image = transformed}) :: tout
        let tin' = tin |> List.except([found])
        ass tout' tin'

let toCorners result = 
    let ps = result |> List.map fst
    let corners  = [
        ps |> List.map fst |> List.min, ps |> List.map snd |> List.min
        ; ps |> List.map fst |> List.min, ps |> List.map snd |> List.max
        ; ps |> List.map fst |> List.max, ps |> List.map snd |> List.min
        ; ps |> List.map fst |> List.max, ps |> List.map snd |> List.max]
    let titles = result |> List.map (fun (p, i) -> p , i.Title) |> Map
    corners |> List.map(fun c -> titles.[c])
    
let tiles =  pars txt
let mosaique = tiles |> ass [] 
let part1 = mosaique |> toCorners |> List.map(fun s -> s.Trim(Seq.toArray "Title: ") |> int64 ) |> List.reduce ( * )
// Part 1 complete

let layTiles mosaique = 
    let ps = mosaique |> List.map fst
    let topleft = ps |> List.map fst |> List.min, ps |> List.map snd |> List.min
    let images = mosaique |> List.map (fun (p, i) -> (fst p - fst topleft, snd p - snd topleft ) , i.Image) |> Map
    let imgsize = 8
    let size = images |> Map.toList |> List.maxBy fst |> fst |> fst |> (+) 1 |> ( * ) imgsize
    Array2D.init size size (fun x y -> 
        let img = images.[x / imgsize, y / imgsize]
        img.[1 + x % imgsize, 1 + y % imgsize])

let monsterPoints = 
    let monster = 
        ["                  # "
         "#    ##    ##    ###"
         " #  #  #  #  #  #   "] 
    monster 
    |> Seq.mapi(fun y l -> l |> Seq.mapi(fun x c -> if c = '#' then Some (x, y) else None ))
    |> Seq.concat |> Seq.choose id |> Seq.toList

let find px py (map:char[,]) =
    let monsterLen = monsterPoints.Length    
    let fant =
        monsterPoints 
        |> Seq.map(fun (x, y) -> 
            let x' = px + x
            let y' = py + y
            (x', y'), map.[x', y']) 
        |> Seq.filter(snd >> fun c -> c = '#')
        |> Seq.toList
    if fant |> List.length = monsterLen then
        Some fant
    else None

let search image =
    seq {
        let s = Image.size image
        for y in 0 .. (s - 3) do
            for x in 0 .. (s - 20) do
                yield find x y image
    } |> Seq.choose id |> Seq.toList
let fullSearch image =
    let nuimage, monsters = 
        Image.transforms 
        |> Seq.map(fun fn -> 
            let m = fn image
            m, search m)
        |> Seq.filter(snd >> List.isEmpty >> not)
        |> Seq.exactlyOne
    monsters |> List.concat |> List.iter(fun ((x, y), _) -> nuimage.[x, y] <- 'O')
    nuimage
let printImage image =
    let  s = Image.size image
    [0 .. s - 1] |> List.iter(fun y -> 
        [0 .. s - 1] |> List.iter(fun x ->
            printf "%c" image.[x, y])
        printfn ""
    )
let counthash image = 
    let  s = Image.size image
    [0 .. s - 1] |> List.collect(fun y -> 
        [0 .. s - 1] |> List.map(fun x -> 
            if image.[x, y] = '#' then 1 else 0 ))
let image = layTiles mosaique
let monstersImage = fullSearch image
printImage monstersImage
printfn "part1: %d" part1
counthash monstersImage |> List.reduce (+) |> printfn "part2: %d"