Skip to content

Instantly share code, notes, and snippets.

@artur-s

artur-s/01.fsx

Last active December 20, 2021 06:09
Show Gist options
  • Save artur-s/0e1c6b6e8c79fd370a923170f0a09846 to your computer and use it in GitHub Desktop.
Save artur-s/0e1c6b6e8c79fd370a923170f0a09846 to your computer and use it in GitHub Desktop.
Download ZIP
AoC2021
Raw
01.fsx
// https://adventofcode.com/2021
let readings =
[|
199
227
229
|]
// part1
let incs =
Seq.pairwise
>> Seq.fold (fun acc (a,b) -> if a<b then acc+1 else acc) 0
incs readings
// part2
let triplewise xs =
Seq.zip3
xs
(Seq.skip 1 xs)
(Seq.skip 2 xs)
let incs3Sums xs =
triplewise xs
|> Seq.map (fun (a:int,b,c) -> a+b+c)
|> Seq.pairwise
|> Seq.fold (fun acc (a,b) -> if a<b then acc+1 else acc) 0
incs3Sums readings
Raw
02.fsx
type Course =
| Forward of int
| Down of int
| Up of int
let forward = Course.Forward
let down = Course.Down
let up = Course.Up
let readings =
[|
forward 1
forward 2
down 5
down 5
down 4
down 9
up 6
up 7
|]
// part 1
let depth1 course =
course
|> Seq.fold (fun (hacc, dacc) -> function
| Forward f -> (hacc + f, dacc)
| Down d -> (hacc, dacc + d)
| Up u -> (hacc, dacc - u) ) (0, 0)
depth1 readings
|> fun (h,d,_) -> h*d
// part 2
let depth2 course =
course
|> Seq.fold (fun (hacc, dacc, aimacc) -> function
| Forward f -> (hacc + f, dacc + f*aimacc, aimacc)
| Down d -> (hacc, dacc, aimacc + d)
| Up u -> (hacc, dacc, aimacc - u) ) (0, 0, 0)
depth2 readings
|> fun (h,d,_) -> h*d
Raw
03.fsx
// Day 3: Binary Diagnostic
let samples = [|
0b00100
0b11110
0b10110
0b10111
0b10101
0b01111
0b00111
0b11100
0b10000
0b11001
0b00010
0b01010
|]
// part 1
let masks precision =
[| for i in [(precision)..(-1)..1] -> 2. ** (float i - 1.) |> int |] // [...; 16; 8; 4; 2; 1]
let countPositonBits bitPrecision countOnes (report: int array) =
let countPred = if countOnes then (<) 0 else (>) 1
let masks = masks bitPrecision
report
|> Seq.fold (fun (acc: int array) n ->
masks
|> Seq.iteri (fun i mask ->
acc.[i] <- acc.[i] + (if n &&& mask > 0 then 1 else -1) )
acc
) (Array.init bitPrecision (fun _ -> 0))
|> Seq.map (fun i -> if countPred i then 1 else 0)
|> Seq.indexed
|> Seq.fold (fun acc (i, b) -> masks.[i] * b + acc) 0
//let stringBin = sprintf "%05B"
let gamma5 = countPositonBits 5 true
let epsilon5 = countPositonBits 5 false
gamma5 samples // = 22
epsilon5 samples // = 9
let gamma12 = countPositonBits 12 true
let epsilon12 = countPositonBits 12 false
// part 2
let o2gen bitPrecision (report: int array) =
let masks = masks bitPrecision
let rec loop bitPos ns =
if Array.length ns > 1 && bitPos < bitPrecision then
let bit =
ns
|> Array.fold (fun (acc: int) n ->
acc + if n &&& masks.[bitPos] > 0 then 1 else -1
) 0
|> (fun i -> if i >= 0 then 1 else 0)
ns
|> Array.filter (fun n -> if n &&& masks.[bitPos] > 0 then bit = 1 else bit = 0)
|> loop (bitPos + 1)
else
ns
loop 0 report
|> Array.head
let co2scrubber bitPrecision (report: int array) =
let masks = masks bitPrecision
let rec loop bitPos ns =
if Array.length ns > 1 && bitPos < bitPrecision then
let bit =
ns
|> Array.fold (fun (acc: int) n ->
acc + if n &&& masks.[bitPos] > 0 then 1 else -1
) 0
|> (fun i -> if i >= 0 then 0 else 1)
ns
|> Array.filter (fun n -> if n &&& masks.[bitPos] > 0 then bit = 1 else bit = 0)
|> loop (bitPos + 1)
else
ns
loop 0 report
|> Array.head
let o2genRating = o2gen 5 samples
let co2scrubberRating = co2scrubber 5 samples
let liveSupportRating = o2genRating * co2scrubberRating
Raw
04.fsx
// Day 4: Giant Squid
let randomNrsText =
"7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1"
let arrsText =
"""
22 13 17 11 0
8 2 23 4 24
21 9 14 16 7
6 10 3 18 5
1 12 20 15 19
3 15 0 2 22
9 18 13 17 5
19 8 7 25 23
20 11 10 24 4
14 21 16 12 6
14 21 17 24 4
10 16 15 9 19
18 8 23 26 20
22 11 13 6 5
2 0 12 3 7
"""
let split (sep:string) (text:string) =
text.Split(sep, System.StringSplitOptions.RemoveEmptyEntries ||| System.StringSplitOptions.TrimEntries)
let array2dToList (arr: _ [,]) =
[ for i in arr.GetLowerBound(0)..arr.GetUpperBound(0)
do yield arr.[i,*] |> List.ofArray ]
|> List.collect id
let readBoards (text: string) =
text
|> split "\n"
|> Array.map (split " ")
|> Array.chunkBySize 5
|> Array.map array2D
|> (Array.map << Array2D.map) int32
let randomNrs =
randomNrsText
|> split ","
|> Array.map int32
let randomNrExpantion =
Seq.init (randomNrs.Length+1) (fun i -> randomNrs |> Array.take (i))
|> Seq.skip 5
|> Seq.toArray
let boards = readBoards arrsText
let isWinner (drawnNums: int array) (board: int [,]) : bool =
[0..4]
|> List.exists (fun i ->
Set.isSubset (set board.[i,*]) (set drawnNums)
||
Set.isSubset (set board.[*,i]) (set drawnNums) )
let score (drawnNums, board: int [,]) =
let sum = Set.difference (board |> array2dToList |> set) (set drawnNums)
|> Seq.sum
let last = Seq.last drawnNums
sum * last
// part 1
let winner =
seq {
for draw in randomNrExpantion do
for board in boards do
if board |> isWinner draw then
yield draw, board }
|> Seq.tryHead
|> Option.map score
// = Some 4512
// part 2
let rec winners numbExp boards =
match numbExp with
| draw::nRest ->
match boards |> List.partition (isWinner draw) with
| (winner::_, bRest) ->
(draw,winner) :: winners nRest bRest
| _ ->
winners nRest boards
| _ ->
[]
//let firstToWin =
// winners (List.ofSeq randomNrExpantion) (List.ofSeq boards)
// |> Seq.tryHead
// |> Option.map score // = Some 4512
let lastToWin =
winners (List.ofSeq randomNrExpantion) (List.ofSeq boards)
|> Seq.tryLast
|> Option.map score // = Some 1924
Raw
05.fsx
// Day 5: Hydrothermal Venture
// https://adventofcode.com/2021/day/5
type 'a Point = { x:'a; y:'a }
type 'a Vector = { a: 'a Point; b: 'a Point }
let point x y = { Point.x = x; y = y}
let vector (ax,ay) (bx,by) = { Vector.a = point ax ay; b = point bx by}
let (=>) a b = vector a b
let vectorToCoords { Vector.a = {x = ax; y = ay};b = {x = bx; y = by} } =
let range = max (abs (bx - ax)) (abs (by - ay))
let xstep = sign (bx - ax)
let ystep = sign (by - ay)
[| for i in 0..range ->
{x = ax + i * xstep; y = ay + i * ystep} |]
(*
(1,1) => (1,3) |> vectorToCoords
(5,5) => (8,2) |> vectorToCoords
(0,0) => (8,8) |> vectorToCoords
(8,0) => (0,8) |> vectorToCoords
*)
let isDiagonal { Vector.a = {x = ax; y = ay}; b = {x = bx; y = by}} =
ax <> bx && ay <> by
(*
(1,1) => (1,3) |> isDiagonal
(5,5) => (8,2) |> isDiagonal
(0,0) => (8,8) |> isDiagonal
(8,0) => (0,8) |> isDiagonal
*)
module Day5 =
module Array2D =
let toSeq (arr: _ [,]) =
seq { for i in arr.GetLowerBound(0)..arr.GetUpperBound(0) do
yield! Seq.ofArray arr.[i,*] }
let countIntersections diagram =
diagram |> Array2D.toSeq
|> Seq.filter ((<) 1)
|> Seq.length
let intersectionsPart1 vectors =
let coords =
vectors
|> Array.filter (not << isDiagonal)
|> Array.collect vectorToCoords
let diagram = Array2D.zeroCreate<int> 1000 1000
for {x = x; y = y} in coords do
diagram.[x,y] <- diagram.[x,y] + 1
countIntersections diagram
let intersectionsPart2 vectors =
let coords =
vectors |> Array.collect vectorToCoords
let diagram = Array2D.zeroCreate<int> 1000 1000
for {x = x; y = y} in coords do
diagram.[x,y] <- diagram.[x,y] + 1
countIntersections diagram
module Text =
open System
let split (sep:string) (text:string) =
text.Split(sep, StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
let lines = split "\n"
let readVectors text =
let point t =
match split "," t with
| [| x; y |] -> int x, int y
| _ -> failwith "point read error"
let toVector line =
match split " -> " line with
| [|a; b|] -> point a => point b
| _ -> failwith "vector read error"
lines text
|> Array.map toVector
let linesInput =
"""
0,9 -> 5,9
8,0 -> 0,8
9,4 -> 3,4
2,2 -> 2,1
7,0 -> 7,4
6,4 -> 2,0
0,9 -> 2,9
3,4 -> 1,4
0,0 -> 8,8
5,5 -> 8,2
"""
Text.readVectors linesInput2 |> Day5.intersectionsPart1 // = 5
Text.readVectors linesInput2 |> Day5.intersectionsPart2 // = 12
Raw
06.fsx
// Day 6: Lanternfish
#time
let initial =
//[| 3;4;3;1;2 |]
[|1;3;1;5;5;1;1;1;5;1;1;1;3;1;1;4;3;1;1;2;2;4;2;1;3;3;2;4;4;4;1;3;1;1;4;3;1;5;5;1;1;3;4;2;1;5;3;4;5;5;2;5;5;1;5;5;2;1;5;1;1;2;1;1;1;4;4;1;3;3;1;5;4;4;3;4;3;3;1;1;3;4;1;5;5;2;5;2;2;4;1;2;5;2;1;2;5;4;1;1;1;1;1;4;1;1;3;1;5;2;5;1;3;1;5;3;3;2;2;1;5;1;1;1;2;1;1;2;1;1;2;1;5;3;5;2;5;2;2;2;1;1;1;5;5;2;2;1;1;3;4;1;1;3;1;3;5;1;4;1;4;1;3;1;4;1;1;1;1;2;1;4;5;4;5;5;2;1;3;1;4;2;5;1;1;3;5;2;1;2;2;5;1;2;2;4;5;2;1;1;1;1;2;2;3;1;5;5;5;3;2;4;2;4;1;5;3;1;4;4;2;4;2;2;4;4;4;4;1;3;4;3;2;1;3;5;3;1;5;5;4;1;5;1;2;4;2;5;4;1;3;3;1;4;1;3;3;3;1;3;1;1;1;1;4;1;2;3;1;3;3;5;2;3;1;1;1;5;5;4;1;2;3;1;3;1;1;4;1;3;2;2;1;1;1;3;4;3;1;3|]
// part 1
let rec fishGrowth day fish =
if day > 0 then
if fish = 0 then
fishGrowth (day-1) 6 +
fishGrowth (day-1) 8
else
fishGrowth (day-1) (fish-1)
else
1L
//fishGrowth 0 3 = 1
//fishGrowth 1 3 = 1
//fishGrowth 2 3 = 1
//fishGrowth 3 3 = 1
//fishGrowth 4 3 = 2
//fishGrowth 1 0 = 2
//fishGrowth 18 3 = 5
let solution1 =
let days = 80
initial
|> Seq.map (int >> fishGrowth days)
|> Seq.sum
// part 2
let fishGrowthCached day (fish:int) =
let dict = System.Collections.Concurrent.ConcurrentDictionary<_,int64>()
let getOrAdd arg f = dict.GetOrAdd(arg, System.Func<_,_> f)
let rec loop day (fish:int) : int64 =
let recurse (d,f) = loop d f
if day > 0 then
if fish = 0 then
getOrAdd (day-1, 6) recurse +
getOrAdd (day-1, 8) recurse
else
getOrAdd (day-1, fish-1) recurse
else
1L
loop day fish
//fishGrowthCached 0 3 = 1
//fishGrowthCached 1 3 = 1
//fishGrowthCached 2 3 = 1
//fishGrowthCached 3 3 = 1
//fishGrowthCached 4 3 = 2
//fishGrowthCached 1 0 = 2
//fishGrowthCached 18 3 = 5
let solution2 =
let days = 256
initial
|> Seq.map (int >> fishGrowthCached days)
|> Seq.sum
Raw
07.fsx
// Day 7: The Treachery of Whales
// https://adventofcode.com/2021/day/7
let inputStr =
"""1101,1,29,67,1102,0,1,65,1008,65,35,66,1005,66,28,1,67,65,20,4,0,1001,65,1,65,1106,0,8,99,35,67,101,99,105,32,110,39,101,115,116,32,112,97,115,32,117,110,101,32,105,110,116,99,111,100,101,32,112,114,111,103,114,97,109,10,1425,266,740,842,335,1076,1125,108,728,131,553,757,316,361,475,1058,555,157,37,1501,287,61,22,394,886,535,235,734,1381,428,200,838,84,0,99,397,516,1260,1079,457,685,669,85,1161,851,1413,207,125,23,396,1024,637,712,942,320,507,32,686,1073,449,736,619,120,1092,674,769,519,26,42,366,187,261,389,583,170,700,695,531,57,263,1058,755,1215,413,201,617,311,443,694,285,677,722,1262,934,790,31,272,410,129,22,186,49,1040,399,19,624,132,1,35,515,423,1039,128,963,254,152,1306,33,360,484,463,483,254,741,284,14,155,6,16,1053,36,1299,637,985,470,476,383,717,304,31,209,263,70,1196,2,283,470,45,20,226,249,654,692,107,31,123,131,42,36,469,249,74,703,798,195,126,1699,135,143,1028,180,33,248,4,118,22,783,721,1033,1250,779,213,241,170,1026,0,124,709,672,349,286,494,134,361,938,985,539,267,240,951,496,431,449,242,804,422,24,202,76,947,414,396,681,142,366,342,256,978,373,677,1471,187,307,579,437,17,779,81,1380,241,69,61,758,1290,98,514,275,510,1427,185,139,816,1401,105,74,978,544,248,413,0,45,1107,223,332,723,745,71,70,330,727,261,1223,914,16,980,306,331,1011,132,70,1735,281,993,976,1,370,280,502,41,644,213,1191,518,464,693,446,44,930,1,23,1412,219,722,1028,84,552,1261,601,433,538,728,385,9,346,212,1017,7,80,88,336,480,1264,219,750,0,1080,711,1095,849,1270,175,20,314,452,620,1283,81,57,193,392,79,1330,220,396,184,922,921,902,199,56,107,32,67,275,91,202,49,4,312,372,262,49,172,493,1473,989,70,373,941,1116,798,709,865,105,442,555,1616,74,402,703,439,120,262,442,1704,1459,195,237,1763,376,734,28,867,370,6,1080,548,750,391,367,123,324,221,453,131,516,586,72,57,185,1667,468,439,225,1407,663,12,355,1320,595,60,59,158,279,365,670,505,14,240,1299,337,128,615,823,576,823,890,284,1196,717,955,1282,1002,20,176,32,222,33,248,634,885,703,543,368,585,1151,110,124,41,475,958,252,99,30,620,793,1021,540,154,635,1194,420,54,33,452,797,157,576,86,116,842,94,98,0,1162,38,483,138,949,316,1248,79,249,40,234,698,275,1239,573,649,815,348,48,78,1039,276,12,261,317,638,304,20,184,1152,711,1673,917,40,244,655,268,151,41,851,79,242,788,611,300,27,141,635,274,330,900,1023,498,269,267,46,436,844,1228,38,142,467,192,399,86,87,645,792,405,844,108,487,356,1251,332,146,128,383,1123,145,0,1148,688,127,316,579,15,215,293,73,1648,599,432,155,317,1054,205,155,451,1411,291,104,536,719,35,25,24,62,747,702,224,971,107,1210,114,41,472,29,286,4,920,0,197,135,112,308,191,1017,438,206,239,6,11,69,945,248,274,397,50,173,80,1349,268,585,590,1071,1127,351,929,106,989,396,209,691,17,149,1001,354,1296,473,179,152,141,1049,376,590,196,27,656,67,275,153,916,849,27,1093,73,156,30,1206,276,623,395,38,760,33,222,371,489,246,309,385,498,517,748,1384,1203,465,360,237,763,1173,94,431,48,770,491,132,564,84,472,1804,57,59,187,351,1340,265,1099,36,199,60,608,148,1209,1142,231,268,254,105,1020,200,1202,661,225,1313,55,808,770,80,522,185,129,36,476,815,1424,534,583,285,15,21,607,722,242,33,299,672,1253,1078,142,285,417,461,261,310,296,1934,271,144,1572,155,1039,881,1097,18,226,45,789,213,309,32,603,1102,5,81,511,672,314,7,1471,104,196,875,286,4,198,472,549,613,1453,139,596,270,164,417,709,437,27,86,758,1365,216,38,1047,124,96,255,72,67,1372,143,120,502,276,922,89,231,491,1330,245,473,25,944,266,1475,569,215,484,73,264,214,608,423,333,879,251,300,32,18,514,135,1349,80,493,569,784,2,794,846,596,30,862,318,207,546,551,1548,547,181,1219,354,650,791,53,20,629,52,105,98,312,140,111,1451,973,11,17,821,724,1836,376,82,248,86,730,1061,47,309,142,1039,114,157,26,307,1058,803,723,105,170,59,239,181,601,79,564,671,636,1465,530,533,75,261,1522,537,96,984,71,504,572,923,85,103,567,780,102,4,835,463,684,427,1091,1104,1163,626,1015,395,1881,43,490,906,1013,398,113,95,332,215,14,8,85,92,1579
"""
let crabPositionsSample = [ 16;1;2;0;4;2;7;1;2;14 ]
let crabPositions =
inputStr.Split ","
|> Seq.map int
|> Seq.toList
let minFuelBruteForce (fuelByDistance:_ -> int) crabPositions =
let start = crabPositions |> Seq.min
let end' = crabPositions |> Seq.max
[start..end']
|> List.map (fun p ->
crabPositions
|> List.sumBy (fun c -> abs (c - p) |> fuelByDistance), p)
|> Seq.minBy fst
|> fst
let minFuelPart1 = minFuelBruteForce id
minFuelPart1 crabPositionsSample = 37
minFuelPart1 crabPositions = 329389
let minFuelPart2 =
let fuelByDistance steps = List.sum [0..steps]
minFuelBruteForce fuelByDistance
minFuelPart2 crabPositionsSample // = 168
minFuelPart2 crabPositions // = 329389
Raw
08.fsx
// Day 8: Seven Segment Search
// https://adventofcode.com/2021/day/8
let sampleInput = """
be cfbegad cbdgef fgaecd cgeb fdcge agebfd fecdb fabcd edb |fdgacbe cefdb cefbgd gcbe
edbfga begcd cbg gc gcadebf fbgde acbgfd abcde gfcbed gfec |fcgedb cgb dgebacf gc
fgaebd cg bdaec gdafb agbcfd gdcbef bgcad gfac gcb cdgabef |cg cg fdcagb cbg
fbegcd cbd adcefb dageb afcb bc aefdc ecdab fgdeca fcdbega |efabcd cedba gadfec cb
aecbfdg fbg gf bafeg dbefa fcge gcbea fcaegb dgceab fcbdga |gecf egdcabf bgf bfgea
fgeab ca afcebg bdacfeg cfaedg gcfdb baec bfadeg bafgc acf |gebdcfa ecba ca fadegcb
dbcfg fgd bdegcaf fgec aegbdf ecdfab fbedc dacgb gdcebf gf |cefg dcbef fcge gbcadfe
bdfegc cbegaf gecbf dfcage bdacg ed bedf ced adcbefg gebcd |ed bcgafe cdgba cbgef
egadfb cdbfeg cegd fecab cgb gbdefca cg fgcdab egfdb bfceg |gbdfcae bgc cg cgb
gcafb gcf dcaebfg ecagb gf abcdeg gaef cafbge fdbac fegbdc |fgae cfgab fg bagce
"""
type Reading =
{ Signals: string []
Outputs: string []}
[<AutoOpen>]
module Reading =
let (|One|_|) (sign:string) = if sign.Length = 2 then Some sign else None
let (|Four|_|) (sign:string) = if sign.Length = 4 then Some sign else None
let (|Seven|_|) (sign:string) = if sign.Length = 3 then Some sign else None
let (|Eight|_|) (sign:string) = if sign.Length = 7 then Some sign else None
module Text =
open System
let split (sep:string) (text:string) =
text.Split(sep, StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
let lines = split "\n"
let readings (text: string) =
lines text
|> Seq.map (split "|")
|> Seq.map (function
| [| signals; outputs |] ->
{ Signals = split " " signals
Outputs = split " " outputs }
| _ -> failwith "cannot read input data")
|> Seq.toArray
let sampleReading = Text.readings sampleInput
// part 1
let knownDigitsCount readings =
readings
|> Seq.sumBy (fun r ->
r.Outputs |> Seq.sumBy (function
| One _ | Four _ | Seven _ | Eight _ -> 1 | _ -> 0))
knownDigitsCount sampleReading // = 26
// part 2
let decodeOutput {Signals = sigs; Outputs = output} =
let digits = Array.init 10 (fun _ -> "")
let (|Two|_|) (sign:string) =
if sign.Length = 5 && set sign - set digits.[4] |> Set.count = 3 then
Some sign
else
None
let (|Six|_|) (sign:string) =
if sign.Length = 6 &&
set digits.[8] - set sign - set digits.[1] = Set.empty then
Some sign else None
let (|Nine|_|) (sign:string) =
if sign.Length = 6 &&
(|Six|_|) sign |> Option.isNone
&& set sign - set digits.[4] |> Set.count = 2 then
Some sign
else
None
let (|Five|_|) sign =
let six = set digits.[6]
if six + set sign = six && set sign <> six then
Some sign
else
None
let (|Three|_|) sign =
let five = set digits.[5]
let nine = set digits.[9]
let four = set digits.[4]
if set sign + five = nine && set sign <> four then
Some sign
else
None
let (|Zero|_|) sign =
if set sign - set digits.[5] |> Set.count = 2 then
Some sign
else
None
while digits |> Seq.contains "" do
for s in sigs do
match s with
| One v -> digits.[1] <- v
| Four v -> digits.[4] <- v
| Seven v -> digits.[7] <- v
| Eight v -> digits.[8] <- v
| Two v -> digits.[2] <- v
| Six v -> digits.[6] <- v
| Nine v -> digits.[9] <- v
| Five v -> digits.[5] <- v
| Three v -> digits.[3] <- v
| Zero v -> digits.[0] <- v
| _ -> ()
let map =
digits
|> Seq.mapi (fun i d -> set d, i)
|> Map.ofSeq
output
|> Seq.map (fun o -> string map.[set o])
|> String.concat ""
|> int
sampleReading |> Seq.map decodeOutput |> Seq.sum // = 61229
Raw
09.fsx
// Day 9: Smoke Basin
// https://adventofcode.com/2021/day/9
let sampleInput = """
2199943210
3987894921
9856789892
8767896789
9899965678"""
module Text =
open System
let split (sep:string) (text:string) =
text.Split(sep, StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
let lines = split "\n"
let heightmap input : int [,] =
let row (c:char seq) =
c |> Seq.map (string >> Int32.Parse)
|> Seq.toArray
lines input
|> Array.map row
|> fun hss ->
let height = hss.Length
let width = hss |> Seq.head |> Seq.length
(fun h w -> hss.[h].[w])
|> Array2D.init height width
let adjacents f (hMap: int [,], maxX, maxY) x y =
let posAndVal ((x,y) as p) = f p hMap.[x,y]
let up = if x - 1 >= 0 then Some (posAndVal (x-1, y)) else None
let down = if x + 1 <= maxX then Some (posAndVal (x+1, y)) else None
let left = if y - 1 >= 0 then Some (posAndVal (x, y-1)) else None
let right = if y + 1 <= maxY then Some (posAndVal (x, y+1)) else None
List.choose id [up; down; left; right]
type Point = { Location: int * int ; Height: int}
let lowPoints (hMap: int [,]) : Point seq =
let maxX= hMap.GetUpperBound 0
let maxY = hMap.GetUpperBound 1
let adjacentValues =
adjacents (fun _ v -> v) (hMap, maxX, maxY)
seq {
for x in 0..maxX do
for y in 0..maxY do
if hMap.[x,y] < (adjacentValues x y |> Seq.min) then
yield
{ Location = x, y
Height = hMap.[x,y] } }
let riskLevel {Height = h} = h + 1
let part1 =
Text.heightmap
>> lowPoints
>> Seq.sumBy riskLevel
part1 sampleInput // = 15
// part 2
let basinSize (hmap: int [,]) (lowPoint: Point) : int =
let maxX = hmap.GetUpperBound 0
let maxY = hmap.GetUpperBound 1
let surface = 9
let adjs =
adjacents
(fun (x,y) v -> {Point.Location = x,y; Height = v})
(hmap, maxX, maxY)
let rec explore size (visited: _ Set) = function
| {Location = (x,y); Height = h}::rest
when h < surface && not <| visited.Contains (x,y) ->
explore (size+1) (visited.Add (x,y)) (rest @ adjs x y)
| _::rest -> explore size visited rest
| _ -> size
explore 0 Set.empty [lowPoint]
let threeLargest xs =
xs |> Seq.sortDescending |> Seq.take 3
let part2 input =
let hmap = Text.heightmap input
hmap |> lowPoints
|> Seq.map (basinSize hmap)
|> threeLargest
|> Seq.reduce (*)
part2 sampleInput // = 1134
#time
Raw
10.fsx
// Day 10: Syntax Scoring
// https://adventofcode.com/2021/day/10
open System
let sampleInput = """
[({(<(())[]>[[{[]{<()<>>
[(()[<>])]({[<{<<[]>>(
{([(<{}[<>[]}>{[]{[(<()>
(((({<>}<{<{<>}{[]{[]{}
[[<[([]))<([[{}[[()]]]
[{[{({}]{}}([{[{{{}}([]
{<[[]]>}<{[{[{[]{()[[[]
[<(<(<(<{}))><([]([]()
<{([([[(<>()){}]>(<<{{
<{([{{}}[<[[[<>{}]]]>[]]
"""
//let puzzleInput = """
//"""
let navSubsystem (input:string) =
input.Split("\n", StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
|> Seq.toList
let limiters =
[ '(', ')'
'[', ']'
'{', '}'
'<', '>' ]
|> Seq.map (fun (a,b) -> b,a)
|> Map.ofSeq
let illegalCharPoints =
[ ')', 3
']', 57
'}', 1197
'>', 25137 ]
|> Map.ofSeq
// part 1
type SyntaxCheckResult =
| IllegalCharacter of char
| Incomplete of char list
| Correct
let checkSyntax line : SyntaxCheckResult =
let isOpening = limiters.Values.Contains
let isClosingOf o c =
match limiters.TryFind c with
| Some x -> o = x
| None -> false
let closingOf o =
limiters |> Map.tryFindKey (fun _ v -> v = o)
|> Option.defaultWith (fun () -> failwith "no closing found")
let push v stack = v::stack
let pop = function | v::rest -> Some (v, rest) | [] -> None
let rec loop stack = function
| ch::rest ->
if isOpening ch then
loop (push ch stack) rest
else // closing
match pop stack with
| Some (v, newStack) when ch |> isClosingOf v ->
loop newStack rest
| _ -> IllegalCharacter ch
| [] ->
if stack.Length > 0 then
Incomplete (stack |> List.map closingOf)
else
Correct
loop [] (Seq.toList line)
let firstIllegal =
checkSyntax >> function
| IllegalCharacter ch -> Some ch
| Incomplete _ | Correct -> None
let scoreIllegalChars lines =
lines
|> Seq.choose firstIllegal
|> Seq.countBy id
|> Seq.sumBy (fun (c, count) -> illegalCharPoints.[c] * count)
navSubsystem sampleInput |> scoreIllegalChars // = 26397
navSubsystem puzzleInput |> scoreIllegalChars // = 374061
// part 2
let complete =
checkSyntax >> function
| Incomplete chs -> Some chs
| IllegalCharacter _ | Correct -> None
let completetionPoints =
[ ')', 1
']', 2
'}', 3
'>', 4 ]
|> Map.ofSeq
let scoreCompl line =
line
|> Seq.map (fun c -> completetionPoints.[c])
|> Seq.fold (fun acc c -> acc * 5L + int64 c) 0L
//scoreCompl "}}]])})]" // = 288957
let middleScore lineScores =
(List.sort lineScores).[ int64 lineScores.Length / 2L |> int ]
let scoreCompetionChars lines =
lines
|> Seq.filter (fun line ->
match firstIllegal line with | Some _ -> false | _ -> true)
|> Seq.choose complete
|> Seq.map scoreCompl
|> Seq.toList
|> middleScore
navSubsystem sampleInput |> scoreCompetionChars // = 288957
navSubsystem puzzleInput |> scoreCompetionChars // =
Raw
11.fsx
// Day 11: Dumbo Octopus
// https://adventofcode.com/2021/day/11
#time
let sample1Input = """
11111
19991
19191
19991
11111"""
let sample2Input = """
5483143223
2745854711
5264556173
6141336146
6357385478
4167524645
2176841721
6882881134
4846848554
5283751526"""
let puzzleInput = """
8826876714
3127787238
8182852861
4655371483
3864551365
1878253581
8317422437
1517254266
2621124761
3473331514
"""
module Text =
open System
let split (sep:string) (text:string) =
text.Split(sep, StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
let lines = split "\n"
let dumbogrid input : int [,] =
let row (c:char seq) =
c |> Seq.map (string >> Int32.Parse)
|> Seq.toArray
lines input
|> Array.map row
|> fun hss ->
let height = hss.Length
let width = hss |> Seq.head |> Seq.length
(fun h w -> hss.[h].[w])
|> Array2D.init height width
module Array2D =
let toSeq (arr: _ [,]) =
seq { for i in arr.GetLowerBound(0)..arr.GetUpperBound(0) do
yield! Seq.ofArray arr.[i,*] }
type Dumbo = { Location: int * int ; Energy: int}
module Dumbo =
let create (x,y) e = {Location = x,y; Energy = e}
let location { Location = l } = l
let energy { Energy = e } = e
let isHighEnery e = e > 9
let isHighEneryDumbo = energy >> isHighEnery
let isZeroEnery e = e = 0
let isZeroEneryDumbo = energy >> isZeroEnery
let increaseEnergy dumbo = {dumbo with Energy = dumbo.Energy + 1}
module Grid =
let adjacents (maxX, maxY) x y =
[for dx in -1..1 do
for dy in -1..1 do
let x' = x + dx
let y' = y + dy
if x' >= 0 && x' <= maxX &&
y' >= 0 && y' <= maxY &&
(x',y') <> (x,y) then
yield x', y' ]
//Grid.adjacents (10, 10) 2 2 |> List.length // = 8
//Grid.adjacents (9, 9) 0 4 |> List.length // = 5
//Grid.adjacents (9, 9) 0 0 |> List.length // = 3
//Grid.adjacents (9, 9) 0 9 |> List.length // = 3
let increaseEnergy (grid: int [,]) =
Array2D.map (fun e -> e+1) grid
let flash (grid: int [,]) : int64 =
let maxX = grid.GetUpperBound 0
let maxY = grid.GetUpperBound 1
let updateGridState dumbos =
for {Location = x,y; Energy = e} in dumbos do
grid.[x,y] <- e
let refreshDumbo ({Location = x,y} as d) = {d with Energy = grid.[x,y]}
let neighbours x y =
Grid.adjacents (maxX, maxY) x y
|> List.map (fun (ax, ay) ->
Dumbo.create (ax, ay) grid.[ax,ay])
let tryFlashAndPowerUpNeighbours ({Dumbo.Location = x, y} as d) =
if Dumbo.isHighEneryDumbo d then
let poweredUpNeighbours =
neighbours x y
|> List.filter (not << Dumbo.isZeroEneryDumbo)
|> List.map Dumbo.increaseEnergy
Some
({d with Energy = 0}, poweredUpNeighbours)
else
None
let rec flashAndPowerupNeighbours flashes (poweredUp: _ Set) = function
| dumbo::rest when not <| poweredUp.Contains dumbo.Location ->
let dumbo' = refreshDumbo dumbo
match tryFlashAndPowerUpNeighbours dumbo' with
| Some (flashed, affectedNeighbours) ->
let poweredUp' =
poweredUp.Add dumbo'.Location
-
(affectedNeighbours |> List.map Dumbo.location |> set)
updateGridState (flashed::affectedNeighbours)
flashAndPowerupNeighbours (flashes+1) poweredUp' (rest @ affectedNeighbours)
| None ->
flashAndPowerupNeighbours flashes (poweredUp.Add dumbo.Location) rest
| _::rest -> flashAndPowerupNeighbours flashes poweredUp rest
| _ -> flashes
let highEnergyLocations =
grid
|> Array2D.mapi (fun x y e -> (x,y),e)
|> Array2D.toSeq
|> Seq.filter (snd >> Dumbo.isHighEnery)
|> Seq.map (fun (l,e) -> Dumbo.create l e)
|> Seq.toList
flashAndPowerupNeighbours 0 Set.empty highEnergyLocations
let runStep grid =
let grid' = Grid.increaseEnergy grid
let flashes = flash grid'
flashes, grid'
let runSteps noOfSteps grid =
List.fold (fun (accGrid, accFlashes) _ ->
let flashes, g' = runStep accGrid
(g', accFlashes + flashes))
(grid, 0L)
[1..noOfSteps]
let sample1grid = Text.dumbogrid sample1Input
let sample2grid = Text.dumbogrid sample2Input
let puzzleGrid = Text.dumbogrid puzzleInput
// part 1
runSteps 2 sample1grid // 9
runSteps 10 sample2grid // 204
runSteps 100 sample2grid // 1656
runSteps 100 puzzleGrid // 1683
// part 2
let firstAllFlashStep steps grid =
let isAllFlashGridState grid =
grid |> Array2D.toSeq
|> Seq.forall Dumbo.isZeroEnery
let rec loop step g =
if step <= steps then
let _, g' = runStep g
if isAllFlashGridState g' then
Some step
else
loop (step+1) g'
else
None
loop 1 grid
firstAllFlashStep 200 sample2grid // 195
firstAllFlashStep 1000 puzzleGrid //
Raw
12.fsx
// Day 12: Passage Pathing
// https://adventofcode.com/2021/day/12
#time
let sampleInput1 = """
start-A
start-b
A-c
A-b
b-d
A-end
b-end
"""
let sampleInput2 = """
dc-end
HN-start
start-kj
dc-start
dc-HN
LN-dc
HN-end
kj-sa
kj-HN
kj-dc
"""
let puzzleInput = """
LA-sn
LA-mo
LA-zs
end-RD
sn-mo
end-zs
vx-start
mh-mo
mh-start
zs-JI
JQ-mo
zs-mo
start-JQ
rk-zs
mh-sn
mh-JQ
RD-mo
zs-JQ
vx-sn
RD-sn
vx-mh
JQ-vx
LA-end
JQ-sn"""
type 'a Edge = Edge of 'a * 'a
type AdjGraph<'a when 'a : comparison> = AdjGraph of Map<'a, 'a Set>
module Text =
open System
let split (sep:string) (text:string) =
text.Split(sep, StringSplitOptions.RemoveEmptyEntries ||| StringSplitOptions.TrimEntries)
let lines = split "\n"
let nodes = split "-"
let edges input =
lines input
|> Seq.map nodes
|> Seq.map (function
| [|v;u|] -> Edge (v, u)
| arr -> failwithf "cannot read edge from %A" arr)
|> Seq.sort
|> Seq.toList
//let edges1 = Text.edges sampleInput1
//let edges2 = Text.edges sampleInput2
let edgesToGraph edges =
let tryAdd n1 n2 ns =
ns
|> Map.tryFind n1
|> function
| Some es -> Map.add n1 (Set.add n2 es) ns
| None -> ns.Add (n1, set [n2])
let rec loop nodes = function
| Edge (a,b)::rest ->
let nodes' =
nodes
|> tryAdd a b
|> tryAdd b a
loop nodes' rest
| [] -> nodes
loop Map.empty (edges |> Set.toList)
|> AdjGraph
let allPaths canVisitAgain from' to' (AdjGraph nodes) : 'a list seq =
let rec loop curr path processed =
seq {
if curr = to' then
yield path
else
for next in nodes[curr] do
if next <> from' then
match processed |> Map.tryFind next with
| Some visitedCount when canVisitAgain next processed ->
let processed' = processed |> Map.add next (visitedCount+1)
yield! loop next (path@[next]) processed'
| None ->
let processed' = processed |> Map.add next 1
yield! loop next (path@[next]) processed'
| _ -> () }
loop from' [from'] Map.empty
// part 1
let isBigCave (node: string) _ =
node |> Seq.head |> System.Char.IsLower |> not
//isBigCave "HN" = true
//isBigCave "a" = false
let pathsPart1 input =
Text.edges input
|> set
|> edgesToGraph
|> allPaths isBigCave "start" "end"
|> Seq.length
pathsPart1 sampleInput1 // = 10
pathsPart1 sampleInput2 // = 19
pathsPart1 puzzleInput // = 4970
// part 2
let canVisitAgain2 (node: string) processed =
let bigCave = node |> Seq.head |> System.Char.IsLower |> not
let canVisitSmall =
match processed |> Map.tryFind node with
| Some count ->
count = 1
&&
processed
|> Map.filter (fun n c ->
n |> Seq.head |> System.Char.IsLower && c > 1)
|> Seq.length = 0
| None -> true
bigCave || canVisitSmall
let pathsPart2 input =
Text.edges input
|> set
|> edgesToGraph
|> allPaths canVisitAgain2 "start" "end"
|> Seq.length
pathsPart2 sampleInput1 // = 36
pathsPart2 sampleInput2 // = 103
pathsPart2 puzzleInput // = 137948
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment