path: root/day21.fsx

#r "nuget: FSHarpx.Collections, 3.0.1"
open FSharpx.Collections
open System.IO
open System.Text.RegularExpressions

let swapPos x y str =
    str |> String.mapi (fun i v -> 
                        match i with
                        | _ when i = x -> str.[y]
                        | _ when i = y -> str.[x]
                        | _ -> v)


let swapLetter x y str =
    str |> String.mapi (fun i v -> 
                        match v with
                        | _ when v = x -> y
                        | _ when v = y -> x
                        | _ -> v)

let rotateSteps steps dir (str: string) =
    let steps = steps % str.Length
    let  ls = str |> List.ofSeq |> if dir = "right" then List.rev else id
    List.fold (fun (s, c) e -> if s <> 0 then (s-1 , List.append c.Tail [e]) else (0, c)) (steps, ls) ls
    |> snd |> if dir = "right" then List.rev else id
    |> List.map string 
    |> String.concat ""

let rotatePos (letter: char) (str: string) =
    let index = str.IndexOf letter
    rotateSteps (index + 1 + (if index >= 4 then 1 else 0)) "right" str

let reversePos (x: int) (y: int) (str: string) =
    let reversed = Seq.rev str[x..y] |> Seq.map string |> String.concat ""
    (if x > 0 then str[..x-1] else "") + reversed + str[y+1..]

let movePos (x: int) (y: int) (str:string) =
    str |> Seq.mapi (fun i v ->
                        match i with
                        | _ when i = x -> ""
                        | _ when i = y -> if x < y 
                                          then (string v + string str[x]) 
                                          else (string str[x] + string v)
                        | _ -> string v)
    |> String.concat ""

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 processLine (str: string): string -> string =
    match str with
    | Regex "swap position (\d) with position (\d)" [x; y] -> swapPos (int x) (int y)
    | Regex "swap letter (\w) with letter (\w)" [x; y] -> swapLetter (char x) (char y)
    | Regex "rotate (left|right) (\d) steps?" [dir; steps] -> rotateSteps (int steps) dir
    | Regex "rotate based on position of letter (\w)" [letter] -> rotatePos (char letter)
    | Regex "reverse positions (\d) through (\d)" [x; y] -> reversePos (int x) (int y)
    | Regex "move position (\d) to position (\d)" [x; y] -> movePos (int x) (int y) 
    | _ -> id

// part 1
let program = File.ReadAllLines "day21.txt" |> Array.map processLine |> Array.reduce (>>)
let starter = "abcdefgh"
program starter |> printfn "%s"

// part 2
let target = "fbgdceah" 
let charsToString: char list -> string =
    List.map string >> String.concat ""

// permute all possible inputs to find which one yields the target
let rec permute x =
    let rec distribute e = function
        | [] -> [[e]]
        | x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs]

    match x with
    | [] -> [[]]
    | e::xs -> List.collect (distribute e) (permute xs)

starter 
|> Seq.toList 
|> permute 
|> List.map charsToString
|> List.map (fun x -> (x, program x))
|> List.filter (snd >> ((=) target))
|> printfn "%A"