advent2017-day14.fs

// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Previous assignment: KnotHash
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let rec reverse start length array =
    if length < 2 then array
    else
        let other = (start + length - 1) % (Array.length array)
        let tmp = array.[start]
        array.[start] <- array.[other]
        array.[other] <- tmp
        reverse ((start + 1) % (Array.length array)) (length - 2) array // tail recursion

let sparseKnotHash rounds lengths =
    let lengthsWithExtras = Seq.concat [lengths; [17; 31; 73; 47; 23] |> Seq.ofList]
    seq { 1..rounds }
    |> Seq.fold
        (fun seed _ ->
            lengthsWithExtras
            |> Seq.fold
                (fun (start, skip, array) length ->
                    let newArray = reverse start length array
                    let newStart = (start + length + skip) % (Array.length array)
                    (newStart, skip + 1, newArray))
                seed)
        (0, 0, [|0..255|])

let knotHash (value: string) =
    let (_, _, sparse) = sparseKnotHash 64 (value |> Seq.map int)
    sparse
    |> Seq.mapi (fun i v -> i / 16, v)
    |> Seq.groupBy fst
    |> Seq.map
        (fun (_, values) ->
            values
            |> Seq.map snd
            |> Seq.reduce (fun x v -> x ^^^ v))
    |> Seq.fold
        (fun (buffer: StringBuilder) byte -> buffer.Append(byte.ToString("x2")))
        (StringBuilder())
    |> (fun b -> b.ToString())


// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Problem A
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let countBits (value: char) =
    match value with
    | '0' -> 0
    | '1' -> 1
    | '2' -> 1
    | '3' -> 2
    | '4' -> 1
    | '5' -> 2
    | '6' -> 2
    | '7' -> 3
    | '8' -> 1
    | '9' -> 2
    | 'a' -> 2
    | 'b' -> 3
    | 'c' -> 2
    | 'd' -> 3
    | 'e' -> 3
    | 'f' -> 4
    | _ -> raise (InvalidOperationException ("Unknown value " + value.ToString()))

let bitCount key =
    { 0..127 }
    |> Seq.map (fun i -> sprintf "%s-%d" key i)
    |> Seq.map knotHash
    |> Seq.map (fun value ->
        value
        |> Seq.map countBits
        |> Seq.sum)
    |> Seq.sum
    
(bitCount "vbqugkhl").Dump("Bit count")


// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// Problem B
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

let toBinary (value: char) =
    match value with
    | '0' -> "    "
    | '1' -> "   #"
    | '2' -> "  # "
    | '3' -> "  ##"
    | '4' -> " #  "
    | '5' -> " # #"
    | '6' -> " ## "
    | '7' -> " ###"
    | '8' -> "#   "
    | '9' -> "#  #"
    | 'a' -> "# # "
    | 'b' -> "# ##"
    | 'c' -> "##  "
    | 'd' -> "## #"
    | 'e' -> "### "
    | 'f' -> "####"
    | _ -> raise (InvalidOperationException ("Unknown value " + value.ToString()))

let createBitMap key =
    { 0..127 }
    |> Seq.map (fun i -> sprintf "%s-%d" key i)
    |> Seq.map knotHash
    |> Seq.map (fun value -> value |> Seq.map toBinary |> Seq.reduce (+))
    |> Seq.reduce (+)
    |> Seq.mapi (fun i c -> if c = '#' then (i % 128 , i / 128) else (-1, -1))
    |> Seq.filter (fst >> ((<>) -1)) // only keep 1s
    |> Set.ofSeq
 
let rec spread bitMap candidates =
    match candidates with
    | [] -> bitMap
    | nextCandidate::rest ->
        let nextCandidateIsValid = bitMap |> Set.contains nextCandidate
        let newBitmap = if nextCandidateIsValid then (bitMap |> Set.remove nextCandidate) else bitMap
        let newCandidates =
            if nextCandidateIsValid then
                let (x,y) = nextCandidate
                ((x-1,y) :: (x+1,y) :: (x,y-1) :: (x,y+1) :: rest)
            else rest
        spread newBitmap newCandidates // tail recursive
        
let rec countGroups (bitMap: Set<int * int>) groupCount =
    if bitMap.IsEmpty then groupCount
    else
        let first = bitMap.First()
        let newBitmap = spread bitMap [first]
        countGroups newBitmap (groupCount + 1)
        
(countGroups (createBitMap "vbqugkhl") 0).Dump("Groups count")