Advent of Code 2017 Solutions.

AdventOfCode2017

Advent of Code 2017 Solutions

Day01_InverseCaptcha.fsx

let input =  "21752342814933766938172121674976879111362417653261522357855816893656462449168377359285244818489723869987861247912289729579296691684761143544956991583942215236568961875851755854977946147178746464675227699149925227227137557479769948569788884399379821111382536722699575759474473273939756348992714667963596189765734743169489599125771443348193383566159843593541134749392569865481578359825844394454173219857919349341442148282229689541561169341622222354651397342928678496478671339383923769856425795211323673389723181967933933832711545885653952861879231537976292517866354812943192728263269524735698423336673735158993853556148833861327959262254756647827739145283577793481526768156921138428318939361859721778556264519643435871835744859243167227889562738712953651128317624673985213525897522378259178625416722152155728615936587369515254936828668564857283226439881266871945998796488472249182538883354186573925183152663862683995449671663285775397453876262722567452435914777363522817594741946638986571793655889466419895996924122915777224499481496837343194149123735355268151941712871245863553836953349887831949788869852929147849489265325843934669999391846286319268686789372513976522282587526866148166337215961493536262851512218794139272361292811529888161198799297966893366553115353639298256788819385272471187213579185523521341651117947676785341146235441411441813242514813227821843819424619974979886871646621918865274574538951761567855845681272364646138584716333599843835167373525248547542442942583122624534494442516259616973235858469131159773167334953658673271599748942956981954699444528689628848694446818825465485122869742839711471129862632128635779658365756362863627135983617613332849756371986376967117549251566281992964573929655589313871976556784849231916513831538254812347116253949818633527185174221565279775766742262687713114114344843534958833372634182176866315441583887177759222598853735114191874277711434653854816841589229914164681364497429324463193669337827467661773833517841763711156376147664749175267212562321567728575765844893232718971471289841171642868948852136818661741238178676857381583155547755219837116125995361896562498721571413742"B

let advent1 f (input : byte[]) =
    let len = input.Length
    let input = Array.map (fun x -> int (x - '0'B)) (Array.concat [input; input])
    [for i in 0..len - 1 do yield (input.[i], input.[f i])]
    |> Seq.filter (fun (a, b) -> a = b)
    |> Seq.sumBy fst

printfn "Part 1: %A" <| advent1 (fun f -> f + 1) input
printfn "Part 2: %A" <| advent1 (fun f -> f + input.Length / 2) input

Day02_CorruptionChecksum.fsx

let advent2 series = Seq.sum (seq { for x in series -> Seq.max(x) - Seq.min(x) })

printfn "Part 1: %A" <| advent2 [
    [5; 1; 9; 5]
    [7; 5; 3]
    [2; 4; 6; 8]
]

let rec part2 (line : int list) i j =
    if line.[i] % line.[j] = 0 && i <> j then line.[i] / line.[j]
    elif j < List.length line - 1 then part2 line i (j + 1)
    elif i < List.length line - 1 then part2 line (i + 1) 0
    else failwith "oops"

[[798; 1976; 1866; 1862; 559; 1797; 1129; 747; 85; 1108; 104; 2000; 248; 131; 87; 95];
[201; 419; 336; 65; 208; 57; 74; 433; 68; 360; 390; 412; 355; 209; 330; 135];
[967; 84; 492; 1425; 1502; 1324; 1268; 1113; 1259; 81; 310; 1360; 773; 69; 68; 290];
[169; 264; 107; 298; 38; 149; 56; 126; 276; 45; 305; 403; 89; 179; 394; 172];
[3069; 387; 2914; 2748; 1294; 1143; 3099; 152; 2867; 3082; 113; 145; 2827; 2545; 134; 469];
[3885; 1098; 2638; 5806; 4655; 4787; 186; 4024; 2286; 5585; 5590; 215; 5336; 2738; 218; 266];
[661; 789; 393; 159; 172; 355; 820; 891; 196; 831; 345; 784; 65; 971; 396; 234];
[4095; 191; 4333; 161; 3184; 193; 4830; 4153; 2070; 3759; 1207; 3222; 185; 176; 2914; 4152];
[131; 298; 279; 304; 118; 135; 300; 74; 269; 96; 366; 341; 139; 159; 17; 149];
[1155; 5131; 373; 136; 103; 5168; 3424; 5126; 122; 5046; 4315; 126; 236; 4668; 4595; 4959];
[664; 635; 588; 673; 354; 656; 70; 86; 211; 139; 95; 40; 84; 413; 618; 31];
[2163; 127; 957; 2500; 2370; 2344; 2224; 1432; 125; 1984; 2392; 379; 2292; 98; 456; 154];
[271; 4026; 2960; 6444; 2896; 228; 819; 676; 6612; 6987; 265; 2231; 2565; 6603; 207; 6236];
[91; 683; 1736; 1998; 1960; 1727; 84; 1992; 1072; 1588; 1768; 74; 58; 1956; 1627; 893];
[3591; 1843; 3448; 1775; 3564; 2632; 1002; 3065; 77; 3579; 78; 99; 1668; 98; 2963; 3553];
[2155; 225; 2856; 3061; 105; 204; 1269; 171; 2505; 2852; 977; 1377; 181; 1856; 2952; 2262];
]
|> Seq.map (fun line -> part2 line 0 0)
|> Seq.sum
|> printfn "Part 2: %O"

Day03_SpiralMemory.fsx

open System.Collections.Generic

let clamp a b v = max a (min b v)
let triangle t r o = abs((t + o) % (4 * r) - 2 * r) - r
let taxi t r o = triangle t r o |> clamp (-r/2) (r/2)

let index n =
    let s = int(float n ** 0.5)
    let shell = (s + 1) / 2 * 2 - 1
    let r = shell + 1
    let t = n - shell * shell
    if r = 0 then (0, 0)
    else (taxi t r (1-r / 2), taxi t r (3 * r + 1 - r / 2))

printfn "Part 1 Solution: %A" (index 361527)

let cumulativeSpiral =
    let data = new Dictionary<int * int, int64>(dict [(0, 0), 1L])
    let readVal x y =
        match data.TryGetValue ((x, y)) with
        | false, _ -> 0L
        | true, n -> n
    let mutGetVal (x, y) = 
        data.[(x, y)] <- List.sum [
            for i in [-1; 0; 1] do
            for j in [-1; 0; 1] do
            yield readVal (x + i) (y + j)]
        readVal x y
    index >> mutGetVal

printfn "Part 2 Solution: %O" (
  Seq.unfold (fun i -> Some(cumulativeSpiral i, i + 1) ) 0
  |> Seq.find (fun i -> i >= 361527L)

Day04_Passphrases.fsx

let input = System.IO.File.ReadAllLines("advent4-input.txt") |> Array.map (fun line -> line.Split())

printfn "Part 1: %d" (
    input
    |> Seq.filter (fun line -> line |> Set.ofSeq |> Seq.length = Seq.length line)
    |> Seq.length)

let sortStr (s:string) = new string(s.ToCharArray() |> Array.sort)

printfn "Part 2: %d" (
    input
    |> Seq.filter (fun line -> line |> Seq.map sortStr |> Set.ofSeq |> Seq.length = Seq.length line)
    |> Seq.length)
    

Day05_Trampolines.fsx

let rec solver f (state : int[]) steps pos =
    if pos >= state.Length || pos < 0 then
        steps
    else
        let jump = state.[pos]
        state.[pos] <- f state.[pos]
        solver f state (steps + 1) (pos + jump)

let input = System.IO.File.ReadAllLines "advent5-input.txt" |> Array.map int
printfn "Part 1: %O" (solver (fun x -> x + 1) (Array.copy input) 0 0)
printfn "Part 2: %O" (solver (fun x -> if x < 3 then x + 1 else x - 1) (Array.copy input) 0 0)

Day06_MemoryReallocation.fsx

let input = [|10;3;15;10;5;15;5;15;9;2;5;8;5;2;3;6 |]

let iterate input =
    let input = Array.copy input
    let n = Array.findIndex ((=) (Array.max input)) input
    let len = Array.length input
    let q = input.[n] / len
    let r = input.[n] % len
    input.[n] <- 0
    for i in 0..len-1 do input.[i] <- input.[i] + q
    for i in 1..r do input.[(n + i) % len] <- input.[(n + i) % len] + 1
    input

let solve input =
    let d = System.Collections.Generic.HashSet<string>()
    let rec unfold (A :int[]) =
        match d.Add (String.concat "," (Seq.map string A)) with
        | false -> (d.Count, A)
        | _ -> unfold (iterate A)
    unfold input

let solve2 = solve >> snd >> solve

solve input |> printfn "Part 1: %A"
solve2 input |> printfn "Part 2: %A"

Day07_RecursiveCircus.fsx

open System                                                                                         
open System.Text.RegularExpressions                                                                 
open System.Collections.Generic                                                                     
                                                                                                    
let input1 = @"pbga (66)                                                                            
xhth (57)                                                                                           
ebii (61)                                                                                           
havc (66)                                                                                           
ktlj (57)                                                                                           
fwft (72) -> ktlj, cntj, xhth                                                                       
qoyq (66)                                                                                           
padx (45) -> pbga, havc, qoyq                                                                       
tknk (41) -> ugml, padx, fwft                                                                       
jptl (61)                                                                                           
ugml (68) -> gyxo, ebii, jptl                                                                       
gyxo (61)                                                                                           
cntj (57)"                                                                                          
                                                                                                    
type Piece(name, weight, children) as this =                                                        
  static let byName = Dictionary<string, Piece>()                                                   
  do byName.Add(name, this)                                                                         
  member x.Name = name                                                                              
  member x.Weight = weight                                                                          
  member x.Children = [for n in children -> byName.[n]]                                             
  member x.TotalWeight = weight + (this.Children |> List.sumBy (fun c -> c.TotalWeight))            
  override this.ToString() = name                                                                   
                                                                                                    
let input = [                                                                                       
  for m in Regex.Matches(input1, @"(\w+) \((\d+)\)(?: -> (.*))?") do                                
    let g = m.Groups                                                                                
    yield Piece(                                                                                    
      g.[1].Value,                                                                                  
      int g.[2].Value,                                                                              
      g.[3].Value.Split([|", "|], StringSplitOptions.RemoveEmptyEntries))]                          
                                                                                                    
let all_children = Set.ofList [ for piece in input do for c in piece.Children do yield c.Name ]     
let root = input |> List.find (fun p -> not (Set.contains p.Name all_children))                     
printfn "Part 1: %A" root                                                                           
                                                                                                    
let rec part2 (piece:Piece) (expected: int) =                                                       
    let weights =                                                                                   
        piece.Children |> List.groupBy (fun c -> c.TotalWeight) |> List.sortBy (snd >> List.length) 
    match List.length weights with                                                                  
    | 1 -> piece, expected - piece.TotalWeight + piece.Weight                                       
    | 2 ->                                                                                          
        let badweight, cc = List.head weights                                                       
        let goodweight, _ = List.last weights                                                       
        part2 cc.[0] goodweight                                                                     
                                                                                                    
printfn "Part 2: %O" (part2 root 0)                                                                 

Day08_IHeardYouLikeRegisters.fsx

let input = @"b inc 5 if a > 1
a inc 1 if b < 5
c dec -10 if a >= 1
c inc -20 if c == 10"

let mutable vars = Map.empty<string, int>
let mutable transitions = []
for line in input.Split('\n') do
  match List.ofArray (line.Split()) with
  | var :: op :: opval :: _if :: condvar :: condop :: condval :: _ ->
      let func = function | "inc" -> (+) | "dec" -> (-) | _ -> failwith "bad op"
      let cond = function
          | "==" -> (=) | ">" -> (>) | "<" -> (<)
          | "!=" -> (<>) | ">=" -> (>=) | "<=" -> (<=)
          | _ -> failwith "bad op"
      let getval var = defaultArg (Map.tryFind var vars) 0
      let newval = (func op) (getval var) (int opval)
      if (cond condop) (getval condvar) (int condval) then
          vars <- Map.add var newval vars
          transitions <- (var, newval) :: transitions
  | _ -> failwith "invalid line"

printfn "Part 1: %O" (Seq.maxBy snd (Map.toSeq vars))
printfn "Part 2: %O" (Seq.maxBy snd transitions)

Day09_StreamProcessing.fsx

open System.Text.RegularExpressions

let solve str_ =
    let str = Regex.Replace(str_, "<(!.|[^!])*?>", "")

    let rec loop sum d i =
        if i = str.Length then sum
        else match str.[i] with
             | '{' -> loop (sum + d) (d + 1) (i + 1)
             | '}' -> loop sum (d - 1) (i + 1)
             | ___ -> loop sum d (i + 1)
    printfn "Part 1: %d" (loop 0 1 0)

    let gc = [for m in Regex.Matches(str_, "<(!.|[^!])*?>") do
              for c in m.Groups.[1].Captures do
              yield if c.Length > 1 then 0 else 1 ]
    printfn "Part 2: %d" (List.sum gc)

solve "{}"
solve "{{<a!>>},{<ab>},{<ab>},{<ab>}}"
solve "{{<!!>},{<!!>},{<!!>},{<!!>}}"
solve "<{o\"i!a,<{i<a>"
solve (System.IO.File.ReadAllText "advent9-input.txt")

Day10_KnotHash

fsi.ShowDeclarationValues <- false
open System

let reverse (arr: 'T []) s n L =
    if s + n < L then
        Array.Reverse(arr, s, n)
    else
        for i in 0..n/2-1 do
            let a = arr.[(s + i) % L]
            let b = arr.[(s + n - 1 - i) % L]
            arr.[(s + i) % L] <- b
            arr.[(s + n - 1 - i) % L] <- a

let rec oneRound data lengths n skip =
    match lengths with
    | [] -> data, n, skip
    | len :: lenNext ->
        let dlen = Array.length data
        reverse data n len dlen
        oneRound data lenNext ((n + len + skip) % dlen) (skip + 1)

let part1 a b c d = oneRound a b c d |> (fun (arr, _, _) -> Array.get arr 0 * Array.get arr 1)
let input = "106,118,236,1,130,0,235,254,59,205,2,87,129,25,255,118"
printfn "%A" (part1 (Array.init 256 id) (List.ofArray (Array.map int (input.Split(',')))) 0 0)

let rec part2 data lengths rounds n skip =
    match rounds with
    | 0 -> data
           |> Array.chunkBySize 16
           |> Array.map (Array.reduce (^^^))
           |> Array.map (sprintf "%02x")
           |> String.concat ""
    | _ ->
        let data, n, skip = oneRound data (lengths @ [17; 31; 73; 47; 23]) n skip
        let L = Array.length data
        part2 data lengths (rounds - 1) (n % L) (skip % L)

printfn "%A" (part2 (Array.init 5 id) [3; 4; 1; 5] 3 0 0)

let part2main bstr =
    let res = part2 (Array.init 256 id) (List.map int (List.ofArray bstr)) 64 0 0
    printfn "%O: %O" (Text.Encoding.ASCII.GetString bstr) res

(part2main ""B)
(part2main "AoC 2017"B)
(part2main (Text.Encoding.ASCII.GetBytes "1,2,3"))
(part2main (Text.Encoding.ASCII.GetBytes input))

Day11_HexEd.fsx

let distance (a, b) = max (abs (a + b)) (max (abs a) (abs b))
let vec_add (a,b) (c,d) = (a + c, b + d)
let solve (path : string) =
    let dir = function | "ne" -> 1, 0 | "n" -> 0, 1 | "se" -> 1, -1
                       | "nw" -> -1, 1 | "sw" -> -1, 0 | "s" -> 0, -1
    let path = path.Trim().Split(',') |> Array.map dir
    printfn "Part 1: %A" (distance (Seq.reduce vec_add path))
    printfn "Part 2: %A" (Seq.scan vec_add (0, 0) path |> Seq.map distance |> Seq.max)

solve "ne,ne,ne"
solve "ne,ne,sw,sw"
solve "ne,ne,s,s"
solve "se,sw,se,sw,sw"
solve (System.IO.File.ReadAllText "advent11-input.txt")