From 58c677f409a1ac5a7ee4726c35655c59542b6fd4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 19 Dec 2023 13:11:39 +0100 Subject: [PATCH] Added solution for "Day 16: The Floor Will Be Lava", part 1 --- AdventOfCode.lpi | 4 + AdventOfCode.lpr | 3 +- solvers/UFloorWillBeLava.pas | 233 ++++++++++++++++++++++++++++ tests/AdventOfCodeFPCUnit.lpi | 4 + tests/AdventOfCodeFPCUnit.lpr | 3 +- tests/UFloorWillBeLavaTestCases.pas | 78 ++++++++++ 6 files changed, 323 insertions(+), 2 deletions(-) create mode 100644 solvers/UFloorWillBeLava.pas create mode 100644 tests/UFloorWillBeLavaTestCases.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index de7ba4b..2518302 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -97,6 +97,10 @@ + + + + diff --git a/AdventOfCode.lpr b/AdventOfCode.lpr index 583af79..ea6fe05 100644 --- a/AdventOfCode.lpr +++ b/AdventOfCode.lpr @@ -25,7 +25,7 @@ uses {$ENDIF} Classes, SysUtils, CustApp, USolver, UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards, UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, - UHotSprings, UPointOfIncidence, UParabolicReflectorDish, ULensLibrary; + UHotSprings, UPointOfIncidence, UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava; type @@ -65,6 +65,7 @@ begin engine.RunAndFree(TPointOfIncidence.Create); engine.RunAndFree(TParabolicReflectorDish.Create); engine.RunAndFree(TLensLibrary.Create); + engine.RunAndFree(TFloorWillBeLava.Create); engine.Free; end; diff --git a/solvers/UFloorWillBeLava.pas b/solvers/UFloorWillBeLava.pas new file mode 100644 index 0000000..986ad80 --- /dev/null +++ b/solvers/UFloorWillBeLava.pas @@ -0,0 +1,233 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2023 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UFloorWillBeLava; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, Generics.Collections, USolver; + +const + CNoDirection: TPoint = (X: 0; Y: 0); + CEmptyChar = '.'; + +type + + { TBeam } + + TBeam = record + Position, Direction: TPoint; + end; + +const + CStartingBeam: TBeam = (Position: (X: 0; Y: 0); Direction: (X: 1; Y: 0)); + +type + TEnergyState = (esNone, esWestOrHorizontal, esEastOrVertical, esBoth); + + { TTransition } + + TTransition = record + IncomingDirection, OutgoingDirection, SplitDirection: TPoint; + Tile: Char; + EnergyChange: TEnergyState; + end; + +const + CTransitions: array of TTransition = ( + (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '/'; + EnergyChange: esWestOrHorizontal), + (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/'; + EnergyChange: esWestOrHorizontal), + (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '/'; + EnergyChange: esEastOrVertical), + (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/'; + EnergyChange: esEastOrVertical), + (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '\'; + EnergyChange: esWestOrHorizontal), + (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\'; + EnergyChange: esEastOrVertical), + (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '\'; + EnergyChange: esEastOrVertical), + (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\'; + EnergyChange: esWestOrHorizontal), + (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|'; + EnergyChange: esBoth), + (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|'; + EnergyChange: esBoth), + (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-'; + EnergyChange: esBoth), + (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-'; + EnergyChange: esBoth) + ); + +type + + { TFloorWillBeLava } + + TFloorWillBeLava = class(TSolver) + private + FLines: TStringList; + function IsBeamOutOfBounds(constref ABeam: TBeam; const AWidth, AHeight: Integer): Boolean; + function GetTile(constref APosition: TPoint): Char; + function GetNewBeam(constref APosition, ADirection: TPoint): TBeam; + public + constructor Create; + destructor Destroy; override; + procedure ProcessDataLine(const ALine: string); override; + procedure Finish; override; + function GetDataFileName: string; override; + function GetPuzzleName: string; override; + end; + +implementation + +{ TFloorWillBeLava } + +function TFloorWillBeLava.IsBeamOutOfBounds(constref ABeam: TBeam; const AWidth, AHeight: Integer): Boolean; +begin + Result := (ABeam.Position.X < 0) or (ABeam.Position.X >= AWidth) + or (ABeam.Position.Y < 0) or (ABeam.Position.Y >= AHeight); +end; + +function TFloorWillBeLava.GetTile(constref APosition: TPoint): Char; +begin + Result := FLines[APosition.Y][APosition.X + 1]; +end; + +function TFloorWillBeLava.GetNewBeam(constref APosition, ADirection: TPoint): TBeam; +begin + Result.Position := APosition; + Result.Direction := ADirection; +end; + +constructor TFloorWillBeLava.Create; +begin + FLines := TStringList.Create; +end; + +destructor TFloorWillBeLava.Destroy; +begin + FLines.Free; + inherited Destroy; +end; + +procedure TFloorWillBeLava.ProcessDataLine(const ALine: string); +begin + FLines.Add(ALine); +end; + +procedure TFloorWillBeLava.Finish; +var + energyMap: array of array of TEnergyState; + width, height, i, j: Integer; + done: Boolean; + stack: specialize TStack; + beam: TBeam; + transition: TTransition; + energyChange: TEnergyState; + s: string; +begin + // Initializes energy map. + width := Length(FLines[0]); + height := FLines.Count; + SetLength(energyMap, width, height); + for i := 0 to width - 1 do + for j := 0 to height - 1 do + energyMap[i, j] := esNone; + + // Starts beam. + done := False; + beam := CStartingBeam; + stack := specialize TStack.Create; + + repeat + // Processes the current beam. + if IsBeamOutOfBounds(beam, width, height) then + done := True + else begin + if beam.Direction.X <> 0 then + energyChange := esWestOrHorizontal + else + energyChange := esEastOrVertical; + + if GetTile(beam.Position) <> CEmptyChar then + begin + // Checks the current position for direction changes and splits. + for transition in CTransitions do + if (transition.IncomingDirection = beam.Direction) and (transition.Tile = GetTile(beam.Position)) then + begin + if transition.SplitDirection <> CNoDirection then + stack.Push(GetNewBeam(beam.Position + transition.SplitDirection, transition.SplitDirection)); + beam.Direction := transition.OutgoingDirection; + energyChange := transition.EnergyChange; + Break; + end; + end; + + // Energizes the current position. + case energyMap[beam.Position.X, beam.Position.Y] of + esNone: energyMap[beam.Position.X, beam.Position.Y] := energyChange; + esWestOrHorizontal: + if energyChange = esEastOrVertical then + energyMap[beam.Position.X, beam.Position.Y] := esBoth + else + done := True; + esEastOrVertical: + if energyChange = esWestOrHorizontal then + energyMap[beam.Position.X, beam.Position.Y] := esBoth + else + done := True; + esBoth: done := True; + end; + + // Moves the beam. + beam.Position := beam.Position + beam.Direction; + end; + + if done and (stack.Count > 0) then + begin + // Starts the next beam that was split earlier. + done := False; + beam := stack.Pop; + end; + until done; + + stack.Free; + + // Counts energized tiles. + for i := 0 to width - 1 do + for j := 0 to height - 1 do + if energyMap[i, j] <> esNone then + Inc(FPart1); +end; + +function TFloorWillBeLava.GetDataFileName: string; +begin + Result := 'floor_will_be_lava.txt'; +end; + +function TFloorWillBeLava.GetPuzzleName: string; +begin + Result := 'Day 16: The Floor Will Be Lava'; +end; + +end. + diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index eedd017..082eb5b 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -104,6 +104,10 @@ + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index ab3a37c..d7c454d 100644 --- a/tests/AdventOfCodeFPCUnit.lpr +++ b/tests/AdventOfCodeFPCUnit.lpr @@ -6,7 +6,8 @@ uses Interfaces, Forms, GuiTestRunner, USolver, UBaseTestCases, UTrebuchetTestCases, UCubeConundrumTestCases, UGearRatiosTestCases, UScratchcardsTestCases, UGiveSeedFertilizerTestCases, UWaitForItTestCases, UCamelCardsTestCases, UHauntedWastelandTestCases, UMirageMaintenanceTestCases, UPipeMazeTestCases, UCosmicExpansionTestCases, - UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases; + UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, + UFloorWillBeLavaTestCases; {$R *.res} diff --git a/tests/UFloorWillBeLavaTestCases.pas b/tests/UFloorWillBeLavaTestCases.pas new file mode 100644 index 0000000..8cb8bed --- /dev/null +++ b/tests/UFloorWillBeLavaTestCases.pas @@ -0,0 +1,78 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2023 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UFloorWillBeLavaTestCases; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UFloorWillBeLava; + +type + + { TFloorWillBeLavaFullDataTestCase } + + TFloorWillBeLavaFullDataTestCase = class(TEngineBaseTest) + protected + function CreateSolver: ISolver; override; + published + procedure TestPart1; + end; + + { TFloorWillBeLavaExampleTestCase } + + TFloorWillBeLavaExampleTestCase = class(TExampleEngineBaseTest) + protected + function CreateSolver: ISolver; override; + published + procedure TestPart1; + end; + +implementation + +{ TFloorWillBeLavaFullDataTestCase } + +function TFloorWillBeLavaFullDataTestCase.CreateSolver: ISolver; +begin + Result := TFloorWillBeLava.Create; +end; + +procedure TFloorWillBeLavaFullDataTestCase.TestPart1; +begin + AssertEquals(7392, FSolver.GetResultPart1); +end; + +{ TFloorWillBeLavaExampleTestCase } + +function TFloorWillBeLavaExampleTestCase.CreateSolver: ISolver; +begin + Result := TFloorWillBeLava.Create; +end; + +procedure TFloorWillBeLavaExampleTestCase.TestPart1; +begin + AssertEquals(46, FSolver.GetResultPart1); +end; + +initialization + + RegisterTest(TFloorWillBeLavaFullDataTestCase); + RegisterTest(TFloorWillBeLavaExampleTestCase); +end. +