warrence
/
AdventOfCode2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: warrence:main
Branches Tags
warrence:main
warrence:bigint
..
compare: warrence:bigint
Branches Tags
warrence:main
warrence:bigint

No commits in common. "main" and "bigint" have entirely different histories.
main ... bigint

57 changed files with 1812 additions and 4230 deletions
Show Stats Expand all files Collapse all files

24
AdventOfCode.lpi
View File

@ -141,30 +141,6 @@
<Filename Value="UBigInt.pas"/> <Filename Value="UBigInt.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="UPolynomial.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UPolynomialRoots.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="solvers\USnowverload.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UCommon.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UMultiIndexEnumerator.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UBinomialCoefficients.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

12
AdventOfCode.lpr
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -25,9 +25,9 @@ uses
{$ENDIF} {$ENDIF}
Classes, SysUtils, CustApp, Generics.Collections, USolver, Classes, SysUtils, CustApp, Generics.Collections, USolver,
UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards, UTrebuchet, UCubeConundrum, UGearRatios, UScratchcards, UGiveSeedFertilizer, UWaitForIt, UCamelCards,
UHauntedWasteland, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence, UHauntedWasteland, UNumberTheory, UMirageMaintenance, UPipeMaze, UCosmicExpansion, UHotSprings, UPointOfIncidence,
UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty, UParabolicReflectorDish, ULensLibrary, UFloorWillBeLava, UClumsyCrucible, ULavaductLagoon, UAplenty,
UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds, USnowverload; UPulsePropagation, UStepCounter, USandSlabs, ULongWalk, UNeverTellMeTheOdds;
type type
@ -54,10 +54,7 @@ var
n: Integer; n: Integer;
begin begin
WriteLn('### Advent of Code 2023 ###'); WriteLn('### Advent of Code 2023 ###');
engine := TSolverEngine.Create(TStringArray.Create( engine := TSolverEngine.Create('data');
'data',
ConcatPaths(['..', '..', 'data'])
));
solvers := specialize TList<Integer>.Create; solvers := specialize TList<Integer>.Create;
if HasOption('p', 'puzzle') then if HasOption('p', 'puzzle') then
@ -96,7 +93,6 @@ begin
22: engine.RunAndFree(TSandSlabs.Create); 22: engine.RunAndFree(TSandSlabs.Create);
23: engine.RunAndFree(TLongWalk.Create); 23: engine.RunAndFree(TLongWalk.Create);
24: engine.RunAndFree(TNeverTellMeTheOdds.Create); 24: engine.RunAndFree(TNeverTellMeTheOdds.Create);
25: engine.RunAndFree(TSnowverload.Create);
end; end;
engine.Free; engine.Free;

202
README.md
View File

@ -1,236 +1,130 @@
# :christmas_tree: Advent of Code 2023 # Advent of Code 2023
Solver for [Advent of Code 2023](https://adventofcode.com/2023/) puzzles. Solver for [Advent of Code 2023](https://adventofcode.com/2023/) puzzles.
This is a single command line application for all 49 puzzles written in [FreePascal](https://www.freepascal.org) with [Lazarus](https://www.lazarus-ide.org/) 2.2.6 and compiled with FPC 3.2.2. This is a single command line application for all puzzles written in [FreePascal](https://www.freepascal.org) with [Lazarus](https://www.lazarus-ide.org/) 2.2.6 and compiled with FPC 3.2.2.
## Puzzle Input ## Day 1: Trebuchet?!
This project does not contain the puzzle or example inputs as per the [copyright notice of Advent of Code](https://adventofcode.com/about). In order to run the compiled application, the puzzle inputs have to be downloaded from the [Advent of Code 2023](https://adventofcode.com/2023/) puzzle pages, and placed as text files into the `bin\data` directory, e.g. `bin\data\cube_conundrum.txt`, or `bin\data\example\cube_conundrum.txt` for the unit tests. The application will output an error message with details if it cannot find an input file. <https://adventofcode.com/2023/day/1>
## Tests
On day 3, I introduced unit tests to help troubleshoot issues and prevent regressions while I kept iterating over the solver class framework. These tests cover the provided example solutions and occasional partial data tests whenever I felt the need for it.
I also added tests for the full puzzle data once I found the solution, but these tests are not public to not spoil the Advent of Code puzzles.
## My Favorites
While I think all the puzzles were a lot of fun, some of them became my favorites, marked with a star :star:, because I enjoyed the puzzle itself or was particularly content with my solution algorithm. These are [day 9](#day-9-mirage-maintenance), [day 18](#day-18-lavaduct-lagoon), and [day 24](#day-24-never-tell-me-the-odds).
## Solutions
### Day 1: Trebuchet?!
:mag_right: Puzzle: <https://adventofcode.com/2023/day/1>, :white_check_mark: Solver: [`UTrebuchet.pas`](solvers/UTrebuchet.pas)
My solution parses each line once forward for the right number, and once backward for the left number for both parts of the puzzle. My solution parses each line once forward for the right number, and once backward for the left number for both parts of the puzzle.
### Day 2: Cube Conundrum ## Day 2: Cube Conundrum
:mag_right: Puzzle: <https://adventofcode.com/2023/day/2>, :white_check_mark: Solver: [`UCubeConundrum.pas`](solvers/UCubeConundrum.pas) <https://adventofcode.com/2023/day/2>
That one seemed pretty straight forward. For each line, the solution immediately sums up games that fulfill the maxima and finds the maximum of each color. That one seemed pretty straight forward. For each line, the solution immediately sums up games that fulfill the maxima and finds the maxima of each color.
### Day 3: Gear Ratios ## Day 3: Gear Ratios
:mag_right: Puzzle: <https://adventofcode.com/2023/day/3>, :white_check_mark: Solver: [`UGearRatios.pas`](solvers/UGearRatios.pas) <https://adventofcode.com/2023/day/3>
This was the first puzzle where I had to implement a solver processing multiple lines at once instead of one by one. Here, it also needs the lines directly before and after the one being processed. For this I modified the solver class to pass in three lines at once, shifting one line down in each iteration, processing the numbers in the middle line and looking for additional symbols in the lines before and after. The tricky part was to correctly track the data needed for processing of each line and discarding it in time, without resorting to reading all data in before processing.
The algorithm processes the numbers in the middle line and looks for additional symbols in the lines before and after. The tricky part was to correctly track the data needed for processing of each line and discarding it in time, without resorting to reading all data in before processing. I introduced the test framework for this puzzle while stumbling over quite a few bugs.
### Day 4: Scratchcards ## Day 4: Scratchcards
:mag_right: Puzzle: <https://adventofcode.com/2023/day/4>, :white_check_mark: Solver: [`UScratchcards.pas`](solvers/UScratchcards.pas) <https://adventofcode.com/2023/day/4>
For part 1, the algorithm simply matches winning numbers against numbers we have, and multiplies the current line result by two for every match (except the first). For part 1, the algorithm simply matches winning numbers against numbers we have, and multiplies the current line result by two for every match (except the first).
For part 2, there is a list of numbers of card copies for the upcoming cards, where the list index is shifted to be always relative to the current line. This works because the copies are always applied contiguously over upcoming cards. Once a card has been processed, its copy value is deleted from the beginning of the list. For part 2 there is a list of numbers of card copies for the upcoming cards, wher the list index is always relative to the current line. This works because the copies are always applied contiguously over upcoming cards. Once a card has been processed, its copy value is deleted from the beginning of the list (index 0).
### Day 5: If You Give A Seed A Fertilizer ## Day 5: If You Give A Seed A Fertilizer
:mag_right: Puzzle: <https://adventofcode.com/2023/day/5>, :white_check_mark: Solver: [`UGiveSeedFertilizer.pas`](solvers/UGiveSeedFertilizer.pas) <https://adventofcode.com/2023/day/5>
Originally, I had implemented this by reading all data in first, constructing a list of the seven mappings, each containing a list of mapping ranges. I rewrote this when I realized that the conversion can be done line-by-line by maintaining separate lists of "unconverted" and "converted" values. Each mapping range is applied to all unconverted values, and if one matches it is converted and moved into the list of converted values. At the end of a map all converted values are moved back into the unconverted list. Unconverted values simply remain unconverted for the next map. Originally, I had implemented this by reading all data in first, constructing a list of the seven mappings, each containing a list of mapping ranges. I rewrote this when I realized that the conversion can be done line-by-line by maintaining separate lists of "unconverted" and "converted" values. Each mapping range is applied to all unconverted values, and if one matches it is converted and moved into the list of converted values. At the end of a map all converted values are moved back into the unconverted list. Unconverted values simply remain unconverted for the next map.
For part 2, it is not necessary (and not feasible) to convert the input ranges into individual values to run through the existing algorithm. Instead I modified the algorithm to run on ranges of input directly. This means that a successful conversion can split a range in up to three parts, where one is moved into the "converted" pile, while the others remain unconverted. For part 2, it is not necessary (and not feasible) to convert the input ranges into individual values to run through the existing algorithm. Instead I modified the algorithm to run on ranges of input directly. This means that a successful conversion can split a range in up to three parts, where one is moved into the "converted" pile, while the others remain unconverted.
### Day 6: Wait For It ## Day 6: Wait For It
:mag_right: Puzzle: <https://adventofcode.com/2023/day/6>, :white_check_mark: Solver: [`UWaitForIt.pas`](solvers/UWaitForIt.pas) <https://adventofcode.com/2023/day/6>
This one I solved by calculating the roots of the function *f(x) = -time ^2 * x + distance* and determining the distance between them. Part 2 was the first puzzle where my solver required 64-bit integers for the calculations. This one I solved by calculating the roots of the function *f(x) = -time ^2 * x + distance* and determining the distance between them. Part 2 was the first puzzle that required 64-bit integers for the calculations.
### Day 7: Camel Cards ## Day 7: Camel Cards
:mag_right: Puzzle: <https://adventofcode.com/2023/day/7>, :white_check_mark: Solver: [`UCamelCards.pas`](solvers/UCamelCards.pas) <https://adventofcode.com/2023/day/7>
The first puzzle that I could not solve line-by-line (day 6 doesn't count). For this one I store all the card hands and assign them a "type", e.g. "four of a kind", when processing them by counting the different card values in a hand. The rest of work is done in a custom compare function. When all data is processed, I just use the compare function to sort all card hands, and then multiply the resulting indices with the bids. The first puzzle that I could not solve line-by-line (day 6 doesn't count). For this one I store all the card hands and assign them a "type", e.g. "four of a kind", when processing them by counting the different card values in a hand. The rest of work is done in a custom compare function. When all data is processed I just use the compare function to sort all card hands, and then multiply the resulting indices with the bids.
For part 2, each card hands gets a "joker type" analogous to the "type", for which the number of joker cards is added to the highest number of a different card type. For part 2, each card hands gets a "joker type" analoguous to the "type", for which the number of joker cards is added to the highest number of a different card type.
### Day 8: Haunted Wasteland ## Day 8: Haunted Wasteland
:mag_right: Puzzle: <https://adventofcode.com/2023/day/8>, :white_check_mark: Solver: [`UHauntedWasteland.pas`](solvers/UHauntedWasteland.pas) <https://adventofcode.com/2023/day/8>
Again a puzzle where I had to read in all of the data before starting the algorithm. It proved difficult to verify parts of the algorithm by hand, but part 1 was still pretty straight forward. Again a puzzle where I had to read in all of the data before starting the algorithm. It proved difficult to verify parts of the algorithm by hand, but part 1 was still pretty straight forward.
Part 2 was a bit sneaky. This is the first puzzle where the result is outside the 32-bit unsigned integer range. And it is solvable only because each starting node leads into a loop with one of the target nodes, where the length of the loop is a multiple of the length of the sequence of instructions. With this knowledge, one can stop traversing the network once each target node has been reached and calculate the result directly. Part 2 was a bit sneaky. This is the first puzzle where the result is outside the 32-bit unsigned integer range. And it is solvable only because each starting node leads into a loop with one of the target nodes, where the length of the loop is a multiple of the length of the sequence of instructions. With this knowledge, one can stop traversing the network once each target node has been reached and calculate the result directly.
### Day 9: Mirage Maintenance ## Day 9: Mirage Maintenance
:star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/9>, :white_check_mark: Solver: [`UMirageMaintenance.pas`](solvers/UMirageMaintenance.pas) <https://adventofcode.com/2023/day/9>
This one I enjoyed the most so far. The process that is described in the puzzle, constructing a series of differences from the previous series, and then reverting the process to extend the series, is equivalent to finding a polynomial with maximum degree of *n - 1*, where the original series are *n* equidistant values of the polynomial. This one I enjoyed the most so far. The process that is discribed in the puzzle, constructing a series of differences from the previous series, and then reverting the process to extend the series, is equivalent to finding a polynomial with maximum degree of *n - 1*, where the original series are *n* equidistant values of the polynomial.
So instead of using the outlined "brute force" method, I used Lagrange polynomials with *x1 = 0, x2 = 1, ..., xn = n - 1* evaluated at *x = n* (for part 1) and *x = -1* (for part 2) to find the function values for the extrapolated "points". Conveniently, the Lagrange polynomials can be precalculated for the whole puzzle (with some tricks to not run over Int64 limits) because they only depend on *x* values, which remain constant. This makes the calculation of the extrapolated values quite easy. So instead of using the outlined "brute force" method, I used Lagrange polynomials with *x1 = 0, x2 = 1, ..., xn = n - 1* evaluated at *x = n* (for part 1) and *x = -1* (for part 2) to find the function values for the extrapolated "points". Conveniently, the Lagrange polynomials can be precalculated for the whole puzzle (with some tricks to not run over Int64 limits) because they only depend on *x* values, which remain constant. This makes the calculation of the extrapolated values quite easy.
A nice explanation of the Lagrange method can be found here <http://bueler.github.io/M310F11/polybasics.pdf>. A nice explanation of the Lagrange method can be found here <http://bueler.github.io/M310F11/polybasics.pdf>.
### Day 10: Pipe Maze ## Day 10: Pipe Maze
:mag_right: Puzzle: <https://adventofcode.com/2023/day/10>, :white_check_mark: Solver: [`UPipeMaze.pas`](solvers/UPipeMaze.pas) <https://adventofcode.com/2023/day/10>
The input data is such that there are only two pipes pointing to *S*, so finding the loop is only a matter of following the chars as instructed. It seems best to read in the full input before trying to traverse the maze, I did not see another option. The length of the loop is always even, so my algorithm just follows the path until it is back to *S* and counts only every other step. The input data is such that there are only two pipes pointing to *S*, so it finding the loop is only a matter of following the chars as instructed. It seems best to read in the full input before trying to traverse the maze, I did not see another option. The length of the loop is always even, so my algorithm just follows the path until it is back to *S* and counts only every other step.
For part 2, I tracked tiles that are "left" and "right" of the path the algorithm took, and implemented a little flood-fill algorithm that tries to fill the area in between the "left" tiles and the "right" tiles, while counting them. The "outside" group is the one where the flood-fill touches the edge of the map and is simply ignored. For part 2, I tracked tiles that are "left" and "right" of the path the algorithm took, and implemented a little flood-fill algorithm that tries to fill the area in between the "left" tiles and the "right" tiles, while counting them. The "outside" group is the one where the flood-fill touches the edge of the map and is simply ignored.
### Day 11: Cosmic Expansion ## Day 11: Cosmic Expansion
:mag_right: Puzzle: <https://adventofcode.com/2023/day/11>, :white_check_mark: Solver: [`UCosmicExpansion.pas`](solvers/UCosmicExpansion.pas) <https://adventofcode.com/2023/day/11>
While parsing the input, the solver tracks coordinates of each galaxy, and for each row and column a *1* if it is empty and a *0* if not. At the end we sum for each pair of galaxies the values for each row and column between their coordinates *+1* to get the sum of their (Manhattan) distances. While parsing the input, we track coordinates of each galaxy, and for each row and column a *1* if it is empty and a *0* if not. At the end we sum for each pair of galaxies the values for each row and column between their coordinates *+1* to get the sum of their (Manhattan) distances.
This approach was trivial to adapt for part 2, since all that was needed was another factor that had to be multiplied with the values tracked for the rows and columns before applying the *+1*. This approach was trivial to adapt for part 2, since all that was needed was another factor that had to be multiplied with the values tracked for the rows and columns before applying the *+1*.
### Day 12: Hot Springs ## Day 13: Point of Incidence
:mag_right: Puzzle: <https://adventofcode.com/2023/day/12>, :white_check_mark: Solver: [`UHotSprings.pas`](solvers/UHotSprings.pas) <https://adventofcode.com/2023/day/13>
All arrangements for part 1 can easily be found by recursively trying all possible positions for each contiguous group of damaged springs in order. While going through each line, the algorithm keeps updating two lists of mirror candidates, separately for horizontal and vertical mirrors. For horizontal mirrors, a new candidate is added whenever two consecutive lines are identical. After it is added, new lines are each compared against the potentially mirrored earlier line, until the candidate is discarded or the last line successfully mirrored.
Interestingly for part 2, I found the improved version of algorithm relatively easy to describe, but tricky to implement. My solver essentially finds all combinations to assign each damaged group ("validation number") from the input to exactly one "block" (a maximal contiguous string of `#` and `?`), such that for each block the assigned groups would fit if all `#` were `?`. If the number of arrangements for a block is not trivial, the solver then finds all combinations to assign each "damage" (a maximal contiguous string of `#`) to one of the numbers assigned to the block, such that the unassigned numbers would still fit in between, for at least some arrangements of the assigned numbers. Lastly, the solver iterates through all combinations of actual positions of the numbers assigned to damages, and calculates the number of combinations to arrange the skipped numbers in between directly from binomial coefficients.
Importantly, the algorithm is optimized to discard any of the tested arrangements as early as possible. For example, if numbers assigned to a block lead to zero combinations for that block, the combination is discarded before numbers or blocks further right in the input are considered.
In addition, the solver keeps track of calculated combinations for all non-trivial number-to-block assignments, which helps because of the many duplicates due to the way in which the input for part 2 is created.
### Day 13: Point of Incidence
:mag_right: Puzzle: <https://adventofcode.com/2023/day/13>, :white_check_mark: Solver: [`UPointOfIncidence.pas`](solvers/UPointOfIncidence.pas)
While going through each line, the algorithm keeps updating two lists of mirror candidates, one for horizontal and one for vertical mirrors. For horizontal mirrors, a new candidate is added whenever two consecutive lines are identical. After it is added, new lines are each compared against the potentially mirrored earlier line, until the candidate is discarded or the last line successfully mirrored.
For vertical mirrors, all candidates are added during processing of the first line, based on whether they mirror the first line or not. While processing further lines, each candidates is verified against each line or discarded. For vertical mirrors, all candidates are added during processing of the first line, based on whether they mirror the first line or not. While processing further lines, each candidates is verified against each line or discarded.
To solve part 2, each candidate is allowed one character switch, and tracks whether that switch happened or not to successfully mirror all processed lines. If a second character switch is required or no switch had occurred at the end, the candidate is discarded. By setting this tracker as if a switch had already happened even for new candidates, both parts of the puzzle can be solved simultaneously. To solve part 2 as well, each candidate tracks whether one character was switched or not to successfully mirror all processed lines. If a second character switch is required or no switch had occurred at the end, the candidate is discarded. By setting this tracker as if a switch had already happened even for new candidates, both parts of the puzzle can be solved simultanously.
### Day 14: Parabolic Reflector Dish ## Day 14: Parabolic Reflector Dish
:mag_right: Puzzle: <https://adventofcode.com/2023/day/14>, :white_check_mark: Solver: [`UParabolicReflectorDish.pas`](solvers/UParabolicReflectorDish.pas) <https://adventofcode.com/2023/day/14>
I spent too much time on this one. I had originally implemented a relatively naive algorithm that would do the tilting of the platform by operating directly the string list, swapping out round rocks as it went, which seemed quite slow. I spent too much time on this one. I had originally implemented a relatively naive algorithm that would do the tilting of the platform by operating directly the string list, swapping out round rocks as it went, which seemed quite slow.
So I reimplemented the whole thing with proper data structures consisting of lists of non-empty intervals between cube-shaped rocks, and lists of rows and columns of rounded rocks, between which the algorithm would alternate, to facilitate a faster computation without string manipulation. This improved the performance of the algorithm, but unfortunately not as much as I had expected. So I reimplemented the whole thing with proper data structures consisting of lists of non-empty intervals between cube-shaped rocks, and lists of rows and columns of rounded rocks, between which the algorithm would alternate, to facilitate a faster computation without string manipulation. This improved the performance of the algorithm, but unfortunately not as much as I had expected.
An essential revelation to make any algorithm for this work is that the formations of the rounded rocks on the platform repeat while spinning it 1,000,000,000 times, so once a previous formation is discovered, the calculation can be short-cut significantly. An essential revelation to make any algorithm for this work is that the formations of the rounded rocks on the platform repeat while spinning it 1,000,000,000 times, so once a previous formation is discovered, the calculation can be severly short-cut.
### Day 15: Lens Library ## Day 15: Lens Library
:mag_right: Puzzle: <https://adventofcode.com/2023/day/15>, :white_check_mark: Solver: [`ULensLibrary.pas`](solvers/ULensLibrary.pas) <https://adventofcode.com/2023/day/15>
Pretty straight-forward implementation of a Hashmap with a custom Hash function. Pretty straight-forward implementation of a HASHMAP with custom HASH function.
### Day 16: The Floor Will Be Lava ## Day 16: The Floor Will Be Lava
:mag_right: Puzzle: <https://adventofcode.com/2023/day/16>, :white_check_mark: Solver: [`UFloorWillBeLava.pas`](solvers/UFloorWillBeLava.pas) <https://adventofcode.com/2023/day/16>
The solver calculates how a beam traverses through the grid until it is reflected outwards. Every time it hits a splitter, a new beam is put on a stack to be calculated later. I found the difficulty to be finding a good way to track how a beam has already traveled through the grid. This seems essential to detect when the calculation for a part of the beam can be aborted, since splitters can create loops. However, two beams could pass through the same tile in different ways without forming a loop. I settled for tracking four energy states for each tile of the grid, one being "not energized", two describing generically the two directions a beam could travel through some tiles, and one for the combination of those two directions. This energy state of the current field and the beam's direction could then be used to abandon a beam early, before it leaves the boundaries of the grid. Here I calculate how a beam traverses through the grid until it is reflected out of the grid. Everytime it hits a splitter a new beam is put on a stack to be calculated later. I found the difficulty to be to find a good way to track how a beam has already travelled through the grid. This seems essential to detect when calculation for a part of the beam can be aborted, since splitters can create loops. However, two beams could pass through the same tile without meeting. I settled for tracking four energy states for each tile of the grid, one being "not energized", two describing generically the two directions a beam could travel through some tiles, and one for the combination of those two directions, and then using the energy state of the current field and the beam's direction to stop it before it leaves the boundaries of the grid.
Once this was solved for one starting beam in part 1, I just iterated over all possible starting beams to find the maximum for part 2. Once this was solved for one starting beam in part 1, I just iterated over all possible starting beams to find the maximum for part 2.
### Day 17: Clumsy Crucible
:mag_right: Puzzle: <https://adventofcode.com/2023/day/17>, :white_check_mark: Solver: [`UClumsyCrucible.pas`](solvers/UClumsyCrucible.pas)
I initially tried to solve this with a simple depth first search for the minimum path, while abandoning branches immediately when they exceed the current lowest known path value. However, this approach is way to costly, even on the small example data. It takes too long for a branch to be abandoned, and sub-paths are re-calculated many times for each of the branches.
Instead, the solver uses a somewhat Dijkstra-inspired algorithm, where for each location in the grid, it tracks two values, one for each 2D axis, which describe the lowest known accumulated heat loss when going from this grid location to the end point with the first step along the associated axis. The solver starts at the end point, where these two values are zero, and gradually calculates the minima for all grid points, while keeping track of grid locations that need recalculations. Once all grid points have been calculated, the result can be taken directly from the starting grid location.
The main modification to the classic algorithm here is that in order to calculate e.g. the horizontal current minimum for a grid point, the vertical current minimum of its vertical neighbors within a certain range have to be considered. The difference between part 1 and 2 is only the specific range to be used.
### Day 18: Lavaduct Lagoon
:star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/18>, :white_check_mark: Solver: [`ULavaductLagoon.pas`](solvers/ULavaductLagoon.pas)
My first algorithm for part 1 was a simply tracking the trench in a top-view two-dimensional array and then flood-filling the outside of the trench to determine the full area. It worked, but there were two problems. Firstly, I had to iteratre over the list of digs twice in order to avoid resizing the array frequently. Secondly, the performance complexity of the algorthim depends largely on the size of the array, i.e. the length of the individual digs, so obviously it did not scale for part 2.
The final algorithm, uses the fact that either all right turns are convex or concave, locally, while all left turns are the opposite. That means that two consecutive turns in the same direction (a U-turn) enclose a rectangular area that is either inside or outside of the trench depending only on the direction of the two turns. So the algorthim simply collapses all U-turns it encounters into a straight dig instruction, thereby cutting of an area that is either added to or subtracted from the running area count.
These U-turn collapses are done immediately when adding digs because then the U-turns will always either be at the end of the list or just before the last collapse. One difficulty is that the in order for this to work well, the algorithm needs to ensure that consecutive digs are always perpendicular, merging any that are parallel into a single one.
### Day 19: Aplenty
:mag_right: Puzzle: <https://adventofcode.com/2023/day/19>, :white_check_mark: Solver: [`UAplenty.pas`](solvers/UAplenty.pas)
Since the workflows are at the beginning of the puzzle input, each machine part can be routed directly through the memorized workflows for part 1 when its line is processed. Each part starts at the `in` workflow and follows the checks and switches until it is either rejected or accepted. To benefit performance, the workflows cache links to each other for each switch, which are each set during the algorithm run after their first match.
For part two, a virtual "multi machine part" that represents all possible values of ratings, modelled as four integer intervals, is sent through the same workflow graph. Each time one of rules is applied to a multi machine part, it is split into up to three new multi machine parts that continue to go through the workflows on separate paths. This is similar to [my day 5 solution](#day-5-if-you-give-a-seed-a-fertilizer).
### Day 20: Pulse Propagation
:mag_right: Puzzle: <https://adventofcode.com/2023/day/20>, :white_check_mark: Solver: [`UPulsePropagation.pas`](solvers/UPulsePropagation.pas)
For part 1, it's quite straight forward to model and simulate the module pulses for the first 1000 button pushes.
Part 2 seemed pretty daunting at first (and probably is quite difficult in the general case), but investigating the graph of the module connection reveals pretty quickly that the modules form a set of four independent counters of button pushes modulo different reset values, such that `rx` receives one low pulse if and only if all four counters reset as a result of the same button push. Clearly, the first time this happens is when the button is pushed a number of times equal to the product of the four counters' reset values.
### Day 21: Step Counter
:mag_right: Puzzle: <https://adventofcode.com/2023/day/21>, :white_check_mark: Solver: [`UStepCounter.pas`](solvers/UStepCounter.pas)
Part 1 can comfortably be solved with a flood-fill algorithm. Counting every other traversed plot will emulate the trivial backtracking the elf can do, without having to do the actual backtracking in the algorithm.
For part 2, I noticed that the map is sparse enough so that all plots that are theoretically in range are also actually in reachable. This means that the algorithm only has to count empty plots within specific, different, disjoint areas on the map, and multiply them by the number of occurences of this piece of the map within the full shape of reachable plots. See [`UStepCounter.pas`, line 174](solvers/UStepCounter.pas#L174) for details.
Interestingly, this is the only puzzle besides [day 20](#day-20-pulse-propagation), which had no part 2 example, where my implementation cannot solve the part 2 examples, since the example map is not sparse and their step limits do not fit the algorithm's requirements.
### Day 22: Sand Slabs
:mag_right: Puzzle: <https://adventofcode.com/2023/day/22>, :white_check_mark: Solver: [`USandSlabs.pas`](solvers/USandSlabs.pas)
I first sort the bricks with a custom compare function, such that they can be stacked in this order on the ground without passing through each other. Then they can be processed one by one on the ground directly, while tracking the current height of the ground positions, essentially the top-view of the ground plot, and which bricks connect vertically.
For part 1, if a brick lands on a single supporting brick, that brick below cannot be disintegrated anymore and is removed from the count, if it could have been disintegrated before.
For part 2, given a starting brick, the algorithm makes use of the tracked vertical connections to find a group of bricks supported by it, such that all supports of the bricks in the group are also in the group. This group of bricks would fall if the starting brick was disintegrated, so its size is counted for each possible starting brick.
### Day 23: A Long Walk
:mag_right: Puzzle: <https://adventofcode.com/2023/day/23>, :white_check_mark: Solver: [`ULongWalk.pas`](solvers/ULongWalk.pas)
There is a nice *O(|V| * |E|)* algorithm for the maximum flow in a directed acyclic graph, if a topological ordering of the vertices is know. It's relatively easy to parse the edges ("paths") of the long walk from the input such that a topological ordering results, by adding the vertices ("crossings") only after all in-edges have been found.
For part 2, I believe there is no polynomial algorithm known for the general case, and even with the given restraints I was unable to come up with one. Instead, my solution uses a depth-first search to parse all options in the network. This was feasible for the given input with some smart data structures to limit iterations of the vertex or edge lists, and with shortcuts to determine early if a search branch can be abandoned.
### Day 24: Never Tell Me the Odds
:star: :mag_right: Puzzle: <https://adventofcode.com/2023/day/24>, :white_check_mark: Solver: [`UNeverTellMeTheOdds.pas`](solvers/UNeverTellMeTheOdds.pas)
While I found part 1 quite trivial, part 2 left me with the feeling that my approach might be mad. Eventually, I managed to find the ray hitting all other rays by solving the general equation system for three known and one unknown rays with some shortcuts for this particular problem, for example assuming the existence of a unique solution. However, this involved excessive manual pre-calculations, arbitrary length integer arithmetic, and a root finder for integer polynomials, all implemented by myself without additional third-party libraries.
### Day 25: Snowverload :star:
:mag_right: Puzzle: <https://adventofcode.com/2023/day/25>, :white_check_mark: Solver: [`USnowverload.pas`](solvers/USnowverload.pas)
This puzzle has only one part, for which my solver uses a graph data structure and runs [Karger's algorithm](https://en.wikipedia.org/wiki/Karger%27s_algorithm) on it until it finds a 3-cut. This was quite fun because I had known about Karger's algorithm, which is an efficient _probabilistic_ min-cut algorithm, but had not yet have the opportunity to implement it.
The main difficulty was to set up the graph data structure in such a way that the edge contractions from the algorithm can be reverted quickly to repeat the process.
## License ## License
Copyright (C) 2023-2024 Stefan Müller 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 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.

2
UBigInt.pas
View File

@ -91,8 +91,6 @@ type
class function FromBinaryString(const AValue: string): TBigInt; static; class function FromBinaryString(const AValue: string): TBigInt; static;
end; end;
TBigIntArray = array of TBigInt;
{ Operators } { Operators }
operator := (const A: Int64): TBigInt; operator := (const A: Int64): TBigInt;

105
UBinomialCoefficients.pas
View File

@ -1,105 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UBinomialCoefficients;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections;
type
TCardinalArray = array of Cardinal;
TCardinalArrays = specialize TList<TCardinalArray>;
{ TBinomialCoefficientCache }
TBinomialCoefficientCache = class
private
FCache: TCardinalArrays;
procedure AddRow;
public
constructor Create;
destructor Destroy; override;
// Returns N choose K, with N >= K >= 0.
function Get(const AN, AK: Cardinal): Cardinal;
// Returns the number of cached rows C = N + 1, where N is the highest from previously queried "N choose K". The
// actual number of cached binomial coefficient values is C * (C + 1) / 2.
function GetCachedRowsCount: Cardinal;
end;
var
BinomialCoefficients: TBinomialCoefficientCache;
implementation
{ TBinomialCoefficientCache }
procedure TBinomialCoefficientCache.AddRow;
var
row: TCardinalArray;
i: Cardinal;
begin
SetLength(row, FCache.Count + 1);
row[0] := 1;
if FCache.Count > 0 then
begin
row[FCache.Count] := 1;
for i := 1 to FCache.Count - 1 do
row[i] := FCache.Last[i - 1] + FCache.Last[i];
end;
FCache.Add(row);
end;
constructor TBinomialCoefficientCache.Create;
begin
FCache := TCardinalArrays.Create;
end;
destructor TBinomialCoefficientCache.Destroy;
begin
FCache.Free;
inherited Destroy;
end;
function TBinomialCoefficientCache.Get(const AN, AK: Cardinal): Cardinal;
var
i: Cardinal;
begin
if AN < AK then
raise ERangeError.Create('Cannot calculate binomial coefficient "n choose k" with k larger than n.');
for i := FCache.Count to AN do
AddRow;
Result := FCache[AN][AK];
end;
function TBinomialCoefficientCache.GetCachedRowsCount: Cardinal;
begin
Result := FCache.Count;
end;
initialization
BinomialCoefficients := TBinomialCoefficientCache.Create;
finalization
BinomialCoefficients.Free;
end.

50
UCommon.pas
View File

@ -1,50 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2023-2024 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 <http://www.gnu.org/licenses/>.
}
unit UCommon;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections;
type
PPoint = ^TPoint;
const
CNoDirection: TPoint = (X: 0; Y: 0);
CDirectionRight: TPoint = (X: 1; Y: 0);
CDirectionDown: TPoint = (X: 0; Y: 1);
CDirectionLeft: TPoint = (X: -1; Y: 0);
CDirectionUp: TPoint = (X: 0; Y: -1);
CDirectionRightDown: TPoint = (X: 1; Y: 1);
CDirectionRightUp: TPoint = (X: 1; Y: -1);
CDirectionLeftDown: TPoint = (X: -1; Y: 1);
CDirectionLeftUp: TPoint = (X: -1; Y: -1);
CPCardinalDirections: array[0..3] of PPoint = (@CDirectionRight, @CDirectionDown, @CDirectionLeft, @CDirectionUp);
type
TInt64Array = array of Int64;
TIntegerList = specialize TList<Integer>;
TPoints = specialize TList<TPoint>;
implementation
end.

161
UMultiIndexEnumerator.pas
View File

@ -1,161 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UMultiIndexEnumerator;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils;
type
TIndexArray = array of Integer;
TIndexValidationResult = (ivrValid, ivrSkip, ivrBacktrack);
TEnumerableMultiIndexStrategy = class;
{ TMultiIndexEnumerator }
TMultiIndexEnumerator = class(TInterfacedObject, specialize IEnumerator<TIndexArray>)
private
FStrategy: TEnumerableMultiIndexStrategy;
FCurrent: TIndexArray;
FMustInit: Boolean;
function UpdateArray(const AInit: Boolean): Boolean;
public
constructor Create(const AStrategy: TEnumerableMultiIndexStrategy);
function GetCurrent: TIndexArray;
function MoveNext: Boolean;
procedure Reset;
property Current: TIndexArray read GetCurrent;
end;
{ TEnumerableMultiIndexStrategy }
TEnumerableMultiIndexStrategy = class(TInterfacedObject, specialize IEnumerable<TIndexArray>)
public
function GetEnumerator: specialize IEnumerator<TIndexArray>;
// Returns the number of indices to iterate over, must return positive (non-zero) value.
function GetCardinality: Integer; virtual; abstract;
function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer;
out AStartIndexValue: Integer): Boolean; virtual; abstract;
function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer):
TIndexValidationResult; virtual; abstract;
end;
implementation
{ TMultiIndexEnumerator }
function TMultiIndexEnumerator.UpdateArray(const AInit: Boolean): Boolean;
var
i, initialized: Integer;
r: TIndexValidationResult;
begin
if AInit then
begin
i := 0;
initialized := -1;
end
else begin
i := Length(FCurrent) - 1;
initialized := i;
end;
while i < Length(FCurrent) do
begin
if initialized < i then
begin
// Checks whether start index value can be set, and backtracks or aborts if not.
if not FStrategy.TryGetStartIndexValue(FCurrent, i, FCurrent[i]) then
if i > 0 then
begin
Dec(i);
Continue;
end
else begin
Result := False;
Exit;
end
end
else
// Sets next candidate for current index value.
Inc(FCurrent[i]);
// Checks if current index value is valid, and increases it until it is, or backtracks or aborts if so indicated.
while True do
begin
r := FStrategy.ValidateIndexValue(FCurrent, i);
case r of
ivrValid: begin
initialized := i;
Inc(i);
Break;
end;
ivrSkip:
Inc(FCurrent[i]);
ivrBacktrack:
if i > 0 then
begin
Dec(i);
Break;
end
else begin
Result := False;
Exit;
end;
end;
end;
end;
Result := True;
end;
constructor TMultiIndexEnumerator.Create(const AStrategy: TEnumerableMultiIndexStrategy);
begin
FStrategy := AStrategy;
SetLength(FCurrent, FStrategy.GetCardinality);
Reset;
end;
function TMultiIndexEnumerator.GetCurrent: TIndexArray;
begin
Result := FCurrent;
end;
function TMultiIndexEnumerator.MoveNext: Boolean;
begin
Result := UpdateArray(FMustInit);
FMustInit := False;
end;
procedure TMultiIndexEnumerator.Reset;
begin
FMustInit := True;
end;
{ TEnumerableMultiIndexStrategy }
function TEnumerableMultiIndexStrategy.GetEnumerator: specialize IEnumerator<TIndexArray>;
begin
Result := TMultiIndexEnumerator.Create(Self);
end;
end.

220
UNumberTheory.pas
View File

@ -22,7 +22,7 @@ unit UNumberTheory;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, Generics.Collections, Math;
type type
@ -34,6 +34,52 @@ type
class function LeastCommonMultiple(AValue1, AValue2: Int64): Int64; class function LeastCommonMultiple(AValue1, AValue2: Int64): Int64;
end; end;
TInt64Array = array of Int64;
{ TIntegerFactor }
TIntegerFactor = record
Factor: Int64;
Exponent: Byte;
end;
TIntegerFactors = specialize TList<TIntegerFactor>;
{ TIntegerFactorization }
TIntegerFactorization = class
public
class function PollardsRhoAlgorithm(const AValue: Int64): TInt64Array;
class function GetNormalized(constref AIntegerFactorArray: TInt64Array): TIntegerFactors;
end;
{ TDividersEnumerator }
TDividersEnumerator = class
private
FFactors: TIntegerFactors;
FCurrentExponents: array of Byte;
function GetCount: Integer;
public
constructor Create(constref AIntegerFactorArray: TInt64Array);
destructor Destroy; override;
function GetCurrent: Int64;
function MoveNext: Boolean;
procedure Reset;
property Current: Int64 read GetCurrent;
property Count: Integer read GetCount;
end;
{ TDividers }
TDividers = class
private
FFactorArray: TInt64Array;
public
constructor Create(constref AIntegerFactorArray: TInt64Array);
function GetEnumerator: TDividersEnumerator;
end;
implementation implementation
{ TNumberTheory } { TNumberTheory }
@ -58,5 +104,177 @@ begin
Result := (Abs(AValue1) div GreatestCommonDivisor(AValue1, AValue2)) * Abs(AValue2); Result := (Abs(AValue1) div GreatestCommonDivisor(AValue1, AValue2)) * Abs(AValue2);
end; end;
{ TIntegerFactorization }
// https://en.wikipedia.org/wiki/Pollard%27s_rho_algorithm
class function TIntegerFactorization.PollardsRhoAlgorithm(const AValue: Int64): TInt64Array;
var
primes: specialize TList<Int64>;
composites: specialize TStack<Int64>;
factor, n: Int64;
i: Integer;
function G(const AX, AC: Int64): Int64;
begin
Result := (AX * AX + AC) mod n;
end;
function FindFactor(const AStartValue, AC: Int64): Int64;
var
x, y, d: Int64;
begin
x := AStartValue;
y := x;
d := 1;
while d = 1 do
begin
x := G(x, AC);
y := G(G(y, AC), AC);
d := TNumberTheory.GreatestCommonDivisor(Abs(x - y), n);
end;
Result := d;
end;
begin
primes := specialize TList<Int64>.Create;
composites := specialize TStack<Int64>.Create;
n := Abs(AValue);
while (n and 1) = 0 do
begin
primes.Add(2);
n := n shr 1;
end;
composites.Push(n);
while composites.Count > 0 do
begin
n := composites.Pop;
i := 0;
repeat
factor := FindFactor(2 + (i + 1) div 2, 1 - i div 2);
if factor < n then
begin
composites.Push(factor);
composites.Push(n div factor);
end;
Inc(i);
until (factor < n) or (i > 3);
if factor = n then
primes.Add(factor);
end;
Result := primes.ToArray;
primes.Free;
composites.Free;
end;
class function TIntegerFactorization.GetNormalized(constref AIntegerFactorArray: TInt64Array): TIntegerFactors;
var
i: Integer;
factor: Int64;
normal: TIntegerFactor;
found: Boolean;
begin
Result := TIntegerFactors.Create;
for factor in AIntegerFactorArray do
begin
found := False;
for i := 0 to Result.Count - 1 do
if Result[i].Factor = factor then
begin
found := True;
normal := Result[i];
Inc(normal.Exponent);
Result[i] := normal;
Break;
end;
if not found then
begin
normal.Factor := factor;
normal.Exponent := 1;
Result.Add(normal);
end;
end;
end;
{ TDividersEnumerator }
function TDividersEnumerator.GetCount: Integer;
var
factor: TIntegerFactor;
begin
if FFactors.Count > 0 then
begin
Result := 1;
for factor in FFactors do
Result := Result * factor.Exponent;
Dec(Result);
end
else
Result := 0;
end;
constructor TDividersEnumerator.Create(constref AIntegerFactorArray: TInt64Array);
begin
FFactors := TIntegerFactorization.GetNormalized(AIntegerFactorArray);
SetLength(FCurrentExponents, FFactors.Count);
end;
destructor TDividersEnumerator.Destroy;
begin
FFactors.Free;
end;
function TDividersEnumerator.GetCurrent: Int64;
var
i: Integer;
begin
Result := 1;
for i := Low(FCurrentExponents) to High(FCurrentExponents) do
if FCurrentExponents[i] > 0 then
Result := Result * Round(Power(FFactors[i].Factor, FCurrentExponents[i]));
end;
function TDividersEnumerator.MoveNext: Boolean;
var
i: Integer;
begin
Result := False;
i := 0;
while (i <= High(FCurrentExponents)) and (FCurrentExponents[i] >= FFactors[i].Exponent) do
begin
FCurrentExponents[i] := 0;
Inc(i);
end;
if i <= High(FCurrentExponents) then
begin
Inc(FCurrentExponents[i]);
Result := True;
end;
end;
procedure TDividersEnumerator.Reset;
var
i: Integer;
begin
for i := Low(FCurrentExponents) to High(FCurrentExponents) do
FCurrentExponents[i] := 0;
end;
{ TDividers }
constructor TDividers.Create(constref AIntegerFactorArray: TInt64Array);
begin
FFactorArray := AIntegerFactorArray;
end;
function TDividers.GetEnumerator: TDividersEnumerator;
begin
Result := TDividersEnumerator.Create(FFactorArray);
end;
end. end.

297
UPolynomial.pas
View File

@ -1,297 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UPolynomial;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, UBigInt;
type
TInt64Array = array of Int64;
{ TBigIntPolynomial }
TBigIntPolynomial = object
private
FCoefficients: array of TBigInt;
function GetDegree: Integer;
function GetCoefficient(const AIndex: Integer): TBigInt;
public
property Degree: Integer read GetDegree;
property Coefficient[const AIndex: Integer]: TBigInt read GetCoefficient;
function CalcValueAt(const AX: Int64): TBigInt;
function CalcSignVariations: Integer;
// Returns 2^n * f(x), given a polynomial f(x) and exponent n.
function ScaleByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial;
// Returns f(s * x), given a polynomial f(x) and scale factor s.
function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial;
// Returns f(2^n * x), given a polynomial f(x) and an exponent n.
function ScaleVariableByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial;
// Returns f(x / 2), given a polynomial f(x).
function ScaleVariableByHalf: TBigIntPolynomial;
// Returns f(x + 1), given a polynomial f(x).
function TranslateVariableByOne: TBigIntPolynomial;
// Returns a polynomial with the reverse order of coefficients, i.e. the polynomial
// a_0 * x^n + a_1 * x^(n - 1) + ... + a_(n - 1) * x + a_n,
// given a polynomial
// a_n * x^n + a_(n - 1) * x^(n - 1) + ... + a_1 * x + a_0.
function RevertOrderOfCoefficients: TBigIntPolynomial;
// Returns a polynomial with all coefficents shifted down one position, and the constant term removed. This should
// only be used when the constant term is zero and is then equivalent to a division of polynomial f(x) by x.
function DivideByVariable: TBigIntPolynomial;
function IsEqualTo(const AOther: TBigIntPolynomial): Boolean;
function ToString: string;
class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static;
end;
{ Operators }
operator = (const A, B: TBigIntPolynomial): Boolean;
operator <> (const A, B: TBigIntPolynomial): Boolean;
implementation
{ TBigIntPolynomial }
function TBigIntPolynomial.GetDegree: Integer;
begin
Result := Length(FCoefficients) - 1;
end;
function TBigIntPolynomial.GetCoefficient(const AIndex: Integer): TBigInt;
begin
Result := FCoefficients[AIndex];
end;
function TBigIntPolynomial.CalcValueAt(const AX: Int64): TBigInt;
var
i: Integer;
begin
Result := TBigInt.Zero;
for i := High(FCoefficients) downto 0 do
Result := Result * AX + FCoefficients[i];
end;
function TBigIntPolynomial.CalcSignVariations: Integer;
var
current, last, i: Integer;
begin
Result := 0;
last := 0;
for i := 0 to Length(FCoefficients) - 1 do
begin
current := FCoefficients[i].Sign;
if (current <> 0) and (last <> current) then
begin
if last <> 0 then
Inc(Result);
last := current
end;
end;
end;
function TBigIntPolynomial.ScaleByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial;
var
len, i: Integer;
begin
len := Length(FCoefficients);
SetLength(Result.FCoefficients, len);
for i := 0 to len - 1 do
Result.FCoefficients[i] := FCoefficients[i] << AExponent;
end;
function TBigIntPolynomial.ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial;
var
len, i: Integer;
factor: TBigInt;
begin
if AScaleFactor <> TBigInt.Zero then
begin
len := Length(FCoefficients);
SetLength(Result.FCoefficients, len);
Result.FCoefficients[0] := FCoefficients[0];
factor := AScaleFactor;
for i := 1 to len - 1 do begin
Result.FCoefficients[i] := FCoefficients[i] * factor;
factor := factor * AScaleFactor;
end;
end
else begin
SetLength(Result.FCoefficients, 1);
Result.FCoefficients[0] := TBigInt.Zero;
end;
end;
function TBigIntPolynomial.ScaleVariableByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial;
var
len, i: Integer;
shift: Cardinal;
begin
len := Length(FCoefficients);
SetLength(Result.FCoefficients, len);
Result.FCoefficients[0] := FCoefficients[0];
shift := AExponent;
for i := 1 to len - 1 do begin
Result.FCoefficients[i] := FCoefficients[i] << shift;
Inc(shift, AExponent);
end;
end;
function TBigIntPolynomial.ScaleVariableByHalf: TBigIntPolynomial;
var
len, i: Integer;
begin
len := Length(FCoefficients);
SetLength(Result.FCoefficients, len);
Result.FCoefficients[0] := FCoefficients[0];
for i := 1 to len - 1 do
Result.FCoefficients[i] := FCoefficients[i] >> i;
end;
function TBigIntPolynomial.TranslateVariableByOne: TBigIntPolynomial;
var
len, i, j: Integer;
factors: array of Cardinal;
begin
len := Length(FCoefficients);
SetLength(Result.FCoefficients, len);
SetLength(factors, len);
for i := 0 to len - 1 do
begin
Result.FCoefficients[i] := TBigInt.Zero;
factors[i] := 1;
end;
// Calculates new coefficients.
for i := 0 to len - 1 do
begin
for j := 0 to len - i - 1 do
begin
if (i <> 0) and (j <> 0) then
factors[j] := factors[j] + factors[j - 1];
Result.FCoefficients[i] := Result.FCoefficients[i] + factors[j] * FCoefficients[j + i];
end;
end;
end;
function TBigIntPolynomial.RevertOrderOfCoefficients: TBigIntPolynomial;
var
len, skip, i: Integer;
begin
// Counts the trailing zeros to skip.
len := Length(FCoefficients);
skip := 0;
while (skip < len) and (FCoefficients[skip] = 0) do
Inc(skip);
// Copies the other coefficients in reverse order.
SetLength(Result.FCoefficients, len - skip);
for i := skip to len - 1 do
Result.FCoefficients[len - i - 1] := FCoefficients[i];
end;
function TBigIntPolynomial.DivideByVariable: TBigIntPolynomial;
var
len: Integer;
begin
len := Length(FCoefficients);
if len > 1 then
Result.FCoefficients := Copy(FCoefficients, 1, len - 1)
else begin
SetLength(Result.FCoefficients, 1);
Result.FCoefficients[0] := TBigInt.Zero;
end;
end;
function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean;
var
i: Integer;
begin
if Length(FCoefficients) = Length(AOther.FCoefficients) then
begin
Result := True;
for i := 0 to Length(FCoefficients) - 1 do
if FCoefficients[i] <> AOther.FCoefficients[i] then
begin
Result := False;
Break;
end;
end
else
Result := False;
end;
function TBigIntPolynomial.ToString: string;
var
i: Integer;
begin
Result := FCoefficients[0].ToString;
for i := 1 to Length(FCoefficients) - 1 do
if i > 1 then
Result := Result + ' + ' + FCoefficients[i].ToString + ' * x^' + IntToStr(i)
else
Result := Result + ' + ' + FCoefficients[i].ToString + ' * x';
end;
class function TBigIntPolynomial.Create(const ACoefficients: array of TBigInt): TBigIntPolynomial;
var
high, i: integer;
begin
high := -1;
for i := Length(ACoefficients) - 1 downto 0 do
if ACoefficients[i] <> 0 then
begin
high := i;
Break;
end;
if high >= 0 then
begin
SetLength(Result.FCoefficients, high + 1);
for i := 0 to high do
Result.FCoefficients[i] := ACoefficients[i];
end
else begin
SetLength(Result.FCoefficients, 1);
Result.FCoefficients[0] := TBigInt.Zero;
end;
end;
{ Operators }
operator = (const A, B: TBigIntPolynomial): Boolean;
begin
Result := A.IsEqualTo(B);
end;
operator <> (const A, B: TBigIntPolynomial): Boolean;
begin
Result := not A.IsEqualTo(B);
end;
end.

205
UPolynomialRoots.pas
View File

@ -1,205 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UPolynomialRoots;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, UPolynomial, UBigInt;
type
{ TIsolatingInterval }
// Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A, B] in respect to
// [0, 2^boundexp], with A = C * 2^boundexp / 2^K and B = (C + H) * 2^boundexp / 2^K.
TIsolatingInterval = record
C: TBigInt;
K, H, BoundExp: Cardinal;
A, B: TBigInt;
end;
TIsolatingIntervals = specialize TList<TIsolatingInterval>;
TIsolatingIntervalArray = array of TIsolatingInterval;
{ TPolynomialRoots }
TPolynomialRoots = class
private
// Returns the exponent (base two) of an upper bound for the roots of the given polynomial, i.e. all real roots of
// the given polynomial are less or equal than 2^b, where b is the returned positive integer.
class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): Cardinal;
class function CreateIsolatingInterval(constref AC: TBigInt; const AK, AH: Cardinal; constref ABoundExp: Cardinal):
TIsolatingInterval;
public
// Returns root-isolating intervals for non-negative, non-multiple roots.
class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervalArray;
// Returns root-isolating intervals for non-multiple roots in the interval [0, 2^boundexp].
class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal;
const AFindIntegers: Boolean = False): TIsolatingIntervalArray;
// Returns non-negative, non-multiple, integer roots in the interval [0, 2^boundexp].
class function BisectInteger(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal):
TBigIntArray;
end;
implementation
{ TPolynomialRoots }
class function TPolynomialRoots.CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): Cardinal;
var
i, sign: Integer;
an, ai, max: TBigInt;
numeratorBit, denominatorBit: Int64;
begin
// We need a_n > 0 here, so we use -sign(a_n) instead of actually flipping the polynomial.
// Sign is not 0 because a_n is not 0.
an := APolynomial.Coefficient[APolynomial.Degree];
sign := -an.Sign;
// This is a simplification of Cauchy's bound to avoid division and make it a power of two.
// https://en.wikipedia.org/wiki/Geometrical_properties_of_polynomial_roots#Bounds_of_positive_real_roots
max := TBigInt.Zero;
for i := 0 to APolynomial.Degree - 1 do begin
ai := sign * APolynomial.Coefficient[i];
if max < ai then
max := ai;
end;
numeratorBit := max.GetMostSignificantBitIndex + 1;
denominatorBit := an.GetMostSignificantBitIndex;
Result := numeratorBit - denominatorBit;
end;
class function TPolynomialRoots.CreateIsolatingInterval(constref AC: TBigInt; const AK, AH: Cardinal;
constref ABoundExp: Cardinal): TIsolatingInterval;
begin
Result.C := AC;
Result.K := AK;
Result.H := AH;
Result.BoundExp := ABoundExp;
if ABoundExp >= AK then
begin
Result.A := AC << (ABoundExp - AK);
Result.B := (AC + AH) << (ABoundExp - AK);
end
else begin
Result.A := AC << (ABoundExp - AK);
Result.B := (AC + AH) << (ABoundExp - AK);
end;
end;
class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervalArray;
var
boundExp: Cardinal;
begin
boundExp := CalcUpperRootBound(APolynomial);
Result := BisectIsolation(APolynomial, boundExp);
end;
// This is adapted from https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method
class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal;
const AFindIntegers: Boolean): TIsolatingIntervalArray;
type
TWorkItem = record
C: TBigInt;
K: Cardinal;
P: TBigIntPolynomial;
end;
TWorkStack = specialize TStack<TWorkItem>;
var
item: TWorkItem;
stack: TWorkStack;
n, v: Integer;
varq: TBigIntPolynomial;
iso: TIsolatingIntervals;
begin
iso := TIsolatingIntervals.Create;
stack := TWorkStack.Create;
item.C := 0;
item.K := 0;
item.P := APolynomial.ScaleVariableByPowerOfTwo(ABoundExp);
stack.Push(item);
n := item.P.Degree;
while stack.Count > 0 do
begin
item := stack.Pop;
if item.P.Coefficient[0] = TBigInt.Zero then
begin
// Found an integer root at 0.
item.P := item.P.DivideByVariable;
Dec(n);
iso.Add(CreateIsolatingInterval(item.C, item.K, 0, ABoundExp));
end;
varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne;
v := varq.CalcSignVariations;
if (v > 1)
or ((v = 1) and AFindIntegers and (item.K < ABoundExp)) then
begin
// Bisects, first new work item is (2c, k + 1, 2^n * q(x/2)).
item.C := item.C << 1;
Inc(item.K);
item.P := item.P.ScaleVariableByHalf.ScaleByPowerOfTwo(n);
stack.Push(item);
// ... second new work item is (2c + 1, k + 1, 2^n * q((x+1)/2)).
item.C := item.C + 1;
item.P := item.P.TranslateVariableByOne;
stack.Push(item);
end
else if v = 1 then
begin
// Found isolating interval.
iso.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp));
end;
end;
Result := iso.ToArray;
iso.Free;
stack.Free;
end;
class function TPolynomialRoots.BisectInteger(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal):
TBigIntArray;
var
intervals: TIsolatingIntervalArray;
i: TIsolatingInterval;
r: specialize TList<TBigInt>;
value: Int64;
begin
// Calculates isolating intervals.
intervals := BisectIsolation(APolynomial, ABoundExp, True);
r := specialize TList<TBigInt>.Create;
for i in intervals do
if i.H = 0 then
r.Add(i.A)
else if i.A.TryToInt64(value) and (APolynomial.CalcValueAt(value) = 0) then
r.Add(value)
else if i.B.TryToInt64(value) and (APolynomial.CalcValueAt(value) = 0) then
r.Add(value);
Result := r.ToArray;
r.Free;
end;
end.

60
USolver.pas
View File

@ -63,15 +63,12 @@ type
TSolverEngine = class TSolverEngine = class
private private
FRelativeDataPaths: TStringArray; FRelativeDataPath: string;
public public
constructor Create(constref ARelativeDataPaths: TStringArray); constructor Create(const ARelativeDataPath: string);
procedure ProcessData(const ASolver: ISolver); procedure ProcessData(const ASolver: ISolver);
procedure Run(const ASolver: ISolver); procedure Run(const ASolver: ISolver);
procedure RunAndFree(const ASolver: ISolver); procedure RunAndFree(const ASolver: ISolver);
function HasValidDataPath(const ASolver: ISolver): Boolean;
function TryGetFirstValidDataPath(const ASolver: ISolver; out ODataFilePath: string): Boolean;
function GetInvalidDataPathMessage(const ASolver: ISolver): string;
end; end;
implementation implementation
@ -96,22 +93,19 @@ end;
{ TSolverEngine } { TSolverEngine }
constructor TSolverEngine.Create(constref ARelativeDataPaths: TStringArray); constructor TSolverEngine.Create(const ARelativeDataPath: string);
begin begin
if (ARelativeDataPaths = nil) or (Length(ARelativeDataPaths) = 0) then FRelativeDataPath := ARelativeDataPath;
raise EArgumentOutOfRangeException.Create('Must specify at least one data path.');
FRelativeDataPaths := ARelativeDataPaths;
end; end;
procedure TSolverEngine.ProcessData(const ASolver: ISolver); procedure TSolverEngine.ProcessData(const ASolver: ISolver);
var var
data: TextFile; data: TextFile;
dataFilePath, s: string; s: string;
begin begin
ASolver.Init; ASolver.Init;
TryGetFirstValidDataPath(ASolver, dataFilePath); AssignFile(data, ConcatPaths([FRelativeDataPath, ASolver.DataFileName]));
AssignFile(data, dataFilePath);
try try
reset(data); reset(data);
while (not EOF(data)) do while (not EOF(data)) do
@ -130,14 +124,9 @@ procedure TSolverEngine.Run(const ASolver: ISolver);
begin begin
WriteLn; WriteLn;
WriteLn('--- ', ASolver.PuzzleName, ' ---'); WriteLn('--- ', ASolver.PuzzleName, ' ---');
if HasValidDataPath(ASolver) then
begin
ProcessData(ASolver); ProcessData(ASolver);
WriteLn('Part 1: ', ASolver.ResultPart1); WriteLn('Part 1: ', ASolver.ResultPart1);
WriteLn('Part 2: ', ASolver.ResultPart2); WriteLn('Part 2: ', ASolver.ResultPart2);
end
else
WriteLn(GetInvalidDataPathMessage(ASolver));
end; end;
procedure TSolverEngine.RunAndFree(const ASolver: ISolver); procedure TSolverEngine.RunAndFree(const ASolver: ISolver);
@ -146,42 +135,5 @@ begin
ASolver.Free; ASolver.Free;
end; end;
function TSolverEngine.HasValidDataPath(const ASolver: ISolver): Boolean;
var
s: string;
begin
Result := TryGetFirstValidDataPath(ASolver, s);
end;
function TSolverEngine.TryGetFirstValidDataPath(const ASolver: ISolver; out ODataFilePath: string): Boolean;
var
path: string;
begin
for path in FRelativeDataPaths do
begin
ODataFilePath := ConcatPaths([path, ASolver.DataFileName]);
if FileExists(ODataFilePath) then
begin
Result := True;
Exit;
end;
end;
Result := False;
ODataFilePath := '';
end;
function TSolverEngine.GetInvalidDataPathMessage(const ASolver: ISolver): string;
var
i: Integer;
begin
Result := 'Cannot find puzzle input file '''
+ ExpandFileName(ConcatPaths([FRelativeDataPaths[0], ASolver.DataFileName]));
for i := 1 to Length(FRelativeDataPaths) - 1 do
Result := Result + ''', or '''
+ ExpandFileName(ConcatPaths([FRelativeDataPaths[i], ASolver.DataFileName]));
Result := Result + '''. Please download the file content from https://adventofcode.com/2023/';
end;
end. end.

302
solvers/UClumsyCrucible.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,78 +22,14 @@ unit UClumsyCrucible;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, Math, USolver, UCommon; Classes, SysUtils, USolver;
type type
{ TAxisData }
TAxisData = record
// The current minimum total heat loss to get from this node to the end if the first step is on this axis.
Minimum: Cardinal;
// True, if and only if the minimum has been set, i.e. a path has been found from this node to the end, with the
// first step on this axis.
IsTraversed,
// True. if a close node was updated (traversed) on the other axis, such that this minimum might be outdated. This
// means that if this node is on the work list, NeedsUpdate is True for at least one of the axes.
NeedsUpdate: Boolean;
end;
TAxisId = (axHorizontal, axVertical);
const
CAxisDirections: array[TAxisId] of array[0..1] of PPoint
= ((@CDirectionRight, @CDirectionLeft), (@CDirectionDown, @CDirectionUp));
COtherAxes: array[TAxisId] of TAxisId = (axVertical, axHorizontal);
type
{ TNode }
TNode = record
Axes: array[TAxisId] of TAxisData;
LocalHeatLoss: Byte;
end;
PNode = ^TNode;
TNodeArray = array of TNode;
TNodeArrays = specialize TList<TNodeArray>;
TWorkQueue = specialize TQueue<TPoint>;
{ TNodeMap }
TNodeMap = class
private
// Each item in FNodes is a horizontal row of nodes.
FNodes: TNodeArrays;
FWidth: Integer;
FMinStraight, FMaxStraight: Integer;
function GetHeight: Integer;
function GetNode(APosition: TPoint): TNode;
function GetPNode(APosition: TPoint): PNode;
function IsPositionInMap(constref APosition: TPoint): Boolean;
procedure ClampPositionToMap(var APosition: TPoint);
procedure InitWorkQueue(constref AWorkQueue: TWorkQueue);
procedure InvalidateNeighbors(constref AWorkQueue: TWorkQueue; const AAxis: TAxisId; constref APosition: TPoint);
function FindStepNodeMinimum(const AAxis: TAxisId; constref APosition: TPoint): Cardinal;
public
property Width: Integer read FWidth;
property Height: Integer read GetHeight;
constructor Create;
destructor Destroy; override;
procedure AddNodes(const ALine: string);
function FindMinimumPathLength(const AMinStraight, AMaxStraight: Integer): Cardinal;
procedure Reset;
end;
{ TClumsyCrucible } { TClumsyCrucible }
TClumsyCrucible = class(TSolver) TClumsyCrucible = class(TSolver)
private
FMap: TNodeMap;
public public
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override; procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override; procedure Finish; override;
function GetDataFileName: string; override; function GetDataFileName: string; override;
@ -102,246 +38,16 @@ type
implementation implementation
const
CMinStraight = 1;
CMaxStraight = 3;
CUltraMinStraight = 4;
CUltraMaxStraight = 10;
{ TNodeMap }
function TNodeMap.GetHeight: Integer;
begin
Result := FNodes.Count;
end;
function TNodeMap.GetNode(APosition: TPoint): TNode;
begin
Result := FNodes[APosition.Y][APosition.X];
end;
function TNodeMap.GetPNode(APosition: TPoint): PNode;
begin
Result := @FNodes[APosition.Y][APosition.X];
end;
function TNodeMap.IsPositionInMap(constref APosition: TPoint): Boolean;
begin
Result := (0 <= APosition.X) and (APosition.X < Width) and (0 <= APosition.Y) and (APosition.Y < Height);
end;
procedure TNodeMap.ClampPositionToMap(var APosition: TPoint);
begin
if APosition.X < -1 then
APosition.X := -1
else if APosition.X > Width then
APosition.X := Width;
if APosition.Y < -1 then
APosition.Y := -1
else if APosition.Y > Height then
APosition.Y := Height;
end;
procedure TNodeMap.InitWorkQueue(constref AWorkQueue: TWorkQueue);
var
position: TPoint;
last: PNode;
axis: TAxisId;
begin
// Initializes the end node and the work queue with its neighbors.
position := Point(Width - 1, Height - 1);
last := GetPNode(position);
for axis in TAxisId do
begin
last^.Axes[axis].Minimum := 0;
last^.Axes[axis].IsTraversed := True;
end;
InvalidateNeighbors(AWorkQueue, axHorizontal, position);
InvalidateNeighbors(AWorkQueue, axVertical, position);
end;
procedure TNodeMap.InvalidateNeighbors(constref AWorkQueue: TWorkQueue; const AAxis: TAxisId; constref APosition:
TPoint);
var
otherAxis: TAxisId;
nodeMinimum: Cardinal;
direction: PPoint;
neighborPos, stop: TPoint;
neighbor: PNode;
begin
otherAxis := COtherAxes[AAxis];
nodeMinimum := GetNode(APosition).Axes[otherAxis].Minimum;
for direction in CAxisDirections[AAxis] do
begin
neighborPos := Point(APosition.X + direction^.X * FMinStraight, APosition.Y + direction^.Y * FMinStraight);
if IsPositionInMap(neighborPos) then
begin
stop := Point(APosition.X + direction^.X * (FMaxStraight + 1), APosition.Y + direction^.Y * (FMaxStraight + 1));
ClampPositionToMap(stop);
while neighborPos <> stop do
begin
neighbor := GetPNode(neighborPos);
if not neighbor^.Axes[AAxis].NeedsUpdate
and (not neighbor^.Axes[AAxis].IsTraversed or (neighbor^.Axes[AAxis].Minimum > nodeMinimum)) then
begin
neighbor^.Axes[AAxis].NeedsUpdate := True;
if not neighbor^.Axes[otherAxis].NeedsUpdate then
AWorkQueue.Enqueue(neighborPos);
end;
neighborPos := neighborPos + direction^;
end;
end;
end;
end;
function TNodeMap.FindStepNodeMinimum(const AAxis: TAxisId; constref APosition: TPoint): Cardinal;
var
otherAxis: TAxisId;
direction: PPoint;
acc: Cardinal;
neighborPos, start, stop: TPoint;
isStartReached: Boolean;
neighbor: TNode;
begin
otherAxis := COtherAxes[AAxis];
Result := Cardinal.MaxValue;
for direction in CAxisDirections[AAxis] do
begin
acc := 0;
isStartReached := False;
neighborPos := APosition + direction^;
start := Point(APosition.X + direction^.X * FMinStraight, APosition.Y + direction^.Y * FMinStraight);
if IsPositionInMap(start) then
begin
stop := Point(APosition.X + direction^.X * (FMaxStraight + 1), APosition.Y + direction^.Y * (FMaxStraight + 1));
ClampPositionToMap(stop);
while neighborPos <> stop do
begin
if neighborPos = start then
isStartReached := True;
neighbor := GetNode(neighborPos);
Inc(acc, neighbor.LocalHeatLoss);
if isStartReached and neighbor.Axes[otherAxis].IsTraversed then
Result := Min(Result, neighbor.Axes[otherAxis].Minimum + acc);
neighborPos := neighborPos + direction^;
end;
end;
end;
end;
constructor TNodeMap.Create;
begin
FNodes := TNodeArrays.Create;
end;
destructor TNodeMap.Destroy;
begin
FNodes.Free;
inherited Destroy;
end;
procedure TNodeMap.AddNodes(const ALine: string);
var
i: Integer;
nodes: TNodeArray;
axis: TAxisId;
begin
FWidth := Length(ALine);
SetLength(nodes, FWidth);
for i := 0 to FWidth - 1 do
begin
nodes[i].LocalHeatLoss := StrToInt(ALine[i + 1]);
for axis in TAxisId do
begin
nodes[i].Axes[axis].IsTraversed := False;
nodes[i].Axes[axis].NeedsUpdate := False;
end;
end;
FNodes.Add(nodes);
end;
function TNodeMap.FindMinimumPathLength(const AMinStraight, AMaxStraight: Integer): Cardinal;
var
queue: TWorkQueue;
position: TPoint;
node: PNode;
axis: TAxisId;
start: TNode;
newMinimum: Cardinal;
begin
FMinStraight := AMinStraight;
FMaxStraight := AMaxStraight;
queue := TWorkQueue.Create;
InitWorkQueue(queue);
// Processes work queue.
while queue.Count > 0 do
begin
position := queue.Dequeue;
node := GetPNode(position);
for axis in TAxisId do
if node^.Axes[axis].NeedsUpdate then
begin
node^.Axes[axis].NeedsUpdate := False;
// Finds minimum for one step from this node along this axis.
newMinimum := FindStepNodeMinimum(axis, position);
if not node^.Axes[axis].IsTraversed or (node^.Axes[axis].Minimum > newMinimum) then
begin
// Updates this axis minimum and queues update for neighbors on the other axis.
node^.Axes[axis].IsTraversed := True;
node^.Axes[axis].Minimum := newMinimum;
InvalidateNeighbors(queue, COtherAxes[axis], position);
end;
end;
end;
queue.Free;
start := GetNode(Point(0, 0));
Result := Min(start.Axes[axHorizontal].Minimum, start.Axes[axVertical].Minimum);
end;
procedure TNodeMap.Reset;
var
i, j: Integer;
axis: TAxisId;
begin
for i := 0 to Width - 1 do
for j := 0 to Height - 1 do
for axis in TAxisId do
begin
FNodes[j][i].Axes[axis].IsTraversed := False;
FNodes[j][i].Axes[axis].NeedsUpdate := False;
end;
end;
{ TClumsyCrucible } { TClumsyCrucible }
constructor TClumsyCrucible.Create;
begin
FMap := TNodeMap.Create;
end;
destructor TClumsyCrucible.Destroy;
begin
FMap.Free;
inherited Destroy;
end;
procedure TClumsyCrucible.ProcessDataLine(const ALine: string); procedure TClumsyCrucible.ProcessDataLine(const ALine: string);
begin begin
FMap.AddNodes(ALine);
end; end;
procedure TClumsyCrucible.Finish; procedure TClumsyCrucible.Finish;
begin begin
FPart1 := FMap.FindMinimumPathLength(CMinStraight, CMaxStraight);
FMap.Reset;
FPart2 := FMap.FindMinimumPathLength(CUltraMinStraight, CUltraMaxStraight);
end; end;
function TClumsyCrucible.GetDataFileName: string; function TClumsyCrucible.GetDataFileName: string;

12
solvers/UCosmicExpansion.pas
View File

@ -22,7 +22,7 @@ unit UCosmicExpansion;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, Math, USolver, UCommon; Classes, SysUtils, Generics.Collections, Math, USolver;
const const
CGalaxyChar = '#'; CGalaxyChar = '#';
@ -36,8 +36,8 @@ type
TCosmicExpansion = class(TSolver) TCosmicExpansion = class(TSolver)
private private
FExpansionFactor: Integer; FExpansionFactor: Integer;
FColumnExpansion, FRowExpansion: TIntegerList; FColumnExpansion, FRowExpansion: specialize TList<Integer>;
FGalaxies: TPoints; FGalaxies: specialize TList<TPoint>;
procedure InitColumnExpansion(const ASize: Integer); procedure InitColumnExpansion(const ASize: Integer);
public public
constructor Create(const AExpansionFactor: Integer = 999999); constructor Create(const AExpansionFactor: Integer = 999999);
@ -67,9 +67,9 @@ end;
constructor TCosmicExpansion.Create(const AExpansionFactor: Integer); constructor TCosmicExpansion.Create(const AExpansionFactor: Integer);
begin begin
FExpansionFactor := AExpansionFactor; FExpansionFactor := AExpansionFactor;
FColumnExpansion := TIntegerList.Create; FColumnExpansion := specialize TList<Integer>.Create;
FRowExpansion := TIntegerList.Create; FRowExpansion := specialize TList<Integer>.Create;
FGalaxies := TPoints.Create; FGalaxies := specialize TList<TPoint>.Create;
end; end;
destructor TCosmicExpansion.Destroy; destructor TCosmicExpansion.Destroy;

41
solvers/UFloorWillBeLava.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,7 +22,7 @@ unit UFloorWillBeLava;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, USolver, UCommon; Classes, SysUtils, Generics.Collections, USolver;
type type
@ -37,7 +37,7 @@ type
{ TTransition } { TTransition }
TTransition = record TTransition = record
IncomingDirection, OutgoingDirection, SplitDirection: PPoint; IncomingDirection, OutgoingDirection, SplitDirection: TPoint;
Tile: Char; Tile: Char;
EnergyChange: TEnergyState; EnergyChange: TEnergyState;
end; end;
@ -73,31 +73,32 @@ type
end; end;
const const
CNoDirection: TPoint = (X: 0; Y: 0);
CEmptyChar = '.'; CEmptyChar = '.';
CTransitions: array of TTransition = ( CTransitions: array of TTransition = (
(IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionUp; SplitDirection: @CNoDirection; Tile: '/'; (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esWestOrHorizontal), EnergyChange: esWestOrHorizontal),
(IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionLeft; SplitDirection: @CNoDirection; Tile: '/'; (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esWestOrHorizontal), EnergyChange: esWestOrHorizontal),
(IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionDown; SplitDirection: @CNoDirection; Tile: '/'; (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esEastOrVertical), EnergyChange: esEastOrVertical),
(IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionRight; SplitDirection: @CNoDirection; Tile: '/'; (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '/';
EnergyChange: esEastOrVertical), EnergyChange: esEastOrVertical),
(IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionDown; SplitDirection: @CNoDirection; Tile: '\'; (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: 1); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esWestOrHorizontal), EnergyChange: esWestOrHorizontal),
(IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionRight; SplitDirection: @CNoDirection; Tile: '\'; (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: 1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esEastOrVertical), EnergyChange: esEastOrVertical),
(IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionUp; SplitDirection: @CNoDirection; Tile: '\'; (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esEastOrVertical), EnergyChange: esEastOrVertical),
(IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionLeft; SplitDirection: @CNoDirection; Tile: '\'; (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 0; Y: 0); Tile: '\';
EnergyChange: esWestOrHorizontal), EnergyChange: esWestOrHorizontal),
(IncomingDirection: @CDirectionRight; OutgoingDirection: @CDirectionUp; SplitDirection: @CDirectionDown; Tile: '|'; (IncomingDirection: (X: 1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|';
EnergyChange: esBoth), EnergyChange: esBoth),
(IncomingDirection: @CDirectionLeft; OutgoingDirection: @CDirectionUp; SplitDirection: @CDirectionDown; Tile: '|'; (IncomingDirection: (X: -1; Y: 0); OutgoingDirection: (X: 0; Y: -1); SplitDirection: (X: 0; Y: 1); Tile: '|';
EnergyChange: esBoth), EnergyChange: esBoth),
(IncomingDirection: @CDirectionDown; OutgoingDirection: @CDirectionLeft; SplitDirection: @CDirectionRight; Tile: '-'; (IncomingDirection: (X: 0; Y: 1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-';
EnergyChange: esBoth), EnergyChange: esBoth),
(IncomingDirection: @CDirectionUp; OutgoingDirection: @CDirectionLeft; SplitDirection: @CDirectionRight; Tile: '-'; (IncomingDirection: (X: 0; Y: -1); OutgoingDirection: (X: -1; Y: 0); SplitDirection: (X: 1; Y: 0); Tile: '-';
EnergyChange: esBoth) EnergyChange: esBoth)
); );
@ -192,11 +193,11 @@ begin
begin begin
// Checks the current position for direction changes and splits. // Checks the current position for direction changes and splits.
for transition in CTransitions do for transition in CTransitions do
if (transition.IncomingDirection^ = ABeam.Direction) and (transition.Tile = GetTile(ABeam.Position)) then if (transition.IncomingDirection = ABeam.Direction) and (transition.Tile = GetTile(ABeam.Position)) then
begin begin
if transition.SplitDirection^ <> CNoDirection then if transition.SplitDirection <> CNoDirection then
stack.Push(GetNewBeam(ABeam.Position + transition.SplitDirection^, transition.SplitDirection^)); stack.Push(GetNewBeam(ABeam.Position + transition.SplitDirection, transition.SplitDirection));
ABeam.Direction := transition.OutgoingDirection^; ABeam.Direction := transition.OutgoingDirection;
energyChange := transition.EnergyChange; energyChange := transition.EnergyChange;
Break; Break;
end; end;
@ -268,7 +269,7 @@ end;
function TFloorWillBeLava.GetDataFileName: string; function TFloorWillBeLava.GetDataFileName: string;
begin begin
Result := 'the_floor_will_be_lava.txt'; Result := 'floor_will_be_lava.txt';
end; end;
function TFloorWillBeLava.GetPuzzleName: string; function TFloorWillBeLava.GetPuzzleName: string;

2
solvers/UGiveSeedFertilizer.pas
View File

@ -255,7 +255,7 @@ end;
function TGiveSeedFertilizer.GetDataFileName: string; function TGiveSeedFertilizer.GetDataFileName: string;
begin begin
Result := 'if_you_give_a_seed_a_fertilizer.txt'; Result := 'give_seed_fertilizer.txt';
end; end;
function TGiveSeedFertilizer.GetPuzzleName: string; function TGiveSeedFertilizer.GetPuzzleName: string;

757
solvers/UHotSprings.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,176 +22,27 @@ unit UHotSprings;
interface interface
uses uses
Classes, SysUtils, Math, Generics.Collections, USolver, UCommon, UMultiIndexEnumerator, UBinomialCoefficients; Classes, SysUtils, Generics.Collections, USolver;
const const
COperationalChar = '.'; COperationalChar = '.';
CDamagedChar = '#'; CDamagedChar = '#';
CWildcardChar = '?'; CWildcardChar = '?';
CPart2Repetition = 5; COperationalPatternChars = [COperationalChar, CWildcardChar];
CDamagedPatternChars = [CDamagedChar, CWildcardChar];
type type
TValidationLengths = array of array of Integer;
{ TDamage }
TDamage = record
Start, Length, CharsRemaining: Integer;
end;
TDamages = specialize TList<TDamage>;
TBlockCombinationsCache = specialize THashMap<Int64, Int64>;
TCombinationsCache = specialize TObjectHashMap<string, TBlockCombinationsCache>;
{ TBlock }
TBlock = class
private
FPattern: string;
FDamages: TDamages;
FCombinationsCache: TBlockCombinationsCache;
procedure ParseDamages;
public
constructor Create(const APattern: string; constref ACombinationsCache: TBlockCombinationsCache);
destructor Destroy; override;
property Pattern: string read FPattern;
// List of damages in this block, containing exactly one entry for each sequence of consecutive damage characters in
// the block's pattern, ordered such that a damage with lower index is further left.
// For example, if Pattern is '??##?#?', then Damages would have 2 entries.
property Damages: TDamages read FDamages;
property CombinationsCache: TBlockCombinationsCache read FCombinationsCache;
end;
TBlocks = specialize TObjectList<TBlock>;
{ TAccumulatedCombinationsMultiIndexStrategy }
// Adds accumulated combinations to the enumerable strategy to allow calculation of combinations on the fly, and
// therefore early rejection of invalid multi-index configurations.
TAccumulatedCombinationsMultiIndexStrategy = class(TEnumerableMultiIndexStrategy)
private
FAccumulatedCombinations: TInt64Array;
protected
function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; virtual;
abstract;
function UpdateCombinations(const AValidationResult: TIndexValidationResult; constref ACurrentIndexArray:
TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult;
public
function GetCombinations: Int64;
end;
TConditionRecord = class;
{ TValidationsToBlockAssignments }
// Enumerable strategy that enumerates all valid assignments of ranges of validation numbers to individual blocks in
// the form of start and stop indices.
TValidationsToBlockAssignments = class(TAccumulatedCombinationsMultiIndexStrategy)
private
FConditionRecord: TConditionRecord;
protected
function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override;
public
constructor Create(constref AConditionRecord: TConditionRecord);
function GetCardinality: Integer; override;
function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer;
out AStartIndexValue: Integer): Boolean; override;
function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer):
TIndexValidationResult; override;
end;
{ TDamageToValidationAssignments }
// Enumerable strategy that enumerates all valid assignments of each damage in the block to a specific validation
// number from the validation numbers that have been assigned to the block, as indicated by start and stop indices.
TDamageToValidationAssignments = class(TEnumerableMultiIndexStrategy)
private
FConditionRecord: TConditionRecord;
FBlock: TBlock;
FValidationStartIndex, FValidationStopIndex: Integer;
// Calculates "span", the length of all damages for one validation number combined.
function CalcValidationSpan(constref ACurrentIndexArray: TIndexArray; const ALastDamageIndex, AValidationNumber:
Integer): Integer;
public
constructor Create(constref AConditionRecord: TConditionRecord; constref ABlock: TBlock;
const AStartValidationIndex, AStopValidationIndex: Integer);
function GetCardinality: Integer; override;
function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer;
out AStartIndexValue: Integer): Boolean; override;
function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer):
TIndexValidationResult; override;
end;
{ TValidationPositionInfo }
TValidationPositionInfo = record
ValidationIndex, MinStart, MaxStart: Integer;
end;
TValidationPositionInfos = specialize TList<TValidationPositionInfo>;
{ TValidationPositionOffsets }
// Enumerable strategy that enumerates all valid assignments of start positions (positions mean character indices in
// the block patterns) of validation numbers that have been assigned to damages in the current block, as indicated by
// provided TValidationPositionInfos.
TValidationPositionOffsets = class(TAccumulatedCombinationsMultiIndexStrategy)
private
FConditionRecord: TConditionRecord;
FPositionInfos: TValidationPositionInfos;
FBlockLength, FValidationStartIndex, FValidationStopIndex: Integer;
protected
function CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): Int64; override;
public
constructor Create(constref AConditionRecord: TConditionRecord; constref APositionInfos: TValidationPositionInfos;
const ABlockLength, AValidationStartIndex, AValidationStopIndex: Integer);
function GetCardinality: Integer; override;
function TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer;
out AStartIndexValue: Integer): Boolean; override;
function ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer):
TIndexValidationResult; override;
end;
{ TConditionRecord }
TConditionRecord = class
private
// List of validation numbers as stated in the problem input.
FValidation: TIntegerList;
// List of non-empty, maximum-length parts of the pattern without operational springs ("blocks").
FBlocks: TBlocks;
// Array 'a' of accumulated validation series lengths. 'a[i, j]' denotes the combined length of consecutive
// validation numbers from 'FValidation[i]' to 'FValidation[j - 1]' with a single space in between each pair of
// them.
FValidationLengths: TValidationLengths;
// Array 'a' of minimum indices 'a[i]', such that all remaining validation numbers starting at index 'a[i] - 1'
// cannot fit into the remaining blocks starting at 'FBlocks[i]'.
FMinIndices: TIndexArray;
FCombinationsCache: TCombinationsCache;
procedure InitValidationLengths;
procedure InitMinIndices;
function CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64;
function CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices: TIndexArray;
const AStartIndex, AStopIndex: Integer): Int64;
function CalcValidationsId(const AStartIndex, AStopIndex: Integer): Int64;
public
constructor Create(constref ACombinationsCache: TCombinationsCache);
destructor Destroy; override;
// Adds all non-empty, maximum-length parts of the pattern without operational springs ("blocks").
procedure AddBlocks(const APattern: string);
function GenerateBlockAssignments: Int64;
function CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64;
function CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer): Int64;
property Validation: TIntegerList read FValidation;
property Blocks: TBlocks read FBlocks;
property ValidationLengths: TValidationLengths read FValidationLengths;
property MinIndices: TIndexArray read FMinIndices;
end;
{ THotSprings } { THotSprings }
THotSprings = class(TSolver) THotSprings = class(TSolver)
private private
FCombinationsCache: TCombinationsCache; FValidation: specialize TList<Integer>;
FSpringPattern: string;
procedure ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount, ACurrentValidationIndex:
Integer);
function TryAppendOperationalChar(var AArrangement: string): Boolean;
function TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -203,549 +54,99 @@ type
implementation implementation
{ TBlock } { THotSprings }
procedure TBlock.ParseDamages; procedure THotSprings.ExtendArrangement(const AArrangement: string; const ARemainingFreeOperationalCount,
ACurrentValidationIndex: Integer);
var
match: Boolean;
temp: string;
begin
if Length(AArrangement) = Length(FSpringPattern) then
Inc(FPart1)
else begin
temp := AArrangement;
// Tries to append a dot (operational) to the current arrangement.
if (ARemainingFreeOperationalCount > 0) and TryAppendOperationalChar(temp) then
begin
ExtendArrangement(temp, ARemainingFreeOperationalCount - 1, ACurrentValidationIndex);
end;
// Tries to append the current validation block (damaged) to the current arrangement.
if ACurrentValidationIndex < FValidation.Count then
begin
temp := AArrangement;
match := TryAppendValidationBlock(temp, FValidation[ACurrentValidationIndex]);
// ... and the mandatory dot after the block, if it is not the last block.
if match
and (ACurrentValidationIndex < FValidation.Count - 1)
and not TryAppendOperationalChar(temp) then
match := False;
if match then
ExtendArrangement(temp, ARemainingFreeOperationalCount, ACurrentValidationIndex + 1);
end;
end;
end;
function THotSprings.TryAppendOperationalChar(var AArrangement: string): Boolean;
begin
if FSpringPattern[Length(AArrangement) + 1] in COperationalPatternChars then
begin
AArrangement := AArrangement + COperationalChar;
Result := True;
end
else
Result := False;
end;
function THotSprings.TryAppendValidationBlock(var AArrangement: string; const ALength: Integer): Boolean;
var var
i, len: Integer; i, len: Integer;
damage: TDamage;
begin
FDamages := TDamages.Create;
damage.Length := 0;
len := Length(FPattern);
for i := 1 to len do
// The pattern must only contain damage and wildcard characters here.
if FPattern[i] = CDamagedChar then
begin
if damage.Length = 0 then
damage.Start := i;
Inc(damage.Length);
end
else if damage.Length > 0 then
begin
damage.CharsRemaining := len - damage.Start - damage.Length + 1;
FDamages.Add(damage);
damage.Length := 0;
end;
if damage.Length > 0 then
begin
damage.CharsRemaining := 0;
FDamages.Add(damage);
end;
end;
constructor TBlock.Create(const APattern: string; constref ACombinationsCache: TBlockCombinationsCache);
begin
FPattern := APattern;
FCombinationsCache := ACombinationsCache;
ParseDamages;
end;
destructor TBlock.Destroy;
begin
FDamages.Free;
inherited Destroy;
end;
{ TAccumulatedCombinationsMultiIndexStrategy }
function TAccumulatedCombinationsMultiIndexStrategy.UpdateCombinations(const AValidationResult: TIndexValidationResult;
constref ACurrentIndexArray: TIndexArray; const ACurrentIndex: Integer): TIndexValidationResult;
var
combinations: Int64;
begin
Result := AValidationResult;
if Result = ivrValid then
begin
combinations := CalcCombinations(ACurrentIndexArray, ACurrentIndex);
if combinations = 0 then
Result := ivrSkip
else if ACurrentIndex > 0 then
FAccumulatedCombinations[ACurrentIndex] := combinations * FAccumulatedCombinations[ACurrentIndex - 1]
else begin
SetLength(FAccumulatedCombinations, GetCardinality);
FAccumulatedCombinations[ACurrentIndex] := combinations;
end;
end;
end;
function TAccumulatedCombinationsMultiIndexStrategy.GetCombinations: Int64;
begin
if FAccumulatedCombinations <> nil then
Result := FAccumulatedCombinations[GetCardinality - 1]
else
Result := 0;
end;
{ TValidationsToBlockAssignments }
function TValidationsToBlockAssignments.CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex:
Integer): Int64;
var
block: TBlock;
start, stop: Integer;
begin
// 'ACurrentIndexArray[i] - 1' denotes the index of the last validation number assigned to 'Block[i]', and the index
// of the first validation number in 'Validation' assigned to 'Block[i + 1]'. If two consecutive values in
// 'ACurrentIndexArray' are the same, then the block in between has no numbers assigned to it.
block := FConditionRecord.Blocks[ACurrentIndex];
if ACurrentIndex > 0 then
start := ACurrentIndexArray[ACurrentIndex - 1]
else
start := 0;
stop := ACurrentIndexArray[ACurrentIndex] - 1;
if block.Damages.Count > 0 then
Result := FConditionRecord.CalcCombinationsBlock(block, start, stop)
else
Result := FConditionRecord.CalcCombinationsWildcardSequence(Length(block.Pattern), start, stop);
end;
constructor TValidationsToBlockAssignments.Create(constref AConditionRecord: TConditionRecord);
begin
FConditionRecord := AConditionRecord;
end;
function TValidationsToBlockAssignments.GetCardinality: Integer;
begin
Result := FConditionRecord.Blocks.Count;
end;
function TValidationsToBlockAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray;
const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean;
begin begin
Result := True; Result := True;
if ACurrentIndex + 1 = GetCardinality then len := Length(AArrangement);
AStartIndexValue := FConditionRecord.Validation.Count for i := 1 to ALength do
else if ACurrentIndex > 0 then begin
AStartIndexValue := Max(ACurrentIndexArray[ACurrentIndex - 1], FConditionRecord.MinIndices[ACurrentIndex]) if FSpringPattern[len + i] in CDamagedPatternChars then
else AArrangement := AArrangement + CDamagedChar
AStartIndexValue := FConditionRecord.MinIndices[ACurrentIndex];
end;
function TValidationsToBlockAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray;
const ACurrentIndex: Integer): TIndexValidationResult;
var
start: Integer;
begin
if ACurrentIndexArray[ACurrentIndex] > FConditionRecord.Validation.Count then
Result := ivrBacktrack
else begin else begin
if ACurrentIndex > 0 then Result := False;
start := ACurrentIndexArray[ACurrentIndex - 1] Break;
else
start := 0;
if FConditionRecord.ValidationLengths[start, ACurrentIndexArray[ACurrentIndex]]
<= Length(FConditionRecord.Blocks[ACurrentIndex].Pattern) then
Result := ivrValid
else
Result := ivrBacktrack;
end;
Result := UpdateCombinations(Result, ACurrentIndexArray, ACurrentIndex);
end;
{ TDamageToValidationAssignments }
function TDamageToValidationAssignments.CalcValidationSpan(constref ACurrentIndexArray: TIndexArray;
const ALastDamageIndex, AValidationNumber: Integer): Integer;
var
spanStart: Integer;
begin
spanStart := ALastDamageIndex;
while (spanStart > 0) and (ACurrentIndexArray[spanStart - 1] = AValidationNumber) do
Dec(spanStart);
Result := FBlock.Damages[ALastDamageIndex].Length;
if spanStart < ALastDamageIndex then
Inc(Result, FBlock.Damages[ALastDamageIndex].Start - FBlock.Damages[spanStart].Start);
end;
constructor TDamageToValidationAssignments.Create(constref AConditionRecord: TConditionRecord; constref ABlock: TBlock;
const AStartValidationIndex, AStopValidationIndex: Integer);
begin
FConditionRecord := AConditionRecord;
FBlock := ABlock;
FValidationStartIndex := AStartValidationIndex;
FValidationStopIndex := AStopValidationIndex;
end;
function TDamageToValidationAssignments.GetCardinality: Integer;
begin
Result := FBlock.Damages.Count;
end;
function TDamageToValidationAssignments.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray;
const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean;
begin
Result := True;
if ACurrentIndex > 0 then
AStartIndexValue := ACurrentIndexArray[ACurrentIndex - 1]
else
AStartIndexValue := FValidationStartIndex;
end;
function TDamageToValidationAssignments.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray;
const ACurrentIndex: Integer): TIndexValidationResult;
var
i, prev: Integer;
begin
i := ACurrentIndexArray[ACurrentIndex];
prev := ACurrentIndex - 1;
// Checks maximum index value.
if i > FValidationStopIndex then
Result := ivrBacktrack
// Checks if there is enough space after this damage for remaining validation numbers.
else if (i < FValidationStopIndex)
and (FConditionRecord.ValidationLengths[i + 1, FValidationStopIndex + 1] + 1 > FBlock.Damages[ACurrentIndex].CharsRemaining) then
Result := ivrSkip
// Checks if there is enough space before this damage for previous validation numbers.
else if (FValidationStartIndex < i)
and (FConditionRecord.ValidationLengths[FValidationStartIndex, i] + 1 >= FBlock.Damages[ACurrentIndex].Start) then
Result := ivrBacktrack
// Checks if there is enough space between previous and this damage for skipped validation numbers.
else if (ACurrentIndex > 0)
and (ACurrentIndexArray[prev] + 1 < i)
and (FConditionRecord.ValidationLengths[ACurrentIndexArray[prev] + 1, i] + 2
> FBlock.Damages[ACurrentIndex].Start - FBlock.Damages[prev].Start - FBlock.Damages[prev].Length) then
Result := ivrBacktrack
// Checks if span is small enough to fit within this validation number.
else if FConditionRecord.Validation[i] < CalcValidationSpan(ACurrentIndexArray, ACurrentIndex, i) then
Result := ivrSkip
else
Result := ivrValid;
end;
{ TValidationPositionOffsets }
function TValidationPositionOffsets.CalcCombinations(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex:
Integer): Int64;
var
space, start, stop: Integer;
begin
stop := FPositionInfos[ACurrentIndex].ValidationIndex - 1;
if ACurrentIndex > 0 then
begin
space := ACurrentIndexArray[ACurrentIndex] - ACurrentIndexArray[ACurrentIndex - 1]
- FConditionRecord.Validation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] - 2;
start := FPositionInfos[ACurrentIndex - 1].ValidationIndex + 1;
Result := FConditionRecord.CalcCombinationsWildcardSequence(space, start, stop);
end
else begin
// Handles first calculated offset.
space := ACurrentIndexArray[0] - 2;
Result := FConditionRecord.CalcCombinationsWildcardSequence(space, FValidationStartIndex, stop);
end;
if (Result > 0) and (ACurrentIndex + 1 = GetCardinality) then
begin
// Handles last calculated offset.
space := FBlockLength - ACurrentIndexArray[ACurrentIndex] - FConditionRecord.Validation[FPositionInfos.Last.ValidationIndex];
start := FPositionInfos.Last.ValidationIndex + 1;
Result := Result * FConditionRecord.CalcCombinationsWildcardSequence(space, start, FValidationStopIndex);
end;
end;
constructor TValidationPositionOffsets.Create(constref AConditionRecord: TConditionRecord; constref APositionInfos:
TValidationPositionInfos; const ABlockLength, AValidationStartIndex, AValidationStopIndex: Integer);
begin
FConditionRecord := AConditionRecord;
FPositionInfos := APositionInfos;
FBlockLength := ABlockLength;
FValidationStartIndex := AValidationStartIndex;
FValidationStopIndex := AValidationStopIndex;
inherited Create;
end;
function TValidationPositionOffsets.GetCardinality: Integer;
begin
Result := FPositionInfos.Count;
end;
function TValidationPositionOffsets.TryGetStartIndexValue(constref ACurrentIndexArray: TIndexArray;
const ACurrentIndex: Integer; out AStartIndexValue: Integer): Boolean;
var
info: TValidationPositionInfo;
begin
info := FPositionInfos[ACurrentIndex];
AStartIndexValue := info.MinStart;
// Adjusts start value to avoid overlap of this validation number with the previous one (the one from previous
// position info).
if ACurrentIndex > 0 then
AStartIndexValue := Max(AStartIndexValue,
ACurrentIndexArray[ACurrentIndex - 1] + FConditionRecord.Validation[FPositionInfos[ACurrentIndex - 1].ValidationIndex] + 1);
Result := True;
end;
function TValidationPositionOffsets.ValidateIndexValue(constref ACurrentIndexArray: TIndexArray; const ACurrentIndex:
Integer): TIndexValidationResult;
begin
if ACurrentIndexArray[ACurrentIndex] <= FPositionInfos[ACurrentIndex].MaxStart then
Result := ivrValid
else
Result := ivrBacktrack;
Result := UpdateCombinations(Result, ACurrentIndexArray, ACurrentIndex);
end;
{ TConditionRecord }
procedure TConditionRecord.InitValidationLengths;
var
i, j: Integer;
begin
SetLength(FValidationLengths, FValidation.Count + 1, FValidation.Count + 1);
for i := 0 to FValidation.Count do
begin
FValidationLengths[i, i] := 0;
for j := i + 1 to FValidation.Count do
if FValidationLengths[i, j - 1] <> 0 then
FValidationLengths[i, j] := FValidationLengths[i, j - 1] + FValidation[j - 1] + 1
else
FValidationLengths[i, j] := FValidationLengths[i, j - 1] + FValidation[j - 1]
end;
end;
procedure TConditionRecord.InitMinIndices;
var
i, j, patternsLength: Integer;
begin
SetLength(FMinIndices, FBlocks.Count - 1);
patternsLength := Length(FBlocks[FBlocks.Count - 1].Pattern);
j := FValidation.Count;
for i := FBlocks.Count - 2 downto 0 do
begin
while (j >= 0) and (FValidationLengths[j, FValidation.Count] <= patternsLength) do
Dec(j);
FMinIndices[i] := j + 1;
patternsLength := patternsLength + 1 + Length(FBlocks[i].Pattern);
end;
end;
function TConditionRecord.CalcCombinationsBlockSingleValidation(constref ABlock: TBlock; const AIndex: Integer): Int64;
var
len, combinedDamagesLength: Integer;
begin
len := Length(ABlock.Pattern);
if len < FValidation[AIndex] then
Result := 0
else if ABlock.Damages.Count = 0 then
Result := len - FValidation[AIndex] + 1
else begin
combinedDamagesLength := ABlock.Damages.Last.Start + ABlock.Damages.Last.Length - ABlock.Damages.First.Start;
if FValidation[AIndex] < combinedDamagesLength then
Result := 0
else begin
Result := Min(Min(Min(
ABlock.Damages.First.Start,
FValidation[AIndex] - combinedDamagesLength + 1),
len - FValidation[AIndex] + 1),
ABlock.Damages.Last.CharsRemaining + 1);
end; end;
end; end;
end; end;
function TConditionRecord.CalcCombinationsBlockMultiValidations(constref ABlock: TBlock; constref AIndices:
TIndexArray; const AStartIndex, AStopIndex: Integer): Int64;
var
i, high: Integer;
position: TValidationPositionInfo;
positions: TValidationPositionInfos;
validationPositionOffsets: TValidationPositionOffsets;
offsets: TIndexArray;
begin
positions := TValidationPositionInfos.Create;
high := Length(AIndices) - 1;
// Initializes first info record.
position.ValidationIndex := AIndices[0];
position.MaxStart := ABlock.Damages[0].Start;
position.MinStart := 1;
for i := 1 to high do
if AIndices[i] <> position.ValidationIndex then
begin
// Finalizes current info record.
position.MaxStart := Min(position.MaxStart, ABlock.Damages[i].Start - 1 - FValidation[position.ValidationIndex]);
position.MinStart := Max(position.MinStart,
ABlock.Damages[i - 1].Start + ABlock.Damages[i - 1].Length - FValidation[position.ValidationIndex]);
positions.Add(position);
// Initializes next info record.
position.ValidationIndex := AIndices[i];
position.MaxStart := ABlock.Damages[i].Start;
position.MinStart := position.MinStart + FValidationLengths[AIndices[i - 1], AIndices[i]] + 1;
end;
// Finalizes last info record.
position.MaxStart := Min(position.MaxStart, Length(ABlock.Pattern) + 1 - FValidation[position.ValidationIndex]);
position.MinStart := Max(position.MinStart,
ABlock.Damages[high].Start + ABlock.Damages[high].Length - FValidation[position.ValidationIndex]);
positions.Add(position);
Result := 0;
validationPositionOffsets := TValidationPositionOffsets.Create(Self, positions, Length(ABlock.Pattern),
AStartIndex, AStopIndex);
for offsets in validationPositionOffsets do
Result := Result + validationPositionOffsets.GetCombinations;
validationPositionOffsets.Free;
positions.Free;
end;
function TConditionRecord.CalcValidationsId(const AStartIndex, AStopIndex: Integer): Int64;
var
i: Integer;
begin
// Requires 'FValidations[i] < 32' for each 'i' and 'AStopIndex - AStartIndex < 12'.
Result := FValidation[AStartIndex];
for i := AStartIndex + 1 to AStopIndex do
Result := (Result shl 5) or FValidation[i];
end;
constructor TConditionRecord.Create(constref ACombinationsCache: TCombinationsCache);
begin
FBlocks := TBlocks.Create;
FValidation := TIntegerList.Create;
FCombinationsCache := ACombinationsCache;
end;
destructor TConditionRecord.Destroy;
begin
FBlocks.Free;
FValidation.Free;
inherited Destroy;
end;
procedure TConditionRecord.AddBlocks(const APattern: string);
var
split: TStringArray;
part: string;
blockCache: TBlockCombinationsCache;
begin
split := APattern.Split([COperationalChar]);
for part in split do
if Length(part) > 0 then
begin
if not FCombinationsCache.TryGetValue(part, blockCache) then
begin
blockCache := TBlockCombinationsCache.Create;
FCombinationsCache.Add(part, blockCache);
end;
FBlocks.Add(TBlock.Create(part, blockCache));
end;
end;
function TConditionRecord.GenerateBlockAssignments: Int64;
var
validationsToBlockAssignments: TValidationsToBlockAssignments;
indices: TIndexArray;
begin
InitValidationLengths;
InitMinIndices;
Result := 0;
validationsToBlockAssignments := TValidationsToBlockAssignments.Create(Self);
for indices in validationsToBlockAssignments do
Result := Result + validationsToBlockAssignments.GetCombinations;
validationsToBlockAssignments.Free;
end;
function TConditionRecord.CalcCombinationsBlock(constref ABlock: TBlock; const AStartIndex, AStopIndex: Integer): Int64;
var
validationsId: Int64;
indices: TIndexArray;
damageToValidationAssignments: TDamageToValidationAssignments;
begin
// No validation number assigned to this block.
if AStartIndex > AStopIndex then
begin
if ABlock.Damages.Count = 0 then
Result := 1
else
Result := 0;
end
// One validation number assigned to this block.
else if AStartIndex = AStopIndex then
Result := CalcCombinationsBlockSingleValidation(ABlock, AStartIndex)
// Multiple validation numbers assigned to this block. Checks cache first.
else begin
validationsId := CalcValidationsId(AStartIndex, AStopIndex);
if not ABlock.CombinationsCache.TryGetValue(validationsId, Result) then
begin
Result := 0;
// Assigns validation numbers to specific damages.
damageToValidationAssignments := TDamageToValidationAssignments.Create(Self, ABlock, AStartIndex, AStopIndex);
for indices in damageToValidationAssignments do
Result := Result + CalcCombinationsBlockMultiValidations(ABlock, indices, AStartIndex, AStopIndex);
damageToValidationAssignments.Free;
ABlock.CombinationsCache.Add(validationsId, Result);
end;
end;
end;
function TConditionRecord.CalcCombinationsWildcardSequence(const ASequenceLength, AStartIndex, AStopIndex: Integer):
Int64;
var
count, freedoms: Integer;
begin
if AStartIndex < AStopIndex + 1 then
begin
count := AStopIndex + 1 - AStartIndex;
freedoms := ASequenceLength - FValidationLengths[AStartIndex, AStopIndex + 1];
if freedoms >= 0 then
Result := BinomialCoefficients.Get(count + freedoms, freedoms)
else
Result := 0;
end
else
Result := 1;
end;
{ THotSprings }
constructor THotSprings.Create; constructor THotSprings.Create;
begin begin
FCombinationsCache := TCombinationsCache.Create([doOwnsValues]); FValidation := specialize TList<Integer>.Create;
end; end;
destructor THotSprings.Destroy; destructor THotSprings.Destroy;
begin begin
FCombinationsCache.Free; FValidation.Free;
inherited Destroy; inherited Destroy;
end; end;
procedure THotSprings.ProcessDataLine(const ALine: string); procedure THotSprings.ProcessDataLine(const ALine: string);
var var
conditionRecord1, conditionRecord2: TConditionRecord; split: TStringArray;
mainSplit, split: TStringArray; i, val, maxFreeOperationalCount: Integer;
part, unfolded: string;
i: Integer;
begin begin
conditionRecord1 := TConditionRecord.Create(FCombinationsCache); FValidation.Clear;
conditionRecord2 := TConditionRecord.Create(FCombinationsCache); split := ALine.Split([' ', ',']);
FSpringPattern := split[0];
mainSplit := ALine.Split([' ']); maxFreeOperationalCount := Length(FSpringPattern) - Length(split) + 2;
for i := 1 to Length(split) - 1 do
begin
val := StrToInt(split[i]);
FValidation.Add(val);
Dec(maxFreeOperationalCount, val);
end;
// Adds blocks for part 1. ExtendArrangement('', maxFreeOperationalCount, 0);
conditionRecord1.AddBlocks(mainSplit[0]);
// Adds blocks for part 2.
unfolded := mainSplit[0];
for i := 2 to CPart2Repetition do
unfolded := unfolded + CWildcardChar + mainSplit[0];
conditionRecord2.AddBlocks(unfolded);
// Adds validation numbers.
split := mainSplit[1].Split([',']);
for part in split do
conditionRecord1.Validation.Add(StrToInt(part));
for i := 1 to CPart2Repetition do
conditionRecord2.Validation.AddRange(conditionRecord1.Validation);
FPart1 := FPart1 + conditionRecord1.GenerateBlockAssignments;
FPart2 := FPart2 + conditionRecord2.GenerateBlockAssignments;
conditionRecord1.Free;
conditionRecord2.Free;
end; end;
procedure THotSprings.Finish; procedure THotSprings.Finish;

192
solvers/ULavaductLagoon.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,41 +22,14 @@ unit ULavaductLagoon;
interface interface
uses uses
Classes, SysUtils, StrUtils, Generics.Collections, Math, USolver; Classes, SysUtils, USolver;
type type
{ TDig }
TDig = class
Direction, Length: Integer;
end;
TDigs = specialize TObjectList<TDig>;
{ TDigSite }
TDigSite = class
private
FDigs: TDigs;
FArea, FTrench: Int64;
function CheckMergeDigs(const ADigIndex: Integer): Cardinal;
public
procedure AddDig(constref ADig: TDig);
procedure CollapseUTurns;
function CalcFinalArea: Int64;
constructor Create;
destructor Destroy; override;
end;
{ TLavaductLagoon } { TLavaductLagoon }
TLavaductLagoon = class(TSolver) TLavaductLagoon = class(TSolver)
FSite1, FSite2: TDigSite;
procedure AddDig(const ALine: string);
public public
constructor Create;
destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override; procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override; procedure Finish; override;
function GetDataFileName: string; override; function GetDataFileName: string; override;
@ -65,173 +38,16 @@ type
implementation implementation
{ TDigSite }
function TDigSite.CheckMergeDigs(const ADigIndex: Integer): Cardinal;
begin
Result := 0;
if (0 <= ADigIndex) and (ADigIndex < FDigs.Count - 1) then
begin
// Appends two consecutive digs, if they go in the same direction.
if FDigs[ADigIndex].Direction = FDigs[ADigIndex + 1].Direction then
begin
FDigs[ADigIndex].Length := FDigs[ADigIndex].Length + FDigs[ADigIndex + 1].Length;
FDigs.Delete(ADigIndex + 1);
Inc(Result);
end
// Otherwise, checks if the directions are opposite.
else if Abs(FDigs[ADigIndex].Direction - FDigs[ADigIndex + 1].Direction) = 2 then
begin
// Recurses, if the opposite digs cancel each other out.
if FDigs[ADigIndex].Length = FDigs[ADigIndex + 1].Length then
begin
FDigs.DeleteRange(ADigIndex, 2);
Inc(Result, 2);
Inc(Result, CheckMergeDigs(ADigIndex - 1));
end
else begin
// Otherwise, subtracts the opposite directions.
if FDigs[ADigIndex].Length > FDigs[ADigIndex + 1].Length then
FDigs[ADigIndex].Length := FDigs[ADigIndex].Length - FDigs[ADigIndex + 1].Length
else begin
FDigs[ADigIndex].Length := FDigs[ADigIndex + 1].Length - FDigs[ADigIndex].Length;
FDigs[ADigIndex].Direction := FDigs[ADigIndex + 1].Direction;
end;
FDigs.Delete(ADigIndex + 1);
Inc(Result);
end;
end;
end;
end;
procedure TDigSite.AddDig(constref ADig: TDig);
begin
FDigs.Add(ADig);
Inc(FTrench, ADig.Length);
// The new dig might have to be merged with the preceeding dig.
CheckMergeDigs(FDigs.Count - 2);
end;
procedure TDigSite.CollapseUTurns;
var
i, side, backtrack, shorter: Integer;
begin
// If there is a U-turn, it must involve the last dig, otherwise we would have collapsed it in an earlier call
// already. Therefore we check the last three digs first.
i := FDigs.Count - 3;
while (0 <= i) and (i + 2 < FDigs.Count) do
begin
// We check if three consecutive digs starting at i form a U-turn. It's enough to check whether the first and the
// third have different directions because they must be parallel.
if FDigs[i].Direction <> FDigs[i + 2].Direction then
begin
// Either right or left U-turns enclose an area inside the trench. We do not need to know which one is which and
// just assume here that the right U-turns enclose an area outside and therefore negate it. If it's the other way
// around, then we can simply negate the end result.
side := FDigs[i + 1].Length;
if (FDigs[i].Direction + 1 = FDigs[i + 1].Direction)
or (FDigs[i + 1].Direction + 1 = FDigs[i + 2].Direction) then
side := -side;
// Updates the shortened dig and collapses the U-turn.
backtrack := 0;
shorter := Min(FDigs[i].Length, FDigs[i + 2].Length);
Inc(FArea, side * shorter);
if FDigs[i + 2].Length = shorter then
begin
FDigs.Delete(i + 2);
Inc(backtrack);
Inc(backtrack, CheckMergeDigs(i + 1));
end
else
Dec(FDigs[i + 2].Length, shorter);
if FDigs[i].Length = shorter then
begin
FDigs.Delete(i);
Inc(backtrack);
Inc(backtrack, CheckMergeDigs(i - 1));
end
else
Dec(FDigs[i].Length, shorter);
Dec(i, backtrack);
end
else
Inc(i);
end;
end;
function TDigSite.CalcFinalArea: Int64;
begin
// If the area is negative, then outside and inside have to be "swapped", which Abs() achieves here.
// When collapsing the U-turns, only the area up to the imaginary middle line of the dug trench is considered, so half
// of the full length of the dug trench + 1 has to be added to include the whole trench in the area calculation.
Result := Abs(FArea) + FTrench div 2 + 1;
end;
constructor TDigSite.Create;
begin
FDigs := TDigs.Create;
end;
destructor TDigSite.Destroy;
begin
FDigs.Free;
inherited Destroy;
end;
{ TLavaductLagoon } { TLavaductLagoon }
procedure TLavaductLagoon.AddDig(const ALine: string);
var
split: TStringArray;
dig: TDig;
begin
dig := TDig.Create;
split := ALine.Split([' ']);
case split[0] of
'R': dig.Direction := 0;
'D': dig.Direction := 1;
'L': dig.Direction := 2;
'U': dig.Direction := 3;
end;
dig.Length := StrToInt(split[1]);
FSite1.AddDig(dig);
dig := TDig.Create;
dig.Direction := StrToInt(split[2][8]);
dig.Length := Hex2Dec(Copy(split[2], 3, 5));
FSite2.AddDig(dig);
end;
constructor TLavaductLagoon.Create;
begin
FSite1 := TDigSite.Create;
FSite2 := TDigSite.Create;
end;
destructor TLavaductLagoon.Destroy;
begin
FSite1.Free;
FSite2.Free;
inherited Destroy;
end;
procedure TLavaductLagoon.ProcessDataLine(const ALine: string); procedure TLavaductLagoon.ProcessDataLine(const ALine: string);
begin begin
AddDig(ALine);
FSite1.CollapseUTurns;
FSite2.CollapseUTurns;
end; end;
procedure TLavaductLagoon.Finish; procedure TLavaductLagoon.Finish;
begin begin
// If the area is negative, then outside and inside have to be "swapped", which Abs() achieves here.
// When collapsing the U-turns, only the area up to the imaginary middle line of the dug trench is considered, so half
// of the full length of the dug trench + 1 has to be added to include the whole trench in the area calculation.
FPart1 := FSite1.CalcFinalArea;
FPart2 := FSite2.CalcFinalArea;
end; end;
function TLavaductLagoon.GetDataFileName: string; function TLavaductLagoon.GetDataFileName: string;

318
solvers/ULongWalk.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,26 +22,23 @@ unit ULongWalk;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, USolver, UCommon; Classes, SysUtils, Generics.Collections, USolver;
type type
TCrossing = class; TPoints = specialize TList<TPoint>;
TPathSelectionState = (pssNone, pssIncluded, pssExcluded); TCrossing = class;
{ TPath } { TPath }
TPath = class TPath = class
private private
FStart, FEnd: TCrossing; FEnd: TCrossing;
FLength: Integer; FLength: Integer;
FSelected: TPathSelectionState;
public public
property StartCrossing: TCrossing read FStart;
property EndCrossing: TCrossing read FEnd; property EndCrossing: TCrossing read FEnd;
property Length: Integer read FLength; property Length: Integer read FLength;
property Selected: TPathSelectionState read FSelected write FSelected; constructor Create(const ALength: Integer; const AEnd: TCrossing);
constructor Create(const ALength: Integer; const AStart, AEnd: TCrossing);
end; end;
TPaths = specialize TObjectList<TPath>; TPaths = specialize TObjectList<TPath>;
@ -60,51 +57,20 @@ type
TCrossing = class TCrossing = class
private private
FPosition: TPoint; FPosition: TPoint;
FOutPaths, FPaths: TPaths; FOutPaths: TPaths;
FDistance: Integer; FDistance: Integer;
FNotExcludedDegree: Integer;
public public
property Position: TPoint read FPosition; property Position: TPoint read FPosition;
property OutPaths: TPaths read FOutPaths; property OutPaths: TPaths read FOutPaths;
property Paths: TPaths read FPaths;
property Distance: Integer read FDistance write FDistance; property Distance: Integer read FDistance write FDistance;
property NotExcludedDegree: Integer read FNotExcludedDegree write FNotExcludedDegree;
function CalcNextPickIndex(const AMinIndex: Integer): Integer;
constructor Create(constref APosition: TPoint); constructor Create(constref APosition: TPoint);
destructor Destroy; override; destructor Destroy; override;
procedure AddOutPath(const AOutPath: TPath); procedure AddOutPath(const AOutPath: TPath);
procedure AddInPath(const AInPath: TPath);
end; end;
TCrossings = specialize TObjectList<TCrossing>; TCrossings = specialize TObjectList<TCrossing>;
TCrossingStack = specialize TStack<TCrossing>; TCrossingStack = specialize TStack<TCrossing>;
TPathChoiceResult = (pcrContinue, pcrTargetReached, pcrTargetUnreachable, pcrNoMinimum);
{ TPathChoice }
TPathChoice = class
private
FPrevious: TPathChoice;
FPickIndex: Integer;
FPick: TPath;
FEndCrossing: TCrossing;
FAutoExcludes: TPaths;
FExcludeCost: Int64;
FIncludeCost: Int64;
public
property PickIndex: Integer read FPickIndex;
property EndCrossing: TCrossing read FEndCrossing;
property IncludeCost: Int64 read FIncludeCost;
function Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
procedure Revert;
constructor Create(const AStartCrossing: TCrossing);
constructor Create(const APickIndex: Integer; const APrevious: TPathChoice = nil);
destructor Destroy; override;
end;
TPathChoiceStack = specialize TStack<TPathChoice>;
{ TLongWalk } { TLongWalk }
TLongWalk = class(TSolver) TLongWalk = class(TSolver)
@ -112,15 +78,12 @@ type
FLines: TStringList; FLines: TStringList;
FPaths: TPaths; FPaths: TPaths;
FCrossings, FWaitingForOtherInPath: TCrossings; FCrossings, FWaitingForOtherInPath: TCrossings;
FPathLengthSum: Int64; FStart: TCrossing;
function GetPosition(constref APoint: TPoint): Char; function GetPosition(constref APoint: TPoint): Char;
procedure ProcessPaths; procedure ProcessPaths;
procedure StepPath(const AStartPositionQueue: TPathStartQueue); procedure StepPath(const AStartPositionQueue: TPathStartQueue);
function FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue): TCrossing; function FindOrCreateCrossing(constref APosition: TPoint; const AStartPositionQueue: TPathStartQueue): TCrossing;
// Treats the graph as directed for part 1.
procedure FindLongestPath; procedure FindLongestPath;
// Treats the graph as undirected for part 2.
procedure FindLongestPathIgnoreSlopes;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -130,173 +93,44 @@ type
function GetPuzzleName: string; override; function GetPuzzleName: string; override;
end; end;
TDirection = (dirRight, dirDown, dirLeft, dirUp);
const const
CPathChar = '.'; CPathChar = '.';
CForestChar = '#'; CForestChar = '#';
CRightSlopeChar = '>'; CRightSlopeChar = '>';
CDownSlopeChar = 'v'; CDownSlopeChar = 'v';
CDirections: array[TDirection] of TPoint = ((X: 1; Y: 0), (X: 0; Y: 1), (X: -1; Y: 0), (X: 0; Y: -1));
CStartReverseDirection: TPoint = (X: 0; Y: -1);
implementation implementation
{ TPath } { TPath }
constructor TPath.Create(const ALength: Integer; const AStart, AEnd: TCrossing); constructor TPath.Create(const ALength: Integer; const AEnd: TCrossing);
begin begin
FLength := ALength; FLength := ALength;
FStart := AStart;
FEnd := AEnd; FEnd := AEnd;
FSelected := pssNone;
end; end;
{ TCrossing } { TCrossing }
function TCrossing.CalcNextPickIndex(const AMinIndex: Integer): Integer;
begin
Result := AMinIndex;
while (Result < FPaths.Count) and (FPaths[Result].Selected <> pssNone) do
Inc(Result);
end;
constructor TCrossing.Create(constref APosition: TPoint); constructor TCrossing.Create(constref APosition: TPoint);
begin begin
FPosition := APosition; FPosition := APosition;
FOutPaths := TPaths.Create(False); FOutPaths := TPaths.Create(False);
FPaths := TPaths.Create(False);
FDistance := 0; FDistance := 0;
FNotExcludedDegree := 0;
end; end;
destructor TCrossing.Destroy; destructor TCrossing.Destroy;
begin begin
FOutPaths.Free; FOutPaths.Free;
FPaths.Free;
inherited Destroy; inherited Destroy;
end; end;
procedure TCrossing.AddOutPath(const AOutPath: TPath); procedure TCrossing.AddOutPath(const AOutPath: TPath);
begin begin
FOutPaths.Add(AOutPath); FOutPaths.Add(AOutPath);
FPaths.Add(AOutPath);
Inc(FNotExcludedDegree);
end;
procedure TCrossing.AddInPath(const AInPath: TPath);
begin
FPaths.Add(AInPath);
Inc(FNotExcludedDegree);
end;
{ TPathChoice }
function TPathChoice.Apply(constref ATargetCrossing: TCrossing; const AExcludeCostLimit: Int64): TPathChoiceResult;
var
path: TPath;
excludeStack: TCrossingStack;
crossing, otherCrossing: TCrossing;
begin
Result := pcrContinue;
// Includes the selected path (edge) and checks whether target has been reached.
FPick.Selected := pssIncluded;
if FEndCrossing = ATargetCrossing then
Result := pcrTargetReached
else if FPrevious <> nil then
begin
// If the target has not been reached, starts at the starting crossing (which is the same as FPRevious.EndCrossing)
// and recursively excludes other connected paths (edges).
excludeStack := TCrossingStack.Create;
excludeStack.Push(FPrevious.EndCrossing);
while excludeStack.Count > 0 do
begin
crossing := excludeStack.Pop;
for path in crossing.Paths do
if path.Selected = pssNone then
begin
// Checks whether the path (edge) to the target crossing has been excluded and if so exits. The input data
// should be such that there is only one such path.
// The last crossing is always an end, never a start of a path (edge).
if path.EndCrossing = ATargetCrossing then
begin
Result := pcrTargetUnreachable;
excludeStack.Free;
Exit;
end
else begin
// Excludes the path (edge).
path.Selected := pssExcluded;
crossing.NotExcludedDegree := crossing.NotExcludedDegree - 1;
FAutoExcludes.Add(path);
FExcludeCost := FExcludeCost + path.Length;
// Checks if this choice is worse than the current best.
if FExcludeCost >= AExcludeCostLimit then
begin
Result := pcrNoMinimum;
excludeStack.Free;
Exit;
end;
// Finds the crossing on the other side, updates it, and possibly pushes it for recursion.
if crossing = path.StartCrossing then
otherCrossing := path.EndCrossing
else
otherCrossing := path.StartCrossing;
otherCrossing.NotExcludedDegree := otherCrossing.NotExcludedDegree - 1;
if otherCrossing.NotExcludedDegree < 2 then
excludeStack.Push(otherCrossing);
end;
end;
end;
excludeStack.Free;
end;
end;
procedure TPathChoice.Revert;
var
path: TPath;
begin
FPick.Selected := pssNone;
for path in FAutoExcludes do begin
path.Selected := pssNone;
path.StartCrossing.NotExcludedDegree := path.StartCrossing.NotExcludedDegree + 1;
path.EndCrossing.NotExcludedDegree := path.EndCrossing.NotExcludedDegree + 1;
end;
end;
constructor TPathChoice.Create(const AStartCrossing: TCrossing);
begin
FPrevious := nil;
FPickIndex := 0;
FPick := AStartCrossing.Paths[FPickIndex];
FEndCrossing := FPick.EndCrossing;
FExcludeCost := 0;
FIncludeCost := FPick.FLength;
FAutoExcludes := TPaths.Create(False);
end;
constructor TPathChoice.Create(const APickIndex: Integer; const APrevious: TPathChoice);
begin
FPrevious := APrevious;
FPickIndex := APickIndex;
FPick := FPrevious.EndCrossing.Paths[FPickIndex];
if FPick.StartCrossing = FPrevious.EndCrossing then
FEndCrossing := FPick.EndCrossing
else
FEndCrossing := FPick.StartCrossing;
FExcludeCost := FPrevious.FExcludeCost;
FIncludeCost := FPrevious.FIncludeCost + FPick.FLength;
FAutoExcludes := TPaths.Create(False);
end;
destructor TPathChoice.Destroy;
begin
FAutoExcludes.Free;
inherited Destroy;
end; end;
{ TLongWalk } { TLongWalk }
@ -308,24 +142,23 @@ end;
procedure TLongWalk.ProcessPaths; procedure TLongWalk.ProcessPaths;
var var
queue: TPathStartQueue; stack: TPathStartQueue;
pathStart: TPathStart; pathStart: TPathStart;
begin begin
queue := TPathStartQueue.Create; stack := TPathStartQueue.Create;
pathStart.Crossing := FCrossings.First; pathStart.Position := FStart.Position;
pathStart.Position := FCrossings.First.Position; pathStart.Crossing := FStart;
pathStart.ReverseDirection := CDirectionUp; pathStart.ReverseDirection := CStartReverseDirection;
queue.Enqueue(pathStart); stack.Enqueue(pathStart);
while queue.Count > 0 do while stack.Count > 0 do
StepPath(queue); StepPath(stack);
queue.Free; stack.Free;
end; end;
procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue); procedure TLongWalk.StepPath(const AStartPositionQueue: TPathStartQueue);
var var
start: TPathStart; start: TPathStart;
new: TPoint; new, direction: TPoint;
pdirection: PPoint;
c: Char; c: Char;
len: Integer; len: Integer;
oneMore, stop: Boolean; oneMore, stop: Boolean;
@ -333,20 +166,20 @@ var
path: TPath; path: TPath;
begin begin
start := AStartPositionQueue.Dequeue; start := AStartPositionQueue.Dequeue;
len := 0; len := 1;
if start.Crossing <> FCrossings.First then if start.Crossing <> FStart then
Inc(len); Inc(len);
oneMore := False; oneMore := False;
stop := False; stop := False;
repeat repeat
for pdirection in CPCardinalDirections do for direction in CDirections do
if pdirection^ <> start.ReverseDirection then if direction <> start.ReverseDirection then
begin begin
new := start.Position + pdirection^; new := start.Position + direction;
c := GetPosition(new); c := GetPosition(new);
if c <> CForestChar then if c <> CForestChar then
begin begin
start.ReverseDirection := Point(-pdirection^.X, -pdirection^.Y); start.ReverseDirection := Point(-direction.X, -direction.Y);
start.Position := new; start.Position := new;
if oneMore or (new.Y = FLines.Count - 1) then if oneMore or (new.Y = FLines.Count - 1) then
@ -362,11 +195,9 @@ begin
until stop; until stop;
crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue); crossing := FindOrCreateCrossing(start.Position, AStartPositionQueue);
path := TPath.Create(len, start.Crossing, crossing); path := TPath.Create(len, crossing);
FPathLengthSum := FPathLengthSum + path.FLength;
FPaths.Add(path); FPaths.Add(path);
start.Crossing.AddOutPath(path); start.Crossing.AddOutPath(path);
crossing.AddInPath(path);
end; end;
// Crossing with multiple (two) entries will only be added to FCrossings once both in-paths have been processed. This // Crossing with multiple (two) entries will only be added to FCrossings once both in-paths have been processed. This
@ -402,8 +233,8 @@ begin
Result := TCrossing.Create(APosition); Result := TCrossing.Create(APosition);
// Checks if the new crossing has multiple entries. // Checks if the new crossing has multiple entries.
if (GetPosition(APosition + CDirectionLeft) = CRightSlopeChar) if (GetPosition(APosition + CDirections[dirLeft]) = CRightSlopeChar)
and (GetPosition(APosition + CDirectionUp) = CDownSlopeChar) then and (GetPosition(APosition + CDirections[dirUp]) = CDownSlopeChar) then
FWaitingForOtherInPath.Add(Result) FWaitingForOtherInPath.Add(Result)
else else
FCrossings.Add(Result); FCrossings.Add(Result);
@ -413,24 +244,22 @@ begin
// Adds the exits of this crossing to the stack as starts for new paths. // Adds the exits of this crossing to the stack as starts for new paths.
pathStart.Crossing := Result; pathStart.Crossing := Result;
pathStart.Position := APosition + CDirectionRight; pathStart.Position := APosition + CDirections[dirRight];
if GetPosition(pathStart.Position) = CRightSlopeChar then if GetPosition(pathStart.Position) = CRightSlopeChar then
begin begin
pathStart.ReverseDirection := CDirectionLeft; pathStart.ReverseDirection := CDirections[dirLeft];
AStartPositionQueue.Enqueue(pathStart); AStartPositionQueue.Enqueue(pathStart);
end; end;
pathStart.Position := APosition + CDirectionDown; pathStart.Position := APosition + CDirections[dirDown];
if GetPosition(pathStart.Position) = CDownSlopeChar then if GetPosition(pathStart.Position) = CDownSlopeChar then
begin begin
pathStart.ReverseDirection := CDirectionUp; pathStart.ReverseDirection := CDirections[dirUp];
AStartPositionQueue.Enqueue(pathStart); AStartPositionQueue.Enqueue(pathStart);
end; end;
end end
end; end;
// In a directed graph with a topological ordering on the crossings (vertices), the maximum distance can be computed
// simply by traversing the crossings in that order and calculating the maximum locally.
procedure TLongWalk.FindLongestPath; procedure TLongWalk.FindLongestPath;
var var
crossing: TCrossing; crossing: TCrossing;
@ -440,82 +269,17 @@ begin
begin begin
for path in crossing.OutPaths do for path in crossing.OutPaths do
if path.EndCrossing.Distance < crossing.Distance + path.Length then if path.EndCrossing.Distance < crossing.Distance + path.Length then
path.EndCrossing.Distance := crossing.Distance + path.Length + 1; path.EndCrossing.Distance := crossing.Distance + path.Length;
end; end;
FPart1 := FCrossings.Last.Distance; FPart1 := FCrossings.Last.Distance;
end; end;
// For the undirected graph, we are running a DFS for the second to last crossing (vertex) with backtracking to find the
// minimum of excluded crossings and paths.
procedure TLongWalk.FindLongestPathIgnoreSlopes;
var
pickIndex: Integer;
choice: TPathChoice;
stack: TPathChoiceStack;
minExcludeCost, newExcludeCost: Int64;
begin
minExcludeCost := FPathLengthSum + FCrossings.Count - 1 - FPart1;
// Prepares the first pick, which is the only path connected to the first crossing.
stack := TPathChoiceStack.Create;
choice := TPathChoice.Create(FCrossings.First);
choice.Apply(FCrossings.Last, minExcludeCost);
stack.Push(choice);
// Runs a DFS for last crossing with backtracking, trying to find the minimum cost of excluded paths (i.e. edges).
pickIndex := -1;
while stack.Count > 0 do
begin
// Chooses next path.
pickIndex := stack.Peek.EndCrossing.CalcNextPickIndex(pickIndex + 1);
if pickIndex < stack.Peek.EndCrossing.Paths.Count then
begin
choice := TPathChoice.Create(pickIndex, stack.Peek);
case choice.Apply(FCrossings.Last, minExcludeCost) of
// Continues DFS, target has not yet been reached.
pcrContinue: begin
stack.Push(choice);
pickIndex := -1;
Continue;
end;
// Updates minimum and backtracks last choice, after target has been reached.
pcrTargetReached: begin
// Calculates new exclude cost based on path length sum and the choice's include cost. This effectively
// accounts for the "undecided" paths (edges) as well. Note that this does not actually need the choice's
// exclude costs, these are only required for the early exit in TPathChoice.Apply().
newExcludeCost := FCrossings.Count - stack.Count - 2 + FPathLengthSum - choice.IncludeCost;
if minExcludeCost > newExcludeCost then
minExcludeCost := newExcludeCost;
choice.Revert;
choice.Free;
end;
// Backtracks last choice, after target has been excluded or exclude costs ran over the current best.
pcrTargetUnreachable, pcrNoMinimum: begin
choice.Revert;
choice.Free;
end;
end;
end
else begin
choice := stack.Pop;
pickIndex := choice.PickIndex;
choice.Revert;
choice.Free;
end;
end;
stack.Free;
FPart2 := FPathLengthSum - minExcludeCost + FCrossings.Count - 1;
end;
constructor TLongWalk.Create; constructor TLongWalk.Create;
begin begin
FLines := TStringList.Create; FLines := TStringList.Create;
FPaths := TPaths.Create; FPaths := TPaths.Create;
FCrossings := TCrossings.Create; FCrossings := TCrossings.Create;
FWaitingForOtherInPath := TCrossings.Create(False); FWaitingForOtherInPath := TCrossings.Create(False);
FPathLengthSum := 0;
end; end;
destructor TLongWalk.Destroy; destructor TLongWalk.Destroy;
@ -530,7 +294,10 @@ end;
procedure TLongWalk.ProcessDataLine(const ALine: string); procedure TLongWalk.ProcessDataLine(const ALine: string);
begin begin
if FLines.Count = 0 then if FLines.Count = 0 then
FCrossings.Add(TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0))); begin
FStart := TCrossing.Create(Point(ALine.IndexOf(CPathChar) + 1, 0));
FCrossings.Add(FStart);
end;
FLines.Add(ALine); FLines.Add(ALine);
end; end;
@ -538,12 +305,11 @@ procedure TLongWalk.Finish;
begin begin
ProcessPaths; ProcessPaths;
FindLongestPath; FindLongestPath;
FindLongestPathIgnoreSlopes;
end; end;
function TLongWalk.GetDataFileName: string; function TLongWalk.GetDataFileName: string;
begin begin
Result := 'a_long_walk.txt'; Result := 'long_walk.txt';
end; end;
function TLongWalk.GetPuzzleName: string; function TLongWalk.GetPuzzleName: string;

865
solvers/UNeverTellMeTheOdds.pas
View File

@ -22,7 +22,7 @@ unit UNeverTellMeTheOdds;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, Math, USolver, UBigInt, UPolynomial, UPolynomialRoots; Classes, SysUtils, Generics.Collections, Math, matrix, USolver, UNumberTheory, UBigInt;
type type
@ -30,15 +30,26 @@ type
THailstone = class THailstone = class
public public
P0, P1, P2: Int64; Position, Velocity: Tvector3_extended;
V0, V1, V2: Integer;
constructor Create(const ALine: string); constructor Create(const ALine: string);
constructor Create; constructor Create(const APosition, AVelocity: Tvector3_extended);
end; end;
THailstones = specialize TObjectList<THailstone>; THailstones = specialize TObjectList<THailstone>;
TInt64Array = array of Int64; { TFirstCollisionPolynomial }
TFirstCollisionPolynomial = class
private
FA: array[0..10] of TBigInt;
FH: array[0..6] of TBigInt;
procedure NormalizeCoefficients;
public
procedure Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1, t_2: Int64);
function EvaluateAt(const AT0: Int64): TBigInt;
function CalcPositiveIntegerRoot: Int64;
function CalcT1(const AT0: Int64): Int64;
end;
{ TNeverTellMeTheOdds } { TNeverTellMeTheOdds }
@ -46,13 +57,10 @@ type
private private
FMin, FMax: Int64; FMin, FMax: Int64;
FHailstones: THailstones; FHailstones: THailstones;
FA: array[0..10] of Int64;
FH: array[0..6] of Int64;
function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean;
function FindRockThrow(const AIndex0, AIndex1, AIndex2: Integer): Int64; procedure FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer);
procedure CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out OPolynomial0,
OPolynomial1: TBigIntPolynomial);
function CalcRockThrowCollisionOptions(constref AHailstone0, AHailstone1, AHailstone2: THailstone): TInt64Array;
function ValidateRockThrow(constref AHailstone0, AHailstone1, AHailstone2: THailstone; const AT0, AT1: Int64):
Int64;
public public
constructor Create(const AMin: Int64 = 200000000000000; const AMax: Int64 = 400000000000000); constructor Create(const AMin: Int64 = 200000000000000; const AMax: Int64 = 400000000000000);
destructor Destroy; override; destructor Destroy; override;
@ -62,6 +70,10 @@ type
function GetPuzzleName: string; override; function GetPuzzleName: string; override;
end; end;
const
CIterationThreshold = 0.00001;
CEpsilon = 0.0000000001;
implementation implementation
{ THailstone } { THailstone }
@ -71,71 +83,69 @@ var
split: TStringArray; split: TStringArray;
begin begin
split := ALine.Split([',', '@']); split := ALine.Split([',', '@']);
P0 := StrToInt64(Trim(split[0])); Position.init(
P1 := StrToInt64(Trim(split[1])); StrToFloat(Trim(split[0])),
P2 := StrToInt64(Trim(split[2])); StrToFloat(Trim(split[1])),
V0 := StrToInt(Trim(split[3])); StrToFloat(Trim(split[2])));
V1 := StrToInt(Trim(split[4])); Velocity.init(
V2 := StrToInt(Trim(split[5])); StrToFloat(Trim(split[3])),
StrToFloat(Trim(split[4])),
StrToFloat(Trim(split[5])));
end; end;
constructor THailstone.Create; constructor THailstone.Create(const APosition, AVelocity: Tvector3_extended);
begin begin
Position := APosition;
Velocity := AVelocity;
end; end;
{ TNeverTellMeTheOdds } { TFirstCollisionPolynomial }
function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; procedure TFirstCollisionPolynomial.NormalizeCoefficients;
var var
m1, m2, x, y: Double; shift: Integer;
i: Low(FA)..High(FA);
//gcd: TBigInt;
begin begin
Result := False; // Eliminates zero constant term.
m1 := AHailstone1.V1 / AHailstone1.V0; shift := 0;
m2 := AHailstone2.V1 / AHailstone2.V0; while (shift <= High(FA)) and (FA[shift] = 0) do
if m1 <> m2 then Inc(shift);
if shift <= High(FA) then
begin begin
x := (AHailstone2.P1 - m2 * AHailstone2.P0 if shift > 0 then
- AHailstone1.P1 + m1 * AHailstone1.P0)
/ (m1 - m2);
if (FMin <= x) and (x <= FMax)
and (x * Sign(AHailstone1.V0) >= AHailstone1.P0 * Sign(AHailstone1.V0))
and (x * Sign(AHailstone2.V0) >= AHailstone2.P0 * Sign(AHailstone2.V0))
then
begin begin
y := m1 * (x - AHailstone1.P0) + AHailstone1.P1; for i := Low(FA) to High(FA) - shift do
if (FMin <= y) and (y <= FMax) then FA[i] := FA[i + shift];
Result := True for i := High(FA) - shift + 1 to High(FA) do
FA[i] := 0;
end; end;
//// Finds GCD of all coefficients.
//gcd := FA[Low(FA)];
//for i := Low(FA) + 1 to High(FA) do
// if FA[i] <> 0 then
// gcd := TNumberTheory.GreatestCommonDivisor(gcd, FA[i]);
//WriteLn('GCD: ', gcd);
//
//for i := Low(FA) to High(FA) do
// FA[i] := FA[i] div gcd;
end; end;
//WriteLn('(', FA[10], ') * x^10 + (', FA[9], ') * x^9 + (', FA[8], ') * x^8 + (', FA[7], ') * x^7 + (',
// FA[6], ') * x^6 + (', FA[5], ') * x^5 + (', FA[4], ') * x^4 + (', FA[3], ') * x^3 + (', FA[2], ') * x^2 + (',
// FA[1], ') * x + (', FA[0], ')');
end; end;
function TNeverTellMeTheOdds.FindRockThrow(const AIndex0, AIndex1, AIndex2: Integer): Int64; procedure TFirstCollisionPolynomial.Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1,
t_2: Int64);
var var
t0, t1: TInt64Array; P_00, P_01, P_02, P_10, P_11, P_12, P_20, P_21, P_22,
i, j: Int64; V_00, V_01, V_02, V_10, V_11, V_12, V_20, V_21, V_22: Int64;
begin k: array[0..139] of TBigInt;
t0 := CalcRockThrowCollisionOptions(FHailstones[AIndex0], FHailstones[AIndex1], FHailstones[AIndex2]); // For debug calculations
t1 := CalcRockThrowCollisionOptions(FHailstones[AIndex1], FHailstones[AIndex0], FHailstones[AIndex2]); act, a_1, a_2, b_0, b_1, c_0, c_1, d_0, d_1, e_0, e_1, f_0, f_1, f_2: Int64;
Result := 0;
for i in t0 do
begin
for j in t1 do
begin
Result := ValidateRockThrow(FHailstones[AIndex0], FHailstones[AIndex1], FHailstones[AIndex2], i, j);
if Result > 0 then
Break;
end;
if Result > 0 then
Break;
end;
end;
procedure TNeverTellMeTheOdds.CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out
OPolynomial0, OPolynomial1: TBigIntPolynomial);
var
k: array[0..74] of TBigInt;
begin begin
// Solving this non-linear equation system, with velocities V_i and start positions P_i: // Solving this non-linear equation system, with velocities V_i and start positions P_i:
// V_0 * t_0 + P_0 = V_x * t_0 + P_x // V_0 * t_0 + P_0 = V_x * t_0 + P_x
@ -145,347 +155,446 @@ begin
// P_x = (V_0 - V_x) * t_0 + P_0 // P_x = (V_0 - V_x) * t_0 + P_0
// V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) // V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1)
// And with vertex components: // And with vertex components:
// 1: 0 = (t_1 - t_0) * (V_00 * t_0 - V_20 * t_2 + P_00 - P_20) // 1: 0 = (t_1 - t_0) * (V_00 * t_0 - V_20 * t_2 + P_00 - P_20) - (t_2 - t_0) * (V_00 * t_0 - V_10 * t_1 + P_00 - P_10)
// - (t_2 - t_0) * (V_00 * t_0 - V_10 * t_1 + P_00 - P_10)
// 2: t_1 = (((V_01 - V_21) * t_2 + P_11 - P_21) * t_0 + (P_01 - P_11) * t_2) // 2: t_1 = (((V_01 - V_21) * t_2 + P_11 - P_21) * t_0 + (P_01 - P_11) * t_2)
// / ((V_01 - V_11) * t_0 + (V_11 - V_21) * t_2 + P_01 - P_21) // / ((V_01 - V_11) * t_0 + (V_11 - V_21) * t_2 + P_01 - P_21)
// 3: t_2 = (((V_02 - V_12) * t_1 + P_22 - P_12) * t_0 + (P_02 - P_22) * t_1) // 3: t_2 = (((V_02 - V_12) * t_1 + P_22 - P_12) * t_0 + (P_02 - P_22) * t_1)
// / ((V_02 - V_22) * t_0 + (V_22 - V_12) * t_1 + P_02 - P_12) // / ((V_02 - V_22) * t_0 + (V_22 - V_12) * t_1 + P_02 - P_12)
// for t_0, t_1, t_2 not pairwise equal. // for t_0, t_1, t_2 not pairwise equal.
// With some substitutions depending only on t_0 this gives // With some substitutions depending only on t_0 this gives
// 1: 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) // 1: 0 = (t_1 - t_0) * (f_2 - V_20 * t_2) - (t_2 - t_0) * (f_1 - V_10 * t_1)
// 2: t_1 = (b_0 + b_1 * t_2) / (c_0 + c_1 * t_2) // 2: t_1 = (b_0 + b_1 * t_2) / (c_0 + c_1 * t_2)
// 3: t_2 = (d_0 + d_1 * t_1) / (e_0 + e_1 * t_1) // 3: t_2 = (d_0 + d_1 * t_1) / (e_0 + e_1 * t_1)
// And 3 in 2 gives: // And 3 in 2 gives:
// 4: f_2 * t_1^2 + f_1 * t_1 - f_0 = 0 // 4: g_2 * t_1^2 - g_1 * t_1 - g_0 = 0
// Then, with 4 and 3 in 1 and many substitutions (see constants k below, now independent of t_0), the equation // Then, with 4 and 3 in 1 and lengthy calculations with many substitutions (see constants k below, now independent of
// 5: 0 = p_0(t_0) + p_1(t_0) * sqrt(p_2(t_0)) // t_0), the following polynomial can be constructed, with t_0 being a positive integer root of this polynomial.
// can be constructed, where p_0, p_1, and p_2 are polynomials in t_0. Since we are searching for an integer solution, // y = a_10 * x^10 + a_9 * x^9 + ... + a_0
// we assume that there is an integer t_0 that is a root of both p_0 and p_1, which would solve the equation.
// Subsitutions depending on t_0: P_00 := Round(AHailstone1.Position.data[0]);
// a_1 = V_00 * t_0 + P_00 - P_20 P_01 := Round(AHailstone1.Position.data[1]);
// a_2 = V_00 * t_0 + P_00 - P_10 P_02 := Round(AHailstone1.Position.data[2]);
// b_0 = (P_11 - P_21) * t_0 P_10 := Round(AHailstone2.Position.data[0]);
// b_1 = (V_01 - V_21) * t_0 + P_01 - P_11 P_11 := Round(AHailstone2.Position.data[1]);
// c_0 = (V_01 - V_11) * t_0 + P_01 - P_21 P_12 := Round(AHailstone2.Position.data[2]);
// c_1 = V_11 - V_21 P_20 := Round(AHailstone3.Position.data[0]);
// d_0 = (P_22 - P_12) * t_0 P_21 := Round(AHailstone3.Position.data[1]);
// d_1 = (V_02 - V_12) * t_0 + P_02 - P_22 P_22 := Round(AHailstone3.Position.data[2]);
// e_0 = (V_02 - V_22) * t_0 + P_02 - P_12 V_00 := Round(AHailstone1.Velocity.data[0]);
// e_1 = V_22 - V_12 V_01 := Round(AHailstone1.Velocity.data[1]);
// f_0 = b_1 * d_0 + b_0 * e_0 V_02 := Round(AHailstone1.Velocity.data[2]);
// f_1 = c_0 * e_0 + c_1 * d_0 - b_0 * e_1 - b_1 * d_1 V_10 := Round(AHailstone2.Velocity.data[0]);
// f_2 = c_0 * e_1 + c_1 * d_1 V_11 := Round(AHailstone2.Velocity.data[1]);
V_12 := Round(AHailstone2.Velocity.data[2]);
V_20 := Round(AHailstone3.Velocity.data[0]);
V_21 := Round(AHailstone3.Velocity.data[1]);
V_22 := Round(AHailstone3.Velocity.data[2]);
// Calculations for equation 5 (4 and 3 in 1). k[0] := P_00 - P_20;
// 1: 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) k[1] := P_00 - P_10;
// 3: (e_0 + e_1 * t_1) * t_2 = (d_0 + d_1 * t_1) k[2] := P_11 - P_21;
// 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) k[3] := P_01 - P_11;
// = (t_1 - t_0) * (a_1 * (e_0 + e_1 * t_1) - V_20 * (e_0 + e_1 * t_1) * t_2) - ((e_0 + e_1 * t_1) * t_2 - (e_0 + e_1 * t_1) * t_0) * (a_2 - V_10 * t_1) k[4] := P_01 - P_21;
// = (t_1 - t_0) * (a_1 * (e_0 + e_1 * t_1) - V_20 * (d_0 + d_1 * t_1)) - ((d_0 + d_1 * t_1) - (e_0 + e_1 * t_1) * t_0) * (a_2 - V_10 * t_1) k[5] := P_22 - P_12;
// = (t_1 - t_0) * (a_1 * e_0 + a_1 * e_1 * t_1 - V_20 * d_0 - V_20 * d_1 * t_1) - (d_0 + d_1 * t_1 - e_0 * t_0 - e_1 * t_1 * t_0) * (a_2 - V_10 * t_1) k[6] := P_02 - P_22;
// = (a_1 * e_1 - V_20 * d_1) * t_1^2 + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1)) * t_1 - t_0 * (a_1 * e_0 - V_20 * d_0) k[7] := P_02 - P_12;
// - ( - V_10 * (d_1 - e_1 * t_0) * t_1^2 + ((d_1 - e_1 * t_0) * a_2 - V_10 * (d_0 - e_0 * t_0)) * t_1 + (d_0 - e_0 * t_0) * a_2) k[8] := V_11 - V_21;
// = (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * t_1^2 k[9] := V_22 - V_12;
k[10] := V_01 - V_21;
k[11] := V_01 - V_11;
k[12] := V_02 - V_12;
k[13] := V_02 - V_22;
FH[0] := k[11] * k[9] + k[8] * k[12];
FH[1] := k[4] * k[9] + k[8] * k[6];
FH[2] := k[11] * k[13] - k[10] * k[12];
FH[3] := k[11] * k[7] + k[4] * k[13] + k[8] * k[5] - k[2] * k[9] - k[10] * k[6] - k[3] * k[12];
FH[4] := k[4] * k[7] - k[3] * k[6];
FH[5] := k[10] * k[5] + k[2] * k[13];
FH[6] := k[3] * k[5] + k[2] * k[7];
k[14] := V_00 * k[9] - V_20 * k[12];
k[15] := k[0] * k[9] - V_20 * k[6];
k[16] := V_00 * k[13];
k[17] := V_00 * k[7] + k[0] * k[13] - V_20 * k[5];
k[18] := k[0] * k[7];
k[19] := k[5] - k[7];
k[20] := 2 * FH[2] * FH[3];
k[21] := FH[3] * FH[3];
k[22] := k[21] + 2 * FH[2] * FH[4];
k[23] := 2 * FH[3] * FH[4];
k[24] := 2 * FH[0] * FH[1];
k[25] := FH[0] * FH[0]; // KILL?
k[26] := FH[5] * k[25]; // KILL?
k[126] := FH[5] * FH[0];
k[127] := FH[5] * FH[1] + FH[6] * FH[0];
k[128] := FH[6] * FH[1];
k[27] := FH[5] * k[24] + FH[6] * k[25]; // KILL?
k[28] := FH[1] * FH[1]; // KILL?
k[29] := FH[5] * k[28] + FH[6] * k[24]; // KILL?
k[30] := FH[6] * k[28]; // KILL?
k[31] := FH[2] * FH[2];
k[132] := k[20] + 4 * k[126];
k[133] := k[22] + 4 * k[127];
k[134] := k[23] + 4 * k[128];
k[32] := k[31] + 4 * k[26]; // KILL?
k[33] := k[20] + 4 * k[27]; // KILL?
k[34] := k[22] + 4 * k[29]; // KILL?
k[35] := k[23] + 4 * k[30]; // KILL?
k[36] := k[31] + 2 * k[26]; // KILL?
k[37] := k[20] + 2 * k[27]; // KILL?
k[38] := k[22] + 2 * k[29]; // KILL?
k[39] := k[23] + 2 * k[30]; // KILL?
k[137] := k[20] + 2 * k[126];
k[138] := k[22] + 2 * k[127];
k[139] := k[23] + 2 * k[128];
k[40] := k[14] + V_10 * (k[12] - k[9]);
k[41] := k[15] + V_10 * k[6];
k[42] := k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00;
k[43] := k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00;
k[44] := k[18] - k[6] * k[1];
k[45] := k[42] * FH[0] - k[40] * FH[2];
k[46] := k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3];
k[47] := k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4];
k[48] := k[44] * FH[1] - k[41] * FH[4];
k[49] := k[42] * FH[2];
k[50] := k[40] * k[31] - k[49] * FH[0];
k[51] := k[42] * FH[3] + k[43] * FH[2];
k[52] := k[40] * k[137] + k[41] * k[31] - k[51] * FH[0] - k[49] * FH[1];
k[53] := k[42] * FH[4] + k[43] * FH[3] + k[44] * FH[2];
k[54] := k[40] * k[138] + k[41] * k[137] - k[53] * FH[0] - k[51] * FH[1];
k[55] := k[43] * FH[4] + k[44] * FH[3];
k[56] := k[40] * k[139] + k[41] * k[138] - k[55] * FH[0] - k[53] * FH[1];
k[57] := k[44] * FH[4];
k[58] := FH[4] * FH[4];
k[59] := k[40] * k[58] + k[41] * k[139] - k[57] * FH[0] - k[55] * FH[1];
k[60] := k[41] * k[58] - k[57] * FH[1];
k[61] := k[13] * V_00 - k[16];
k[62] := 2 * k[25] * k[61];
k[63] := k[13] * k[1] - k[19] * V_00 - k[17];
k[64] := 2 * (k[24] * k[61] + k[25] * k[63]);
k[65] := - k[19] * k[1] - k[18];
k[66] := 2 * (k[28] * k[61] + k[24] * k[63] + k[25] * k[65]);
k[67] := 2 * (k[28] * k[63] + k[24] * k[65]);
k[68] := 2 * k[28] * k[65];
k[69] := k[50] + k[62];
k[70] := k[52] + k[64];
k[71] := k[54] + k[66];
k[72] := k[56] + k[67];
k[73] := k[59] + k[68];
k[74] := k[45] * k[45];
k[75] := 2 * k[45] * k[46];
k[76] := k[46] * k[46] + 2 * k[45] * k[47];
k[77] := 2 * (k[45] * k[48] + k[46] * k[47]);
k[78] := k[47] * k[47] + 2 * k[46] * k[48];
k[79] := 2 * k[47] * k[48];
k[80] := k[48] * k[48];
FA[0] := k[58] * k[80] - k[60] * k[60];
FA[1] := k[134] * k[80] + k[58] * k[79] - 2 * k[73] * k[60];
FA[2] := k[133] * k[80] + k[134] * k[79] + k[58] * k[78] - k[73] * k[73] - 2 * k[72] * k[60];
FA[3] := k[133] * k[79] + k[134] * k[78] + k[58] * k[77] + k[132] * k[80]
- 2 * (k[71] * k[60] + k[72] * k[73]);
FA[4] := k[31] * k[80] + k[133] * k[78] + k[134] * k[77] + k[58] * k[76] + k[132] * k[79] - k[72] * k[72]
- 2 * (k[70] * k[60] + k[71] * k[73]);
FA[5] := k[31] * k[79] + k[133] * k[77] + k[134] * k[76] + k[58] * k[75] + k[132] * k[78]
- 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]);
FA[6] := k[31] * k[78] + k[133] * k[76] + k[134] * k[75] + k[58] * k[74] + k[132] * k[77] - k[71] * k[71]
- 2 * (k[69] * k[73] + k[70] * k[72]);
FA[7] := k[31] * k[77] + k[133] * k[75] + k[134] * k[74] + k[132] * k[76] - 2 * (k[69] * k[72] + k[70] * k[71]);
FA[8] := k[31] * k[76] + k[132] * k[75] + k[133] * k[74] - k[70] * k[70] - 2 * k[69] * k[71];
FA[9] := k[31] * k[75] + k[132] * k[74] - 2 * k[69] * k[70];
FA[10] := k[31] * k[74] - k[69] * k[69];
// Debug calculations
//a_1 := V_00 * t_0 + P_00 - P_20;
//a_2 := V_00 * t_0 + P_00 - P_10;
//b_0 := (P_11 - P_21) * t_0;
//b_1 := (V_01 - V_21) * t_0 + P_01 - P_11;
//c_0 := (V_01 - V_11) * t_0 + P_01 - P_21;
//c_1 := V_11 - V_21;
//d_0 := (P_22 - P_12) * t_0;
//d_1 := (V_02 - V_12) * t_0 + P_02 - P_22;
//e_0 := (V_02 - V_22) * t_0 + P_02 - P_12;
//e_1 := V_22 - V_12;
//f_2 := c_0 * e_1 + c_1 * d_1;
//f_1 := c_0 * e_0 + c_1 * d_0 - b_0 * e_1 - b_1 * d_1;
//f_0 := b_1 * d_0 + b_0 * e_0;
//
//act := f_2 * t_1 * t_1 + f_1 * t_1 - f_0;
//Write('debug10: ', 0 = act, ' ');
//
//if f_2 <> 0 then
//begin
// act := Round(- f_1 / (2 * f_2) + Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2));
// Write('debug15: ', t_1 = act);
// act := Round(- f_1 / (2 * f_2) - Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2));
// Write(' OR ', t_1 = act, ' ');
//end;
//
//act := (e_0 + e_1 * t_1) * t_2 - (d_0 + d_1 * t_1);
//Write('debug20: ', 0 = act, ' ');
//
//act := (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * t_1 * t_1
// + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * t_1 // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * t_1
// + t_0 * (V_20 * d_0 - a_1 * e_0) + (e_0 * t_0 - d_0) * a_2 // + t_0 * (V_20 * d_0 - a_1 * e_0) + (e_0 * t_0 - d_0) * a_2;
// Inserting 4, solved for t_0: t_1 = - f_1 / (2 * f_2) + sqrt((f_1 / (2 * f_2))^2 + f_0 / f_2) //Write('debug30: ', 0 = act, ' ');
// = (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * (f_1^2 + 2 * f_0 * f_2 - f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) //
// + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * (- f_1 * f_2 + f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) //act := Round((a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * (f_1 * f_1 + 2 * f_0 * f_2 - f_1 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + t_0 * (V_20 * d_0 - a_1 * e_0) * 2 * f_2^2 + (e_0 * t_0 - d_0) * a_2 * 2 * f_2^2 // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * (- f_1 * f_2 + f_2 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + t_0 * (V_20 * d_0 - a_1 * e_0) * 2 * f_2 * f_2 + (e_0 * t_0 - d_0) * a_2 * 2 * f_2 * f_2);
// a_1 = V_00 * t_0 + k_0 //Write('debug40: ', 0 = act, ' ');
// a_2 = V_00 * t_0 + k_1 //
// b_0 = k_2 * t_0 //Write('debug41: ',
// b_1 = k_10 * t_0 + k_3 // a_1 * k[9] - V_20 * d_1
// c_0 = k_11 * t_0 + k_4 // = k[14] * t_0 + k[15], ' ');
// d_0 = k_5 * t_0 //Write('debug42: ',
// d_1 = k_12 * t_0 + k_6 // d_1 - k[9] * t_0
// e_0 = k_13 * t_0 + k_7 // = (k[12] - k[9]) * t_0 + k[6], ' ');
// f_2 = (k_11 * t_0 + k_4) * k_9 + k_8 * (k_12 * t_0 + k_6) //Write('debug43: ',
// = (k_11 * k_9 + k_8 * k_12) * t_0 + k_4 * k_9 + k_8 * k_6
// = k_14 * t_0 + k_15
// f_1 = (k_11 * t_0 + k_4) * (k_13 * t_0 + k_7) + k_8 * k_5 * t_0 - k_2 * t_0 * k_9 - (k_10 * t_0 + k_3) * (k_12 * t_0 + k_6)
// = (k_11 * k_13 - k_10 * k_12) * t_0^2 + (k_11 * k_7 + k_4 * k_12 + k_8 * k_5 - k_2 * k_9 - k_10 * k_6 - k_3 * k_12) * t_0 + k_4 * k_7 - k_3 * k_6
// = k_16 * t_0^2 + k_17 * t_0 + k_18
// f_0 = (k_10 * t_0 + k_3) * k_5 * t_0 + k_2 * t_0 * (k_13 * t_0 + k_7)
// = (k_10 * k_5 + k_2 * k_13) * t_0^2 + (k_3 * k_5 + k_2 * k_7) * t_0
// = k_19 * t_0^2 + k_20 * t_0
k[0] := AHailstone0.P0 - AHailstone2.P0;
k[1] := AHailstone0.P0 - AHailstone1.P0;
k[2] := AHailstone1.P1 - AHailstone2.P1;
k[3] := AHailstone0.P1 - AHailstone1.P1;
k[4] := AHailstone0.P1 - AHailstone2.P1;
k[5] := AHailstone2.P2 - AHailstone1.P2;
k[6] := AHailstone0.P2 - AHailstone2.P2;
k[7] := AHailstone0.P2 - AHailstone1.P2;
k[8] := AHailstone1.V1 - AHailstone2.V1;
k[9] := AHailstone2.V2 - AHailstone1.V2;
k[10] := AHailstone0.V1 - AHailstone2.V1;
k[11] := AHailstone0.V1 - AHailstone1.V1;
k[12] := AHailstone0.V2 - AHailstone1.V2;
k[13] := AHailstone0.V2 - AHailstone2.V2;
k[14] := k[11] * k[9] + k[8] * k[12];
k[15] := k[4] * k[9] + k[8] * k[6];
k[16] := k[11] * k[13] - k[10] * k[12];
k[17] := k[11] * k[7] + k[4] * k[13] + k[8] * k[5] - k[2] * k[9] - k[10] * k[6] - k[3] * k[12];
k[18] := k[4] * k[7] - k[3] * k[6];
k[19] := k[10] * k[5] + k[2] * k[13];
k[20] := k[3] * k[5] + k[2] * k[7];
// Additional substitutions.
// a_1 * k_9 - V_20 * d_1
// = (V_00 * t_0 + k_0) * k_9 - V_20 * (k_12 * t_0 + k_6)
// = (V_00 * k_9 - V_20 * k_12) * t_0 + k_0 * k_9 - V_20 * k_6
// = k_21 * t_0 + k_22
// d_1 - k_9 * t_0
// = k_12 * t_0 + k_6 - k_9 * t_0
// = (k_12 - k_9) * t_0 + k_6
// a_1 * e_0 - V_20 * d_0 // a_1 * e_0 - V_20 * d_0
// = (V_00 * t_0 + k_0) * (k_13 * t_0 + k_7) - V_20 * k_5 * t_0 // = k[16] * t_0 * t_0 + k[17] * t_0 + k[18], ' ');
// = V_00 * k_13 * t_0^2 + (V_00 * k_7 + k_0 * k_13 - V_20 * k_5) * t_0 + k_0 * k_7 //Write('debug44: ',
// = k_23 * t_0^2 + k_24 * t_0 + k_25
// d_0 - e_0 * t_0 // d_0 - e_0 * t_0
// = k_5 * t_0 - k_13 * t_0^2 - k_7 * t_0 // = - k[13] * t_0 * t_0 + k[19] * t_0, ' ');
// = - k_13 * t_0^2 + k_26 * t_0 //Write('debug45: ',
// f_1^2 // f_1 * f_1
// = (k_16 * t_0^2 + k_17 * t_0 + k_18)^2 // = FH[2] * FH[2] * t_0 * t_0 * t_0 * t_0 + k[20] * t_0 * t_0 * t_0 + k[22] * t_0 * t_0 + k[23] * t_0 + FH[4] * FH[4], ' ');
// = k_16^2 * t_0^4 + k_17^2 * t_0^2 + k_18^2 + 2 * k_16 * t_0^2 * k_17 * t_0 + 2 * k_16 * t_0^2 * k_18 + 2 * k_17 * t_0 * k_18 //Write('debug46: ',
// = k_16^2 * t_0^4 + 2 * k_16 * k_17 * t_0^3 + (k_17^2 + 2 * k_16 * k_18) * t_0^2 + 2 * k_17 * k_18 * t_0 + k_18^2 // f_2 * f_2
// = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 // = FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1], ' ');
// f_2^2 //Write('debug47: ',
// = (k_14 * t_0 + k_15)^2
// = k_14^2 * t_0^2 + 2 * k_14 * k_15 * t_0 + k_15^2
// = k_14^2 * t_0^2 + k_31 * t_0 + k_15^2
// f_0 * f_2 // f_0 * f_2
// = (k_19 * t_0^2 + k_20 * t_0) * (k_14 * t_0 + k_15) // = k[126] * t_0 * t_0 * t_0 + k[127] * t_0 * t_0 + k[128] * t_0, ' ');
// = k_19 * k_14 * t_0^3 + (k_19 * k_15 + k_20 * k_14) * t_0^2 + k_20 * k_15 * t_0 //Write('debug48: ',
// = k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0 // f_1 * f_1 + 4 * f_0 * f_2
// f_1^2 + 4 * f_0 * f_2 // = k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58], ' ');
// = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 + 4 * (k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0) //Write('debug49: ',
// = k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59 // f_1 * f_1 + 2 * f_0 * f_2
// f_1^2 + 2 * f_0 * f_2 // = k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58], ' ');
// = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 + 2 * (k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0) //
// = k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 //act := Round((k[14] * t_0 + k[15] + V_10 * ((k[12] - k[9]) * t_0 + k[6])) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + (k[16] * t_0 * t_0 + k[17] * t_0 + k[18] - t_0 * (k[14] * t_0 + k[15]) - ((k[12] - k[9]) * t_0 + k[6]) * a_2 - V_10 * (k[13] * t_0 * t_0 - k[19] * t_0)) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]));
//Write('debug50: ', 0 = act, ' ');
//
//Write('debug53: ',
// 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + ((k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00) * t_0 * t_0 + (k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00) * t_0 + k[18] - k[6] * k[1]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])),
// ' ');
//
//Write('debug55: ',
// 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58])
// - (k[40] * t_0 + k[41]) * f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)
// + (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])),
// ' ');
//
//Write('debug70: ',
// 0 = Round(((k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[0] * t_0 + FH[1]) - (k[40] * t_0 + k[41]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4])) * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + (k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58])
// - (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4]) * (FH[0] * t_0 + FH[1])
// - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * (V_00 * t_0 + k[1]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]),
// ' ');
//
// Write('debug73: ',
// 0 = Round((
// (k[42] * FH[0] - k[40] * FH[2]) * t_0 * t_0 * t_0
// + (k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]) * t_0 * t_0
// + (k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4]) * t_0
// + k[44] * FH[1] - k[41] * FH[4]
// ) * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + (k[40] * k[31] - k[42] * FH[2] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0
// + (k[40] * k[137] + k[41] * k[31] - k[42] * FH[3] * FH[0] - k[43] * FH[2] * FH[0] - k[42] * FH[2] * FH[1]) * t_0 * t_0 * t_0 * t_0
// + (k[40] * k[138] + k[41] * k[137] - k[42] * FH[4] * FH[0] - k[43] * FH[3] * FH[0] - k[44] * FH[2] * FH[0] - k[42] * FH[3] * FH[1] - k[43] * FH[2] * FH[1]) * t_0 * t_0 * t_0
// + (k[40] * k[139] + k[41] * k[138] - k[43] * FH[4] * FH[0] - k[44] * FH[3] * FH[0] - k[42] * FH[4] * FH[1] - k[43] * FH[3] * FH[1] - k[44] * FH[2] * FH[1]) * t_0 * t_0
// + (k[40] * k[58] + k[41] * k[139] - k[44] * FH[4] * FH[0] - k[43] * FH[4] * FH[1] - k[44] * FH[3] * FH[1]) * t_0
// + k[41] * k[58] - k[44] * FH[4] * FH[1]
// + 2 * (k[13] * V_00 * FH[0] * FH[0] - k[16] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0
// + 2 * (k[13] * V_00 * k[24] + k[13] * k[1] * FH[0] * FH[0] - k[19] * V_00 * FH[0] * FH[0] - k[16] * k[24] - k[17] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0
// + 2 * (k[13] * V_00 * FH[1] * FH[1] + k[13] * k[1] * k[24] - k[19] * V_00 * k[24] - k[19] * k[1] * FH[0] * FH[0] - k[16] * FH[1] * FH[1] - k[17] * k[24] - k[18] * FH[0] * FH[0]) * t_0 * t_0 * t_0
// + 2 * (k[13] * k[1] * FH[1] * FH[1] - k[19] * V_00 * FH[1] * FH[1] - k[19] * k[1] * k[24] - k[17] * FH[1] * FH[1] - k[18] * k[24]) * t_0 * t_0
// + 2 * (- k[19] * k[1] * FH[1] * FH[1] - k[18] * FH[1] * FH[1]) * t_0,
// ' ');
//
// Write('debug78: ',
// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(f_1 * f_1 + 4 * f_0 * f_2))
// + (k[50] + k[62]) * t_0 * t_0 * t_0 * t_0 * t_0 + (k[52] + k[64]) * t_0 * t_0 * t_0 * t_0 + (k[54] + k[66]) * t_0 * t_0 * t_0 + (k[56] + k[67]) * t_0 * t_0 + (k[59] + k[68]) * t_0 + k[60],
// ' ');
//
// Write('debug80: ',
// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58])
// + k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]),
// ' ');
// WriteLn;
// WriteLn(' 0 = ((', k[45], ') * x^3 + (', k[46], ') * x^2 + (', k[47], ') * x + (', k[48], ')) * sqrt((', k[31], ') * x^4 + (', k[132], ') * x^3 + (', k[133], ') * x^2 + (', k[134], ') * x + (', k[58], ')) + (',
// k[69], ') * x^5 + (', k[70], ') * x^4 + (', k[71], ') * x^3 + (', k[72], ') * x^2 + (', k[73], ') * x + (', k[60], ')');
k[21] := AHailstone0.V0 * k[9] - AHailstone2.V0 * k[12]; Write('debug83: ',
k[22] := k[0] * k[9] - AHailstone2.V0 * k[6]; (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) =
k[23] := AHailstone0.V0 * k[13]; (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]) * (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]),
k[24] := AHailstone0.V0 * k[7] + k[0] * k[13] - AHailstone2.V0 * k[5]; ' ');
k[25] := k[0] * k[7]; Write('debug85: ',
k[26] := k[5] - k[7]; 0 =
k[27] := 2 * k[16] * k[17]; (
k[28] := k[17] * k[17]; k[45] * k[45] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[29] := k[28] + 2 * k[16] * k[18]; + 2 * k[45] * k[46] * t_0 * t_0 * t_0 * t_0 * t_0
k[30] := 2 * k[17] * k[18]; + k[46] * k[46] * t_0 * t_0 * t_0 * t_0
k[31] := 2 * k[14] * k[15]; + 2 * k[45] * k[47] * t_0 * t_0 * t_0 * t_0
k[32] := k[14] * k[14]; + 2 * k[45] * k[48] * t_0 * t_0 * t_0
k[33] := k[19] * k[14]; + 2 * k[46] * k[47] * t_0 * t_0 * t_0
k[34] := k[19] * k[15] + k[20] * k[14]; + k[47] * k[47] * t_0 * t_0
k[35] := k[20] * k[15]; + 2 * k[46] * k[48] * t_0 * t_0
k[36] := k[15] * k[15]; + 2 * k[47] * k[48] * t_0
k[37] := k[16] * k[16]; + k[48] * k[48]
k[38] := k[27] + 2 * k[33]; ) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58])
k[39] := k[29] + 2 * k[34]; - k[69] * k[69] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[40] := k[30] + 2 * k[35]; - 2 * k[69] * k[70] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[41] := k[21] + AHailstone1.V0 * (k[12] - k[9]); - (k[70] * k[70] + 2 * k[69] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[42] := k[22] + AHailstone1.V0 * k[6]; - 2 * (k[69] * k[72] + k[70] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[43] := k[23] - k[21] - AHailstone1.V0 * k[13] - (k[12] - k[9]) * AHailstone0.V0; - (k[71] * k[71] + 2 * k[69] * k[73] + 2 * k[70] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0
k[44] := k[24] - k[22] + AHailstone1.V0 * k[26] - (k[12] - k[9]) * k[1] - k[6] * AHailstone0.V0; - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0
k[45] := k[25] - k[6] * k[1]; - (k[72] * k[72] + 2 * k[70] * k[60] + 2 * k[71] * k[73]) * t_0 * t_0 * t_0 * t_0
k[46] := k[43] * k[14] - k[41] * k[16]; - 2 * (k[71] * k[60] + k[72] * k[73]) * t_0 * t_0 * t_0
k[47] := k[43] * k[15] + k[44] * k[14] - k[42] * k[16] - k[41] * k[17]; - (k[73] * k[73] + 2 * k[72] * k[60]) * t_0 * t_0
k[48] := k[44] * k[15] + k[45] * k[14] - k[42] * k[17] - k[41] * k[18]; - 2 * k[73] * k[60] * t_0
k[49] := k[45] * k[15] - k[42] * k[18]; - k[60] * k[60],
k[50] := k[43] * k[16]; ' ');
k[51] := k[41] * k[37] - k[50] * k[14];
k[52] := k[43] * k[17] + k[44] * k[16];
k[53] := k[41] * k[38] + k[42] * k[37] - k[52] * k[14] - k[50] * k[15];
k[54] := k[43] * k[18] + k[44] * k[17] + k[45] * k[16];
k[55] := k[41] * k[39] + k[42] * k[38] - k[54] * k[14] - k[52] * k[15];
k[56] := k[44] * k[18] + k[45] * k[17];
k[57] := k[41] * k[40] + k[42] * k[39] - k[56] * k[14] - k[54] * k[15];
k[58] := k[45] * k[18];
k[59] := k[18] * k[18];
k[60] := k[41] * k[59] + k[42] * k[40] - k[58] * k[14] - k[56] * k[15];
k[61] := k[42] * k[59] - k[58] * k[15];
k[62] := k[13] * AHailstone0.V0 - k[23];
k[63] := 2 * k[32] * k[62];
k[64] := k[13] * k[1] - k[26] * AHailstone0.V0 - k[24];
k[65] := 2 * (k[31] * k[62] + k[32] * k[64]);
k[66] := - k[26] * k[1] - k[25];
k[67] := 2 * (k[36] * k[62] + k[31] * k[64] + k[32] * k[66]);
k[68] := 2 * (k[36] * k[64] + k[31] * k[66]);
k[69] := 2 * k[36] * k[66];
k[70] := k[51] + k[63];
k[71] := k[53] + k[65];
k[72] := k[55] + k[67];
k[73] := k[57] + k[68];
k[74] := k[60] + k[69];
// Unused, they are part of the polynomial inside the square root.
//k[75] := k[27] + 4 * k[33];
//k[76] := k[29] + 4 * k[34];
//k[77] := k[30] + 4 * k[35];
// Continuing calculations for equation 5. WriteLn('debug96: ', EvaluateAt(t_0) = 0);
// 0 = (k_21 * t_0 + k_22 + V_10 * ((k_12 - k_9) * t_0 + k_6)) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2))
// + (k_23 * t_0^2 + k_24 * t_0 + k_25 - t_0 * (k_21 * t_0 + k_22) - ((k_12 - k_9) * t_0 + k_6) * a_2 - V_10 * (k_13 * t_0^2 - k_26 * t_0)) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2))
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2))
// + ((k_23 - k_21 - V_10 * k_13 - (k_12 - k_9) * V_00) * t_0^2 + (k_24 - k_22 + V_10 * k_26 - (k_12 - k_9) * k_1 - k_6 * V_00) * t_0 + k_25 - k_6 * k_1) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2))
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59)
// -+ (k_41 * t_0 + k_42) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)
// + (k_43 * t_0^2 + k_44 * t_0 + k_45) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2))
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59)
// -+ (k_41 * t_0 + k_42) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)
// - (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_1 * f_2
// +- (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = +- ((k_43 * t_0^2 + k_44 * t_0 + k_45) * f_2 - (k_41 * t_0 + k_42) * f_1) * sqrt(f_1^2 + 4 * f_0 * f_2)
// + (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59)
// - (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_1 * f_2
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = +- ((k_43 * t_0^2 + k_44 * t_0 + k_45) * (k_14 * t_0 + k_15) - (k_41 * t_0 + k_42) * (k_16 * t_0^2 + k_17 * t_0 + k_18)) * sqrt(f_1^2 + 4 * f_0 * f_2)
// + (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59)
// - (k_43 * t_0^2 + k_44 * t_0 + k_45) * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (k_14 * t_0 + k_15)
// - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * (V_00 * t_0 + k_1) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2)
// 0 = +- (
// (k_43 * k_14 - k_41 * k_16) * t_0^3
// + (k_43 * k_15 + k_44 * k_14 - k_42 * k_16 - k_41 * k_17) * t_0^2
// + (k_44 * k_15 + k_45 * k_14 - k_42 * k_17 - k_41 * k_18) * t_0
// + k_45 * k_15 - k_42 * k_18
// ) * sqrt(f_1^2 + 4 * f_0 * f_2)
// + (k_41 * k_37 - k_43 * k_16 * k_14) * t_0^5
// + (k_41 * k_38 + k_42 * k_37 - k_43 * k_17 * k_14 - k_44 * k_16 * k_14 - k_43 * k_16 * k_15) * t_0^4
// + (k_41 * k_39 + k_42 * k_38 - k_43 * k_18 * k_14 - k_44 * k_17 * k_14 - k_45 * k_16 * k_14 - k_43 * k_17 * k_15 - k_44 * k_16 * k_15) * t_0^3
// + (k_41 * k_40 + k_42 * k_39 - k_44 * k_18 * k_14 - k_45 * k_17 * k_14 - k_43 * k_18 * k_15 - k_44 * k_17 * k_15 - k_45 * k_16 * k_15) * t_0^2
// + (k_41 * k_59 + k_42 * k_40 - k_45 * k_18 * k_14 - k_44 * k_18 * k_15 - k_45 * k_17 * k_15) * t_0
// + k_42 * k_59 - k_45 * k_18 * k_15
// + 2 * (k_13 * V_00 * k_14^2 - k_23 * k_14^2) * t_0^5
// + 2 * (k_13 * V_00 * k_31 + k_13 * k_1 * k_14^2 - k_26 * V_00 * k_14^2 - k_23 * k_31 - k_24 * k_14^2) * t_0^4
// + 2 * (k_13 * V_00 * k_15^2 + k_13 * k_1 * k_31 - k_26 * V_00 * k_31 - k_26 * k_1 * k_14^2 - k_23 * k_15^2 - k_24 * k_31 - k_25 * k_14^2) * t_0^3
// + 2 * (k_13 * k_1 * k_15^2 - k_26 * V_00 * k_15^2 - k_26 * k_1 * k_31 - k_24 * k_15^2 - k_25 * k_31) * t_0^2
// + 2 * (- k_26 * k_1 * k_15^2 - k_25 * k_15^2) * t_0
// 0 = +- (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(f_1^2 + 4 * f_0 * f_2)
// + (k_51 + k_63) * t_0^5 + (k_53 + k_65) * t_0^4 + (k_55 + k_67) * t_0^3 + (k_57 + k_68) * t_0^2 + (k_60 + k_69) * t_0 + k_61
// 0 = +- (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59)
// + k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61
OPolynomial0 := TBigIntPolynomial.Create([k[61], k[74], k[73], k[72], k[71], k[70]]); NormalizeCoefficients;
OPolynomial1 := TBigIntPolynomial.Create([k[49], k[48], k[47], k[46]]);
// Squaring that formula eliminates the square root, but may lead to a polynomial with all coefficients zero in some WriteLn('debug99: ', EvaluateAt(t_0) = 0, ' ');
// cases. Therefore this part is merely included for the interested reader.
// -+ (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) =
// k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61
// (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49)^2 * (k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) =
// (k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61)^2
// 0 =
// (k_46^2 * t_0^6
// + 2 * k_46 * k_47 * t_0^5
// + k_47^2 * t_0^4 + 2 * k_46 * k_48 * t_0^4
// + 2 * k_46 * k_49 * t_0^3 + 2 * k_47 * k_48 * t_0^3
// + k_48^2 * t_0^2 + 2 * k_47 * k_49 * t_0^2
// + 2 * k_48 * k_49 * t_0
// + k_49^2
// ) * (k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59)
// - k_70^2 * t_0^10
// - 2 * k_70 * k_71 * t_0^9
// - (k_71^2 + 2 * k_70 * k_72) * t_0^8
// - 2 * (k_70 * k_73 + k_71 * k_72) * t_0^7
// - (k_72^2 + 2 * k_70 * k_74 + 2 * k_71 * k_73) * t_0^6
// - 2 * (k_70 * k_61 + k_71 * k_74 + k_72 * k_73) * t_0^5
// - (k_73^2 + 2 * k_71 * k_61 + 2 * k_72 * k_74) * t_0^4
// - 2 * (k_72 * k_61 + k_73 * k_74) * t_0^3
// - (k_74^2 + 2 * k_73 * k_61) * t_0^2
// - 2 * k_74 * k_61 * t_0
// - k_61^2
// 0 = ak_10 * t_0^10 + ak_9 * t_0^9 + ak_8 * t_0^8 + ak_7 * t_0^7 + ak_6 * t_0^6 + ak_5 * t_0^5 + ak_4 * t_0^4 + ak_3 * t_0^3 + ak_2 * t_0^2 + ak_1 * t_0 + ak_0
//k[78] := k[46] * k[46];
//k[79] := 2 * k[46] * k[47];
//k[80] := k[47] * k[47] + 2 * k[46] * k[48];
//k[81] := 2 * (k[46] * k[49] + k[47] * k[48]);
//k[82] := k[48] * k[48] + 2 * k[47] * k[49];
//k[83] := 2 * k[48] * k[49];
//k[84] := k[49] * k[49];
//ak[0] := k[59] * k[84] - k[61] * k[61];
//ak[1] := k[77] * k[84] + k[59] * k[83] - 2 * k[74] * k[61];
//ak[2] := k[76] * k[84] + k[77] * k[83] + k[59] * k[82] - k[74] * k[74] - 2 * k[73] * k[61];
//ak[3] := k[76] * k[83] + k[77] * k[82] + k[59] * k[81] + k[75] * k[84]
// - 2 * (k[72] * k[61] + k[73] * k[74]);
//ak[4] := k[37] * k[84] + k[76] * k[82] + k[77] * k[81] + k[59] * k[80] + k[75] * k[83] - k[73] * k[73]
// - 2 * (k[71] * k[61] + k[72] * k[74]);
//ak[5] := k[37] * k[83] + k[76] * k[81] + k[77] * k[80] + k[59] * k[79] + k[75] * k[82]
// - 2 * (k[70] * k[61] + k[71] * k[74] + k[72] * k[73]);
//ak[6] := k[37] * k[82] + k[76] * k[80] + k[77] * k[79] + k[59] * k[78] + k[75] * k[81] - k[72] * k[72]
// - 2 * (k[70] * k[74] + k[71] * k[73]);
//ak[7] := k[37] * k[81] + k[76] * k[79] + k[77] * k[78] + k[75] * k[80] - 2 * (k[70] * k[73] + k[71] * k[72]);
//ak[8] := k[37] * k[80] + k[75] * k[79] + k[76] * k[78] - k[71] * k[71] - 2 * k[70] * k[72];
//ak[9] := k[37] * k[79] + k[75] * k[78] - 2 * k[70] * k[71];
//ak[10] := k[37] * k[78] - k[70] * k[70];
end; end;
function TNeverTellMeTheOdds.CalcRockThrowCollisionOptions(constref AHailstone0, AHailstone1, AHailstone2: THailstone): function TFirstCollisionPolynomial.EvaluateAt(const AT0: Int64): TBigInt;
TInt64Array;
var var
a0, a1: TBigIntPolynomial; i: Low(FA)..High(FA);
a0Roots, a1Roots: TBigIntArray;
options: specialize TList<Int64>;
i, j: TBigInt;
val: Int64;
begin begin
CalcCollisionPolynomials(AHailstone0, AHailstone1, AHailstone2, a0, a1); Result := TBigInt.Zero;
a0Roots := TPolynomialRoots.BisectInteger(a0, 64); for i := High(FA) downto Low(FA) do
a1Roots := TPolynomialRoots.BisectInteger(a1, 64); Result := Result * AT0 + FA[i];
options := specialize TList<Int64>.Create;
for i in a0Roots do
for j in a1Roots do
if (i = j) and i.TryToInt64(val) then
options.Add(val);
Result := options.ToArray;
options.Free;
end; end;
function TNeverTellMeTheOdds.ValidateRockThrow(constref AHailstone0, AHailstone1, AHailstone2: THailstone; const AT0, function TFirstCollisionPolynomial.CalcPositiveIntegerRoot: Int64;
AT1: Int64): Int64;
var var
divisor, t: Int64; dividers: TDividers;
rock: THailstone; factors: TInt64Array;
divider: Int64;
begin begin
// V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1)
divisor := AT0 - AT1;
rock := THailstone.Create;
rock.V0 := (AHailstone0.V0 * AT0 - AHailstone1.V0 * AT1 + AHailstone0.P0 - AHailstone1.P0) div divisor;
rock.V1 := (AHailstone0.V1 * AT0 - AHailstone1.V1 * AT1 + AHailstone0.P1 - AHailstone1.P1) div divisor;
rock.V2 := (AHailstone0.V2 * AT0 - AHailstone1.V2 * AT1 + AHailstone0.P2 - AHailstone1.P2) div divisor;
// P_x = (V_0 - V_x) * t_0 + P_0
rock.P0 := (AHailstone0.V0 - rock.V0) * AT0 + AHailstone0.P0;
rock.P1 := (AHailstone0.V1 - rock.V1) * AT0 + AHailstone0.P1;
rock.P2 := (AHailstone0.V2 - rock.V2) * AT0 + AHailstone0.P2;
Result := rock.P0 + rock.P1 + rock.P2;
// Checks collision with the third hailstone.
if ((AHailstone2.V0 = rock.V0) and (AHailstone2.P0 <> rock.P0))
or ((AHailstone2.V1 = rock.V1) and (AHailstone2.P1 <> rock.P1))
or ((AHailstone2.V2 = rock.V2) and (AHailstone2.P2 <> rock.P2)) then
Result := 0
else begin
t := (AHailstone2.P0 - rock.P0) div (rock.V0 - AHailstone2.V0);
if (t <> (AHailstone2.P1 - rock.P1) div (rock.V1 - AHailstone2.V1))
or (t <> (AHailstone2.P2 - rock.P2) div (rock.V2 - AHailstone2.V2)) then
Result := 0; Result := 0;
end; //factors := TIntegerFactorization.PollardsRhoAlgorithm(FA[0]);
//dividers := TDividers.Create(factors);
//
//try
//for divider in dividers do
//begin
// //WriteLn('Check if ', divider, ' is a root...');
// if EvaluateAt(divider) = 0 then
// begin
// Result := divider;
// Break;
// end;
//end;
//
//finally
// dividers.Free;
//end;
end;
rock.Free; function TFirstCollisionPolynomial.CalcT1(const AT0: Int64): Int64;
var
g_0, g_1, g_2: Int64;
g: Extended;
begin
//g_2 := FH[0] * AT0 + FH[1];
//g_1 := FH[2] * AT0 * AT0 + FH[3] * AT0 + FH[4];
//g_0 := FH[5] * AT0 * AT0 + FH[6] * AT0;
//g := - g_1 / (2 * g_2);
//Result := Round(g + sqrt(g * g + g_0));
end;
{ TNeverTellMeTheOdds }
function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean;
var
m1, m2, x, y: Double;
begin
Result := False;
m1 := AHailstone1.Velocity.data[1] / AHailstone1.Velocity.data[0];
m2 := AHailstone2.Velocity.data[1] / AHailstone2.Velocity.data[0];
if m1 <> m2 then
begin
x := (AHailstone2.Position.data[1] - m2 * AHailstone2.Position.data[0]
- AHailstone1.Position.data[1] + m1 * AHailstone1.Position.data[0])
/ (m1 - m2);
if (FMin <= x) and (x <= FMax)
and (x * Sign(AHailstone1.Velocity.data[0]) >= AHailstone1.Position.data[0] * Sign(AHailstone1.Velocity.data[0]))
and (x * Sign(AHailstone2.Velocity.data[0]) >= AHailstone2.Position.data[0] * Sign(AHailstone2.Velocity.data[0]))
then
begin
y := m1 * (x - AHailstone1.Position.data[0]) + AHailstone1.Position.data[1];
if (FMin <= y) and (y <= FMax) then
Result := True
end;
end;
end;
// For debug calculations:
Const
T : array[0..4] of Byte = (5, 3, 4, 6, 1);
procedure TNeverTellMeTheOdds.FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer);
var
//i, j, k: Integer;
//x0, x1, x2: Extended;
f: TFirstCollisionPolynomial;
t0, t1: Int64;
p, v: Tvector3_extended;
test: TBigInt;
begin
WriteLn;
WriteLn(AIndex1, ' ', AIndex2, ' ', AIndex3);
f := TFirstCollisionPolynomial.Create;
f.Init(FHailstones[AIndex1], FHailstones[AIndex2], FHailstones[AIndex3], T[AIndex1], T[AIndex2], T[AIndex3]);
//t0 := f.CalcPositiveIntegerRoot;
//WriteLn('t0: ', t0, ' ', t0 = T[AIndex1]);
//t1 := f.CalcT1(t0);
//WriteLn(', t1: ', t1);
f.Free;
//// V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1)
//v := (FHailstones[AIndex1].Velocity * t0 - FHailstones[AIndex2].Velocity * t1
// + FHailstones[AIndex1].Position - FHailstones[AIndex2].Position) / (t0 - t1);
//// P_x = (V_0 - V_x) * t_0 + P_0
//p := (FHailstones[AIndex1].Velocity - v) * t0 + FHailstones[AIndex1].Position;
//FPart2 := Round(p.data[0]) + Round(p.data[1]) + Round(p.data[2]);
//for i := 0 to FHailstones.Count - 3 do
// for j := i + 1 to FHailstones.Count - 2 do
// for k:= j + 1 to FHailstones.Count - 1 do
// begin
// WriteLn(i, j, k);
// solver := TRockThrowSolver.Create(FHailstones[i], FHailstones[j], FHailstones[k], 0);
// case i of
// 0: x0 := 5;
// 1: x0 := 3;
// 2: x0 := 4;
// end;
// f := solver.CalcValue(x0);
// solver.Free;
// end;
//for i := 80 to 120 do
//begin
// solver := TRockThrowSolver.Create(FHailstones[0], FHailstones[1], FHailstones[2], 0);
// x0 := i / 20;
// f := solver.CalcValue(x0);
// WriteLn(x0, ' ', f.Valid, ' ', f.Value);
// solver.Free;
//end;
end; end;
constructor TNeverTellMeTheOdds.Create(const AMin: Int64; const AMax: Int64); constructor TNeverTellMeTheOdds.Create(const AMin: Int64; const AMax: Int64);
@ -508,15 +617,19 @@ end;
procedure TNeverTellMeTheOdds.Finish; procedure TNeverTellMeTheOdds.Finish;
var var
i, j: Integer; i, j, k: Integer;
begin begin
for i := 0 to FHailstones.Count - 2 do for i := 0 to FHailstones.Count - 2 do
for j := i + 1 to FHailstones.Count - 1 do for j := i + 1 to FHailstones.Count - 1 do
if AreIntersecting(FHailstones[i], FHailstones[j]) then if AreIntersecting(FHailstones[i], FHailstones[j]) then
Inc(FPart1); Inc(FPart1);
if FHailstones.Count >= 3 then for i := 0 to FHailstones.Count - 1 do
FPart2 := FindRockThrow(0, 1, 2); for j := 0 to FHailstones.Count - 1 do
for k := 0 to FHailstones.Count - 1 do
if (i <> j) and (i <> k) and (j <> k) then
FindRockThrow(i, j, k);
//FindRockThrow(0, 1, 2);
end; end;
function TNeverTellMeTheOdds.GetDataFileName: string; function TNeverTellMeTheOdds.GetDataFileName: string;

45
solvers/UPipeMaze.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,7 +22,7 @@ unit UPipeMaze;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, USolver, UCommon; Classes, SysUtils, Generics.Collections, USolver;
const const
CStartChar = 'S'; CStartChar = 'S';
@ -115,18 +115,24 @@ procedure TPipeMaze.InitStepMappings;
var var
i: Integer; i: Integer;
begin begin
FStepMappings.Add(TStepMapping.Create(CDirectionDown, CDirectionDown, '|', FStepMappings.Add(TStepMapping.Create(Point(0, 1), Point(0, 1), '|',
TPointArray.Create(CDirectionRight), TPointArray.Create(CDirectionLeft))); TPointArray.Create(Point(1, 0)),
FStepMappings.Add(TStepMapping.Create(CDirectionRight, CDirectionRight, '-', TPointArray.Create(Point(-1, 0))));
TPointArray.Create(CDirectionUp), TPointArray.Create(CDirectionDown))); FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(1, 0), '-',
FStepMappings.Add(TStepMapping.Create(CDirectionLeft, CDirectionUp, 'L', TPointArray.Create(Point(0, -1)),
TPointArray.Create(CDirectionDown, CDirectionLeftDown, CDirectionLeft), [])); TPointArray.Create(Point(0, 1))));
FStepMappings.Add(TStepMapping.Create(CDirectionDown, CDirectionLeft, 'J', FStepMappings.Add(TStepMapping.Create(Point(-1, 0), Point(0, -1), 'L',
TPointArray.Create(CDirectionRight, CDirectionRightDown, CDirectionDown), [])); TPointArray.Create(Point(0, 1), Point(-1, 1), Point(-1, 0)),
FStepMappings.Add(TStepMapping.Create(CDirectionRight, CDirectionDown, '7', []));
TPointArray.Create(CDirectionUp, CDirectionRightUp, CDirectionRight), [])); FStepMappings.Add(TStepMapping.Create(Point(0, 1), Point(-1, 0), 'J',
FStepMappings.Add(TStepMapping.Create(CDirectionUp, CDirectionRight, 'F', TPointArray.Create(Point(1, 0), Point(1, 1), Point(0, 1)),
TPointArray.Create(CDirectionLeft, CDirectionLeftUp, CDirectionUp), [])); []));
FStepMappings.Add(TStepMapping.Create(Point(1, 0), Point(0, 1), '7',
TPointArray.Create(Point(0, -1), Point(1, -1), Point(1, 0)),
[]));
FStepMappings.Add(TStepMapping.Create(Point(0, -1), Point(1, 0), 'F',
TPointArray.Create(Point(-1, 0), Point(-1, -1), Point(0, -1)),
[]));
// Adds reverse step mappings. // Adds reverse step mappings.
for i := 0 to FStepMappings.Count - 1 do for i := 0 to FStepMappings.Count - 1 do
@ -225,12 +231,13 @@ end;
function TPipeMaze.TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean; function TPipeMaze.TryCountEnclosureSide(const AChar: Char; out OCount: Int64): Boolean;
var var
directions: TPointArray;
stack: specialize TStack<TPoint>; stack: specialize TStack<TPoint>;
i, j: Integer; i, j: Integer;
position, neighbor: TPoint; position, direction, neighbor: TPoint;
pdirection: PPoint;
c: Char; c: Char;
begin begin
directions := TPointArray.Create(Point(0, -1), Point(-1, 0), Point(0, 1), Point(1, 0));
stack := specialize TStack<TPoint>.Create; stack := specialize TStack<TPoint>.Create;
OCount := 0; OCount := 0;
@ -252,12 +259,12 @@ begin
begin begin
position := stack.Pop; position := stack.Pop;
for pdirection in CPCardinalDirections do for direction in directions do
begin begin
if CheckMapBounds(position + pdirection^) then if CheckMapBounds(position + direction) then
begin begin
// Checks the neighboring position. // Checks the neighboring position.
neighbor := position + pdirection^; neighbor := position + direction;
c := GetEnclosureMapChar(neighbor); c := GetEnclosureMapChar(neighbor);
if (c <> CFloodFillChar) and (c <> CPathChar) then if (c <> CFloodFillChar) and (c <> CPathChar) then
begin begin

127
solvers/UPulsePropagation.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,7 +22,7 @@ unit UPulsePropagation;
interface interface
uses uses
Classes, SysUtils, Generics.Collections, USolver; Classes, SysUtils, Generics.Collections, Math, USolver;
type type
TModule = class; TModule = class;
@ -49,12 +49,12 @@ type
public public
property Name: string read FName; property Name: string read FName;
property OutputNames: TStringList read FOutputNames; property OutputNames: TStringList read FOutputNames;
property Outputs: TModules read FOutputs;
constructor Create(const AName: string); constructor Create(const AName: string);
destructor Destroy; override; destructor Destroy; override;
procedure AddInput(const AInput: TModule); virtual; procedure AddInput(const AInput: TModule); virtual;
procedure AddOutput(const AOutput: TModule); virtual; procedure AddOutput(const AOutput: TModule); virtual;
function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; virtual; abstract; function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; virtual; abstract;
function IsOff: Boolean; virtual;
end; end;
{ TBroadcasterModule } { TBroadcasterModule }
@ -71,29 +71,31 @@ type
FState: Boolean; FState: Boolean;
public public
function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override; function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
function IsOff: Boolean; override;
end; end;
{ TConjunctionInputBuffer } { TConjectionBuffer }
TConjunctionInputBuffer = record TConjectionBuffer = record
Input: TModule; Input: TModule;
LastState: Boolean; LastState: Boolean;
end; end;
TConjunctionInputBuffers = specialize TList<TConjunctionInputBuffer>; TConjectionBuffers = specialize TList<TConjectionBuffer>;
{ TConjunctionModule } { TConjunctionModule }
TConjunctionModule = class(TModule) TConjunctionModule = class(TModule)
private private
FInputBuffers: TConjunctionInputBuffers; FInputBuffers: TConjectionBuffers;
procedure UpdateInputBuffer(constref AInput: TModule; const AState: Boolean); procedure UpdateInputBuffer(constref AInput: TModule; const AState: Boolean);
function AreAllBuffersHigh: Boolean; function AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
public public
constructor Create(const AName: string); constructor Create(const AName: string);
destructor Destroy; override; destructor Destroy; override;
procedure AddInput(const AInput: TModule); override; procedure AddInput(const AInput: TModule); override;
function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override; function ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; override;
function IsOff: Boolean; override;
end; end;
{ TEndpointModule } { TEndpointModule }
@ -109,6 +111,8 @@ type
LowCount, HighCount: Integer; LowCount, HighCount: Integer;
end; end;
TButtonResults = specialize TList<TButtonResult>;
{ TPulsePropagation } { TPulsePropagation }
TPulsePropagation = class(TSolver) TPulsePropagation = class(TSolver)
@ -117,7 +121,7 @@ type
FBroadcaster: TModule; FBroadcaster: TModule;
procedure UpdateModuleConnections; procedure UpdateModuleConnections;
function PushButton: TButtonResult; function PushButton: TButtonResult;
function CalcCounterTarget(const AFirstFlipFlop: TModule): Int64; function AreAllModulesOff: Boolean;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -176,6 +180,11 @@ begin
FOutputs.Add(AOutput); FOutputs.Add(AOutput);
end; end;
function TModule.IsOff: Boolean;
begin
Result := True;
end;
{ TBroadcasterModule } { TBroadcasterModule }
function TBroadcasterModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; function TBroadcasterModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
@ -195,12 +204,17 @@ begin
end; end;
end; end;
function TFlipFlopModule.IsOff: Boolean;
begin
Result := not FState;
end;
{ TConjunctionModule } { TConjunctionModule }
procedure TConjunctionModule.UpdateInputBuffer(constref AInput: TModule; const AState: Boolean); procedure TConjunctionModule.UpdateInputBuffer(constref AInput: TModule; const AState: Boolean);
var var
i: Integer; i: Integer;
buffer: TConjunctionInputBuffer; buffer: TConjectionBuffer;
begin begin
for i := 0 to FInputBuffers.Count - 1 do for i := 0 to FInputBuffers.Count - 1 do
if FInputBuffers[i].Input = AInput then if FInputBuffers[i].Input = AInput then
@ -212,13 +226,13 @@ begin
end; end;
end; end;
function TConjunctionModule.AreAllBuffersHigh: Boolean; function TConjunctionModule.AreAllBuffersSame(const AIsHigh: Boolean): Boolean;
var var
buffer: TConjunctionInputBuffer; buffer: TConjectionBuffer;
begin begin
Result := True; Result := True;
for buffer in FInputBuffers do for buffer in FInputBuffers do
if not buffer.LastState then if buffer.LastState <> AIsHigh then
begin begin
Result := False; Result := False;
Exit; Exit;
@ -228,7 +242,7 @@ end;
constructor TConjunctionModule.Create(const AName: string); constructor TConjunctionModule.Create(const AName: string);
begin begin
inherited Create(AName); inherited Create(AName);
FInputBuffers := TConjunctionInputBuffers.Create; FInputBuffers := TConjectionBuffers.Create;
end; end;
destructor TConjunctionModule.Destroy; destructor TConjunctionModule.Destroy;
@ -239,7 +253,7 @@ end;
procedure TConjunctionModule.AddInput(const AInput: TModule); procedure TConjunctionModule.AddInput(const AInput: TModule);
var var
buffer: TConjunctionInputBuffer; buffer: TConjectionBuffer;
begin begin
buffer.Input := AInput; buffer.Input := AInput;
buffer.LastState := False; buffer.LastState := False;
@ -249,7 +263,12 @@ end;
function TConjunctionModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses; function TConjunctionModule.ReceivePulse(const ASender: TModule; const AIsHigh: Boolean): TPulses;
begin begin
UpdateInputBuffer(ASender, AIsHigh); UpdateInputBuffer(ASender, AIsHigh);
Result := CreatePulsesToOutputs(not AreAllBuffersHigh); Result := CreatePulsesToOutputs(not AreAllBuffersSame(True));
end;
function TConjunctionModule.IsOff: Boolean;
begin
Result := AreAllBuffersSame(False);
end; end;
{ TEndpointModule } { TEndpointModule }
@ -323,38 +342,16 @@ begin
queue.Free; queue.Free;
end; end;
function TPulsePropagation.CalcCounterTarget(const AFirstFlipFlop: TModule): Int64; function TPulsePropagation.AreAllModulesOff: Boolean;
var var
binDigit: Int64; module: TModule;
current, next: TModule;
i: Integer;
begin begin
Result := 0; Result := True;
binDigit := 1; for module in FModules do
current := AFirstFlipFlop; if not module.IsOff then
while True do
begin begin
if current.Outputs.Count = 1 then Result := False;
begin
current := current.Outputs.First;
if current is TConjunctionModule then
begin
Result := Result + binDigit;
Break;
end;
end
else begin
Result := Result + binDigit;
i := 0;
repeat
if i = current.Outputs.Count then
Exit; Exit;
next := current.Outputs[i];
Inc(i);
until next is TFlipFlopModule;
current := next;
end;
binDigit := binDigit << 1;
end; end;
end; end;
@ -395,26 +392,42 @@ end;
procedure TPulsePropagation.Finish; procedure TPulsePropagation.Finish;
var var
result, accumulated: TButtonResult; results: TButtonResults;
i: Integer; finalResult: TButtonResult;
module: TModule; cycles, remainder, i, j, max: Integer;
begin begin
UpdateModuleConnections; UpdateModuleConnections;
accumulated.LowCount := 0; // The pulse counts for the full puzzle input repeat themselves in a very specific way, but the system state does not.
accumulated.HighCount := 0; // This indicates there is a better solution for this problem.
for i := 1 to CButtonPushes do // TODO: See if there is a better solution based on the repeating patterns in the pulse counts.
results := TButtonResults.Create;
repeat
results.Add(PushButton);
until AreAllModulesOff or (results.Count >= CButtonPushes);
DivMod(CButtonPushes, results.Count, cycles, remainder);
finalResult.LowCount := 0;
finalResult.HighCount := 0;
max := results.Count - 1;
for j := 0 to 1 do
begin begin
result := PushButton; for i := 0 to max do
Inc(accumulated.LowCount, result.LowCount); begin
Inc(accumulated.HighCount, result.HighCount); Inc(finalResult.LowCount, results[i].LowCount);
Inc(finalResult.HighCount, results[i].HighCount);
end;
if j = 0 then
begin
finalResult.LowCount := finalResult.LowCount * cycles;
finalResult.HighCount := finalResult.HighCount * cycles;
max := remainder - 1;
end;
end; end;
FPart1 := accumulated.LowCount * accumulated.HighCount; results.Free;
FPart2 := 1; FPart1 := finalResult.LowCount * finalResult.HighCount;
for module in FBroadcaster.Outputs do
FPart2 := FPart2 * CalcCounterTarget(module);
end; end;
function TPulsePropagation.GetDataFileName: string; function TPulsePropagation.GetDataFileName: string;

6
solvers/USandSlabs.pas
View File

@ -230,12 +230,14 @@ begin
end; end;
// Updates disintegration flag. // Updates disintegration flag.
if (ABrick.SupportBricks.Count = 1) if ABrick.SupportBricks.Count = 1 then
and ABrick.SupportBricks[0].IsDisintegratable then begin
if ABrick.SupportBricks[0].IsDisintegratable then
begin begin
ABrick.SupportBricks[0].IsDisintegratable := False; ABrick.SupportBricks[0].IsDisintegratable := False;
Dec(FPart1); Dec(FPart1);
end; end;
end;
for i := 0 to ABrick.SupportBricks.Count - 1 do for i := 0 to ABrick.SupportBricks.Count - 1 do
ABrick.SupportBricks[i].AddTopBrick(ABrick); ABrick.SupportBricks[i].AddTopBrick(ABrick);

308
solvers/USnowverload.pas
View File

@ -1,308 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit USnowverload;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Generics.Collections, USolver;
type
TSnowComponent = class;
TSnowComponents = specialize TObjectList<TSnowComponent>;
{ TSnowComponent }
TSnowComponent = class
private
FName: string;
FMergedComponents: TSnowComponents;
FMergeParent: TSnowComponent;
public
property Name: string read FName;
procedure AddMerged(constref AMerge: TSnowComponent);
function GetRootComponent: TSnowComponent;
function GetMergeCount: Integer;
procedure Reset;
constructor Create(const AName: string);
destructor Destroy; override;
end;
{ TWire }
TWire = class
private
FComponent1, FComponent2: TSnowComponent;
function GetComponent1: TSnowComponent;
function GetComponent2: TSnowComponent;
public
property Component1: TSnowComponent read GetComponent1;
property Component2: TSnowComponent read GetComponent2;
function IsLoop: Boolean;
constructor Create(constref AComponent1, AComponent2: TSnowComponent);
end;
TWires = specialize TObjectList<TWire>;
{ TNetwork }
TNetwork = class
private
FComponents: TSnowComponents;
FWires, FContracted: TWires;
public
function FindOrAddComponent(const AName: string): TSnowComponent;
procedure AddWire(constref AComponent1, AComponent2: TSnowComponent);
function RunMinCutContractionAlgorithm: Integer;
procedure Reset;
function GetResult: Integer;
constructor Create;
destructor Destroy; override;
end;
{ TSnowverload }
TSnowverload = class(TSolver)
private
FNetwork: TNetwork;
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
{ TSnowComponent }
procedure TSnowComponent.AddMerged(constref AMerge: TSnowComponent);
begin
FMergedComponents.Add(AMerge);
AMerge.FMergeParent := Self;
end;
function TSnowComponent.GetRootComponent: TSnowComponent;
begin
Result := Self;
while Result.FMergeParent <> nil do
Result := Result.FMergeParent;
end;
function TSnowComponent.GetMergeCount: Integer;
var
c: TSnowComponent;
begin
Result := 1;
for c in FMergedComponents do
Inc(Result, c.GetMergeCount);
end;
procedure TSnowComponent.Reset;
begin
FMergedComponents.Clear;
FMergeParent := nil;
end;
constructor TSnowComponent.Create(const AName: string);
begin
FName := AName;
FMergedComponents := TSnowComponents.Create(False);
FMergeParent := nil;
end;
destructor TSnowComponent.Destroy;
begin
FMergedComponents.Free;
inherited Destroy;
end;
{ TWire }
function TWire.GetComponent1: TSnowComponent;
begin
Result := FComponent1.GetRootComponent;
end;
function TWire.GetComponent2: TSnowComponent;
begin
Result := FComponent2.GetRootComponent;
end;
function TWire.IsLoop: Boolean;
begin
Result := Component1 = Component2;
end;
constructor TWire.Create(constref AComponent1, AComponent2: TSnowComponent);
begin
FComponent1 := AComponent1;
FComponent2 := AComponent2;
end;
{ TNetwork }
function TNetwork.FindOrAddComponent(const AName: string): TSnowComponent;
var
found: Boolean;
begin
found := False;
for Result in FComponents do
if Result.Name = AName then
begin
found := True;
Break;
end;
if not found then
begin
Result := TSnowComponent.Create(AName);
FComponents.Add(Result);
end;
end;
procedure TNetwork.AddWire(constref AComponent1, AComponent2: TSnowComponent);
begin
FWires.Add(TWire.Create(AComponent1, AComponent2));
end;
function TNetwork.RunMinCutContractionAlgorithm: Integer;
var
r, count: Integer;
w: TWire;
begin
count := FComponents.Count;
while count > 2 do
begin
// Determines contraction wire.
r := Random(FWires.Count - 1);
w := FWires.ExtractIndex(r);
FContracted.Add(w);
// Merges c2 into c1.
if not w.IsLoop then
begin
w.Component1.AddMerged(w.Component2);
Dec(count);
end;
end;
Result := 0;
for w in FWires do
if not w.IsLoop then
Inc(Result);
end;
procedure TNetwork.Reset;
var
c: TSnowComponent;
i: Integer;
w: TWire;
begin
for c in FComponents do
c.Reset;
i := FContracted.Count - 1;
while i >= 0 do
begin
w := FContracted.ExtractIndex(i);
FWires.Add(w);
Dec(i);
end;
end;
function TNetwork.GetResult: Integer;
begin
Result := FComponents[0].GetRootComponent.GetMergeCount;
Result := Result * (FComponents.Count - Result);
end;
constructor TNetwork.Create;
begin
FComponents := TSnowComponents.Create;
FWires := TWires.Create;
FContracted := TWires.Create;
end;
destructor TNetwork.Destroy;
begin
FComponents.Free;
FWires.Free;
FContracted.Free;
inherited Destroy;
end;
{ TSnowverload }
constructor TSnowverload.Create;
begin
FNetwork := TNetwork.Create;
end;
destructor TSnowverload.Destroy;
begin
FNetwork.Free;
inherited Destroy;
end;
procedure TSnowverload.ProcessDataLine(const ALine: string);
var
split: TStringArray;
c1, c2: TSnowComponent;
i: Integer;
begin
split := ALine.Split([':', ' ']);
c1 := FNetwork.FindOrAddComponent(split[0]);
for i := 2 to Length(split) - 1 do
begin
c2 := FNetwork.FindOrAddComponent(split[i]);
FNetwork.AddWire(c1, c2);
end;
end;
procedure TSnowverload.Finish;
var
cut: Integer;
begin
// Karger's algorithm with known minimum cut size.
// See https://en.wikipedia.org/wiki/Karger%27s_algorithm
Randomize;
cut := FNetwork.RunMinCutContractionAlgorithm;
while cut > 3 do
begin
FNetwork.Reset;
cut := FNetwork.RunMinCutContractionAlgorithm;
end;
FPart1 := FNetwork.GetResult;
end;
function TSnowverload.GetDataFileName: string;
begin
Result := 'snowverload.txt';
end;
function TSnowverload.GetPuzzleName: string;
begin
Result := 'Day 25: Snowverload';
end;
end.

215
solvers/UStepCounter.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -22,25 +22,23 @@ unit UStepCounter;
interface interface
uses uses
Classes, SysUtils, USolver, UCommon; Classes, SysUtils, Generics.Collections, USolver;
type type
TPoints = specialize TList<TPoint>;
{ TStepCounter } { TStepCounter }
TStepCounter = class(TSolver) TStepCounter = class(TSolver)
private private
FLines: TStringList; FLines: TStringList;
FWidth, FHeight, FMaxSteps1, FMaxSteps2: Integer; FWidth, FHeight, FMaxSteps: Integer;
function FindStart: TPoint; function FindStart: TPoint;
function IsInBounds(constref APoint: TPoint): Boolean; function IsInBounds(constref APoint: TPoint): Boolean;
function GetPosition(constref APoint: TPoint): Char; function GetPosition(constref APoint: TPoint): Char;
procedure SetPosition(constref APoint: TPoint; const AValue: Char); procedure SetPosition(constref APoint: TPoint; const AValue: Char);
procedure PrepareMap;
function DoSteps(const AMaxSteps: Integer): Int64;
function CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
public public
constructor Create(const AMaxStepsPart1: Integer = 64; const AMaxStepsPart2: Integer = 26501365); constructor Create(const AMaxSteps: Integer = 64);
destructor Destroy; override; destructor Destroy; override;
procedure ProcessDataLine(const ALine: string); override; procedure ProcessDataLine(const ALine: string); override;
procedure Finish; override; procedure Finish; override;
@ -51,8 +49,8 @@ type
const const
CStartChar = 'S'; CStartChar = 'S';
CPlotChar = '.'; CPlotChar = '.';
CRockChar = '#';
CTraversedChar = '+'; CTraversedChar = '+';
CDirections: array of TPoint = ((X: 1; Y: 0), (X: -1; Y: 0), (X: 0; Y: 1), (X: 0; Y: -1));
implementation implementation
@ -91,167 +89,9 @@ begin
FLines[APoint.Y] := s; FLines[APoint.Y] := s;
end; end;
procedure TStepCounter.PrepareMap; constructor TStepCounter.Create(const AMaxSteps: Integer);
var
i, j: Integer;
begin begin
for i := 2 to FWidth - 1 do FMaxSteps := AMaxSteps;
for j := 1 to FHeight - 2 do
if (FLines[j][i] <> CRockChar) and (FLines[j - 1][i] = CRockChar) and (FLines[j + 1][i] = CRockChar)
and (FLines[j][i - 1] = CRockChar) and (FLines[j][i + 1] = CRockChar) then
SetPosition(Point(i, j), CRockChar);
end;
function TStepCounter.DoSteps(const AMaxSteps: Integer): Int64;
var
mod2, currentStep: Integer;
currentPlots, nextPlots, temp: TPoints;
plot, next: TPoint;
pdirection: PPoint;
begin
currentStep := 0;
currentPlots := TPoints.Create;
currentPlots.Add(FindStart);
nextPlots := TPoints.Create;
// Counts the start if max steps is even.
mod2 := AMaxSteps and 1;
if mod2 = 0 then
Result := 1
else
Result := 0;
while currentStep < AMaxSteps do
begin
for plot in currentPlots do
for pdirection in CPCardinalDirections do
begin
next := plot + pdirection^;
if IsInBounds(next) and (GetPosition(next) = CPlotChar) then
begin
SetPosition(next, CTraversedChar);
nextPlots.Add(next);
end;
end;
currentPlots.Clear;
temp := currentPlots;
currentPlots := nextPlots;
nextPlots := temp;
Inc(currentStep);
// Positions where the number of steps are even or odd (for even or odd AMaxSteps, respectively) can be reached with
// trivial backtracking, so they count.
if currentStep and 1 = mod2 then
Inc(Result, currentPlots.Count);
end;
currentPlots.Free;
nextPlots.Free;
end;
function TStepCounter.CalcTargetPlotsOnInfiniteMap(const AMaxSteps: Integer): Int64;
var
half, k, i, j: Integer;
factor1, factor1B, factor2, factor4A: Int64;
begin
Result := 0;
// Asserts square input map with odd size.
if (FWidth <> FHeight) or (FWidth and 1 = 0) then
Exit;
// Asserts half map size is odd.
half := FWidth shr 1;
if half and 1 = 0 then
Exit;
// Asserts that there is an even k such that maximum number of steps is equal to k + 1/2 times the map size.
// k is the number of visited repeated maps, not counting the start map, when taking all steps in a straight line in
// any of the four directions.
k := (AMaxSteps - half) div FWidth;
if (k and 1 = 0) and (AMaxSteps <> k * FWidth + half) then
Exit;
// Assuming that the rocks on the map are sparse enough, and the central vertical and horizontal lines are empty,
// every free plot with odd (Manhattan) distance (not larger than AMaxSteps) to the start plot (because of trivial
// backtracking) on the maps is reachable, essentially formning a 45-degree rotated square shape centered on the start
// plot.
// Inside this "diamond" shape, 2k(k - 1) + 1 (k-th centered square number) copies of the map are traversed fully.
// However, there are two different types of these. (k - 1)^2 are traversed like the start map, where all plots with
// odd distance to the center are reachable (type 1), and k^2 are traversed such that all plots within odd distance to
// the center are reachable (type 2).
// On each of the corners of this "diamond" shape, there is one map traversed fully except for two adjacent of its
// corner triangles (type 3).
// On each of the edges of this "diamond" shape, there are k maps where only the corner triangle facing towards the
// shapes center is traversed (type 4), and k - 1 maps that are fully traversed except for the corner triangle facing
// away from the shapes center (type 5).
// The four different versions of type 4 do not overlap within a map, so they can be counted together (type 4A).
// Types 1, 3, and 5 share patterns, so they can also be counted together, but the parts of the patterns have
// different counts. Each corner (type 1A) is traversed (k - 1)^2 times for type 1, 2 times for type 3, and 3(k - 1)
// for type 5, that is (k - 1)^2 + 3k - 1 in total. The center (type 1B) is traversed (k - 1)^2 times for type 1, 4
// times for type 3, and 4(k - 1) for type 5, that is (k - 1)^2 + 4k.
// Equivalently, instead type 1 is traversed (k - 1)^2 + 3k - 1 times and type 1B is traversed k + 1 times.
// Types example for k = 2, half = 5:
// 4 5 2 4A
// ........... .....O.O.O. O.O.O.O.O.O O.O.O.O.O.O
// ........... ....O.O.O.O .O.O.O.O.O. .O.O...O.O.
// ........... ...O.O.O.O. O.O.O.O.O.O O.O.....O.O
// ......#.... ..O.O.#.O.O .O.O.O#O.O. .O....#..O.
// ...#....... .O.#.O.O.O. O.O#O.O.O.O O..#......O
// ........... O.O.O.O.O.O .O.O.O.O.O. ...........
// ....#..#..O .O.O#O.#.O. O.O.#.O.#.O O...#..#..O
// .........O. O.O.O.O.O.O .O.O.O.O.O. .O.......O.
// ........O.O .O.O.O.O.O. O.O.O.O.O.O O.O.....O.O
// .......O.O. O.O.O.O.O.O .O.O.O.O.O. .O.O...O.O.
// ......O.O.O .O.O.O.O.O. O.O.O.O.O.O O.O.O.O.O.O
//
// 3 2 1 1A 1B
// .....O.O.O. O.O.O.O.O.O .O.O.O.O.O. .O.O...O.O. .....O.....
// ....O.O.O.O .O.O.O.O.O. O.O.O.O.O.O O.O.....O.O ....O.O....
// ...O.O.O.O. O.O.O.O.O.O .O.O.O.O.O. .O.......O. ...O.O.O...
// ..O.O.#.O.O .O.O.O#O.O. O.O.O.#.O.O O.....#...O ..O.O.#.O..
// .O.#.O.O.O. O.O#O.O.O.O .O.#.O.O.O. ...#....... .O.#.O.O.O.
// O.O.O.O.O.O .O.O.O.O.O. O.O.OSO.O.O ........... O.O.O.O.O.O
// .O.O#O.#.O. O.O.#.O.#.O .O.O#O.#.O. ....#..#... .O.O#O.#.O.
// ..O.O.O.O.O .O.O.O.O.O. O.O.O.O.O.O O.........O ..O.O.O.O..
// ...O.O.O.O. O.O.O.O.O.O .O.O.O.O.O. .O.......O. ...O.O.O...
// ....O.O.O.O .O.O.O.O.O. O.O.O.O.O.O O.O.....O.O ....O.O....
// .....O.O.O. O.O.O.O.O.O .O.O.O.O.O. .O.O...O.O. .....O.....
// Sets factors, aka number of occurrences, for each type.
factor1 := (k - 1) * (k - 1) + 3 * k - 1;
factor1B := k + 1;
factor2 := k * k;
factor4A := k;
for i := 0 to FWidth - 1 do
for j := 1 to FWidth do
if FLines[i][j] <> CRockChar then
if (i and 1) = (j and 1) then
begin
// Counts types 1.
Result := Result + factor1;
// Counts types 1B.
if not ((i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1)) then
Result := Result + factor1B;
end
else begin
// Counts types 2.
Result := Result + factor2;
// Counts types 4A.
if (i + j <= half) or (i + j > FWidth + half) or (i - j >= half) or (j - i > half + 1) then
Result := Result + factor4A;
end
end;
constructor TStepCounter.Create(const AMaxStepsPart1: Integer; const AMaxStepsPart2: Integer);
begin
FMaxSteps1 := AMaxStepsPart1;
FMaxSteps2 := AMaxStepsPart2;
FLines := TStringList.Create; FLines := TStringList.Create;
end; end;
@ -267,13 +107,46 @@ begin
end; end;
procedure TStepCounter.Finish; procedure TStepCounter.Finish;
var
currentStep: Integer;
currentPlots, nextPlots, temp: TPoints;
plot, direction, next: TPoint;
begin begin
FWidth := Length(FLines[0]); FWidth := Length(FLines[0]);
FHeight := FLines.Count; FHeight := FLines.Count;
PrepareMap;
FPart2 := CalcTargetPlotsOnInfiniteMap(FMaxSteps2); currentStep := 0;
FPart1 := DoSteps(FMaxSteps1); currentPlots := TPoints.Create;
currentPlots.Add(FindStart);
Inc(FPart1);
nextPlots := TPoints.Create;
while currentStep < FMaxSteps do
begin
for plot in currentPlots do
for direction in CDirections do
begin
next := plot + direction;
if IsInBounds(next) and (GetPosition(next) = CPlotChar) then
begin
SetPosition(next, CTraversedChar);
nextPlots.Add(next);
end;
end;
currentPlots.Clear;
temp := currentPlots;
currentPlots := nextPlots;
nextPlots := temp;
Inc(currentStep);
// Positions where the number of steps are even can be reached with trivial backtracking, so they count.
if currentStep mod 2 = 0 then
Inc(FPart1, currentPlots.Count);
end;
currentPlots.Free;
nextPlots.Free;
end; end;
function TStepCounter.GetDataFileName: string; function TStepCounter.GetDataFileName: string;

2
solvers/UTrebuchet.pas
View File

@ -151,7 +151,7 @@ end;
function TTrebuchet.GetDataFileName: string; function TTrebuchet.GetDataFileName: string;
begin begin
Result := 'trebuchet.txt'; Result := 'trebuchet_calibration_document.txt';
end; end;
function TTrebuchet.GetPuzzleName: string; function TTrebuchet.GetPuzzleName: string;

16
tests/AdventOfCodeFPCUnit.lpi
View File

@ -40,6 +40,10 @@
<Filename Value="UGearRatiosTestCases.pas"/> <Filename Value="UGearRatiosTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="..\USolver.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit> <Unit>
<Filename Value="UBaseTestCases.pas"/> <Filename Value="UBaseTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -140,6 +144,10 @@
<Filename Value="UPolynomialTestCases.pas"/> <Filename Value="UPolynomialTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="..\UPolynomialRoots.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit> <Unit>
<Filename Value="UPolynomialRootsTestCases.pas"/> <Filename Value="UPolynomialRootsTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -148,14 +156,6 @@
<Filename Value="UBigIntTestCases.pas"/> <Filename Value="UBigIntTestCases.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="USnowverloadTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="UBinomialCoefficientsTestCases.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

3
tests/AdventOfCodeFPCUnit.lpr
View File

@ -9,8 +9,7 @@ uses
UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases,
UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases,
UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases, UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases,
UNeverTellMeTheOddsTestCases, USnowverloadTestCases, UBigIntTestCases, UPolynomialTestCases, UNeverTellMeTheOddsTestCases, UBigIntTestCases;
UPolynomialRootsTestCases, UBinomialCoefficientsTestCases;
{$R *.res} {$R *.res}

30
tests/UAplentyTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TAplentyFullDataTestCase }
TAplentyFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TAplentyExampleTestCase } { TAplentyExampleTestCase }
TAplentyExampleTestCase = class(TExampleEngineBaseTest) TAplentyExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TAplentyFullDataTestCase }
function TAplentyFullDataTestCase.CreateSolver: ISolver;
begin
Result := TAplenty.Create;
end;
procedure TAplentyFullDataTestCase.TestPart1;
begin
AssertEquals(331208, FSolver.GetResultPart1);
end;
procedure TAplentyFullDataTestCase.TestPart2;
begin
AssertEquals(121464316215623, FSolver.GetResultPart2);
end;
{ TAplentyExampleTestCase } { TAplentyExampleTestCase }
function TAplentyExampleTestCase.CreateSolver: ISolver; function TAplentyExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TAplenty', TAplentyExampleTestCase); RegisterTest(TAplentyFullDataTestCase);
RegisterTest(TAplentyExampleTestCase);
end. end.

23
tests/UBaseTestCases.pas
View File

@ -43,14 +43,14 @@ type
FEngine: TSolverEngine; FEngine: TSolverEngine;
procedure Setup; override; procedure Setup; override;
procedure TearDown; override; procedure TearDown; override;
function GetDataPaths: TStringArray; virtual; function GetDataPath: string; virtual;
end; end;
{ TExampleEngineBaseTest } { TExampleEngineBaseTest }
TExampleEngineBaseTest = class(TEngineBaseTest) TExampleEngineBaseTest = class(TEngineBaseTest)
protected protected
function GetDataPaths: TStringArray; override; function GetDataPath: string; override;
end; end;
implementation implementation
@ -74,8 +74,7 @@ end;
procedure TEngineBaseTest.Setup; procedure TEngineBaseTest.Setup;
begin begin
inherited Setup; inherited Setup;
FEngine := TSolverEngine.Create(GetDataPaths); FEngine := TSolverEngine.Create(GetDataPath);
AssertTrue(FEngine.GetInvalidDataPathMessage(FSolver), FEngine.HasValidDataPath(FSolver));
FEngine.ProcessData(FSolver); FEngine.ProcessData(FSolver);
end; end;
@ -85,24 +84,16 @@ begin
inherited TearDown; inherited TearDown;
end; end;
function TEngineBaseTest.GetDataPaths: TStringArray; function TEngineBaseTest.GetDataPath: string;
begin begin
Result := TStringArray.Create( Result := ConcatPaths(['..', '..', 'bin', 'data']);
ConcatPaths(['..', '..', 'bin', 'data']),
ConcatPaths(['..', '..', '..', 'data']),
ConcatPaths(['..', '..', 'data'])
);
end; end;
{ TExampleEngineBaseTest } { TExampleEngineBaseTest }
function TExampleEngineBaseTest.GetDataPaths: TStringArray; function TExampleEngineBaseTest.GetDataPath: string;
begin begin
Result := TStringArray.Create( Result := 'example_data';
ConcatPaths(['..', '..', 'bin', 'data', 'example']),
ConcatPaths(['..', '..', '..', 'data', 'example']),
ConcatPaths(['..', '..', 'data', 'example'])
);
end; end;
end. end.

26
tests/UBigIntTestCases.pas
View File

@ -1016,18 +1016,18 @@ end;
initialization initialization
RegisterTest('Helper.TBigInt', TBigIntSignTestCase); RegisterTest(TBigIntSignTestCase);
RegisterTest('Helper.TBigInt', TBigIntMostSignificantBitIndexTestCase); RegisterTest(TBigIntMostSignificantBitIndexTestCase);
RegisterTest('Helper.TBigInt', TBigIntFromInt64TestCase); RegisterTest(TBigIntFromInt64TestCase);
RegisterTest('Helper.TBigInt', TBigIntFromHexTestCase); RegisterTest(TBigIntFromHexTestCase);
RegisterTest('Helper.TBigInt', TBigIntFromBinTestCase); RegisterTest(TBigIntFromBinTestCase);
RegisterTest('Helper.TBigInt', TBigIntUnaryMinusTestCase); RegisterTest(TBigIntUnaryMinusTestCase);
RegisterTest('Helper.TBigInt', TBigIntSumTestCase); RegisterTest(TBigIntSumTestCase);
RegisterTest('Helper.TBigInt', TBigIntDifferenceTestCase); RegisterTest(TBigIntDifferenceTestCase);
RegisterTest('Helper.TBigInt', TBigIntProductTestCase); RegisterTest(TBigIntProductTestCase);
RegisterTest('Helper.TBigInt', TBigIntShiftLeftTestCase); RegisterTest(TBigIntShiftLeftTestCase);
RegisterTest('Helper.TBigInt', TBigIntShiftRightTestCase); RegisterTest(TBigIntShiftRightTestCase);
RegisterTest('Helper.TBigInt', TBigIntEqualityTestCase); RegisterTest(TBigIntEqualityTestCase);
RegisterTest('Helper.TBigInt', TBigIntComparisonTestCase); RegisterTest(TBigIntComparisonTestCase);
end. end.

162
tests/UBinomialCoefficientsTestCases.pas
View File

@ -1,162 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UBinomialCoefficientsTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, UBinomialCoefficients;
type
{ TBinomialCoefficientsTestCase }
TBinomialCoefficientsTestCase = class(TTestCase)
private
FBinomialCoefficientCache: TBinomialCoefficientCache;
procedure RunRangeError;
procedure AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
procedure AssertEqualsCachedRowsCount(const AExpected: Cardinal);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestZeroChooseZero;
procedure TestNChooseZero;
procedure TestNChooseN;
procedure TestNChooseK;
procedure TestCombined;
procedure TestFullRow;
procedure TestRangeError;
end;
{ TBinomialCoefficientsGlobalTestCase }
TBinomialCoefficientsGlobalTestCase = class(TTestCase)
private
procedure AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
published
procedure TestCombined;
end;
implementation
{ TBinomialCoefficientsTestCase }
procedure TBinomialCoefficientsTestCase.RunRangeError;
begin
FBinomialCoefficientCache.Get(1, 5);
end;
procedure TBinomialCoefficientsTestCase.AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
begin
AssertEquals('Unexpected calculation result', AExpected, FBinomialCoefficientCache.Get(AN, AK));
end;
procedure TBinomialCoefficientsTestCase.AssertEqualsCachedRowsCount(const AExpected: Cardinal);
begin
AssertEquals('Unexpected cached rows count', AExpected, FBinomialCoefficientCache.GetCachedRowsCount);
end;
procedure TBinomialCoefficientsTestCase.SetUp;
begin
FBinomialCoefficientCache := TBinomialCoefficientCache.Create;
end;
procedure TBinomialCoefficientsTestCase.TearDown;
begin
FBinomialCoefficientCache.Free;
end;
procedure TBinomialCoefficientsTestCase.TestZeroChooseZero;
begin
AssertEqualsCalculation(0, 0, 1);
AssertEqualsCachedRowsCount(1);
end;
procedure TBinomialCoefficientsTestCase.TestNChooseZero;
begin
AssertEqualsCalculation(15, 0, 1);
AssertEqualsCachedRowsCount(16);
end;
procedure TBinomialCoefficientsTestCase.TestNChooseN;
begin
AssertEqualsCalculation(11, 11, 1);
AssertEqualsCachedRowsCount(12);
end;
procedure TBinomialCoefficientsTestCase.TestNChooseK;
begin
AssertEqualsCalculation(8, 3, 56);
AssertEqualsCachedRowsCount(9);
end;
procedure TBinomialCoefficientsTestCase.TestCombined;
begin
AssertEqualsCalculation(5, 1, 5);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(8, 4, 70);
AssertEqualsCachedRowsCount(9);
AssertEqualsCalculation(3, 1, 3);
AssertEqualsCachedRowsCount(9);
end;
procedure TBinomialCoefficientsTestCase.TestFullRow;
begin
AssertEqualsCalculation(5, 0, 1);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(5, 1, 5);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(5, 2, 10);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(5, 3, 10);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(5, 4, 5);
AssertEqualsCachedRowsCount(6);
AssertEqualsCalculation(5, 5, 1);
AssertEqualsCachedRowsCount(6);
end;
procedure TBinomialCoefficientsTestCase.TestRangeError;
begin
AssertException(ERangeError, @RunRangeError);
end;
{ TBinomialCoefficientsGlobalTestCase }
procedure TBinomialCoefficientsGlobalTestCase.AssertEqualsCalculation(const AN, AK, AExpected: Cardinal);
begin
AssertEquals('Unexpected calculation result', AExpected, BinomialCoefficients.Get(AN, AK));
end;
procedure TBinomialCoefficientsGlobalTestCase.TestCombined;
begin
AssertEqualsCalculation(5, 1, 5);
AssertEqualsCalculation(8, 4, 70);
AssertEqualsCalculation(3, 1, 3);
end;
initialization
RegisterTest('Helper.TBinomialCoefficientCache', TBinomialCoefficientsTestCase);
RegisterTest('Helper.TBinomialCoefficientCache', TBinomialCoefficientsGlobalTestCase);
end.

30
tests/UCamelCardsTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TCamelCardsFullDataTestCase }
TCamelCardsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TCamelCardsExampleTestCase } { TCamelCardsExampleTestCase }
TCamelCardsExampleTestCase = class(TExampleEngineBaseTest) TCamelCardsExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TCamelCardsFullDataTestCase }
function TCamelCardsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TCamelCards.Create;
end;
procedure TCamelCardsFullDataTestCase.TestPart1;
begin
AssertEquals(254024898, FSolver.GetResultPart1);
end;
procedure TCamelCardsFullDataTestCase.TestPart2;
begin
AssertEquals(254115617, FSolver.GetResultPart2);
end;
{ TCamelCardsExampleTestCase } { TCamelCardsExampleTestCase }
function TCamelCardsExampleTestCase.CreateSolver: ISolver; function TCamelCardsExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TCamelCards', TCamelCardsExampleTestCase); RegisterTest(TCamelCardsFullDataTestCase);
RegisterTest(TCamelCardsExampleTestCase);
end. end.

69
tests/UClumsyCrucibleTestCases.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -26,6 +26,16 @@ uses
type type
{ TClumsyCrucibleFullDataTestCase }
TClumsyCrucibleFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TClumsyCrucibleExampleTestCase } { TClumsyCrucibleExampleTestCase }
TClumsyCrucibleExampleTestCase = class(TExampleEngineBaseTest) TClumsyCrucibleExampleTestCase = class(TExampleEngineBaseTest)
@ -36,23 +46,25 @@ type
procedure TestPart2; procedure TestPart2;
end; end;
{ TExample2ClumsyCrucible }
TExample2ClumsyCrucible = class(TClumsyCrucible)
function GetDataFileName: string; override;
end;
{ TClumsyCrucibleExample2TestCase }
TClumsyCrucibleExample2TestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart2;
end;
implementation implementation
{ TClumsyCrucibleFullDataTestCase }
function TClumsyCrucibleFullDataTestCase.CreateSolver: ISolver;
begin
Result := TClumsyCrucible.Create;
end;
procedure TClumsyCrucibleFullDataTestCase.TestPart1;
begin
AssertEquals(-1, FSolver.GetResultPart1);
end;
procedure TClumsyCrucibleFullDataTestCase.TestPart2;
begin
AssertEquals(-1, FSolver.GetResultPart2);
end;
{ TClumsyCrucibleExampleTestCase } { TClumsyCrucibleExampleTestCase }
function TClumsyCrucibleExampleTestCase.CreateSolver: ISolver; function TClumsyCrucibleExampleTestCase.CreateSolver: ISolver;
@ -67,31 +79,12 @@ end;
procedure TClumsyCrucibleExampleTestCase.TestPart2; procedure TClumsyCrucibleExampleTestCase.TestPart2;
begin begin
AssertEquals(94, FSolver.GetResultPart2); AssertEquals(-1, FSolver.GetResultPart2);
end;
{ TExample2ClumsyCrucible }
function TExample2ClumsyCrucible.GetDataFileName: string;
begin
Result := 'clumsy_crucible2.txt';
end;
{ TClumsyCrucibleExample2TestCase }
function TClumsyCrucibleExample2TestCase.CreateSolver: ISolver;
begin
Result := TExample2ClumsyCrucible.Create;
end;
procedure TClumsyCrucibleExample2TestCase.TestPart2;
begin
AssertEquals(71, FSolver.GetResultPart2);
end; end;
initialization initialization
RegisterTest('TClumsyCrucible', TClumsyCrucibleExampleTestCase); //RegisterTest(TClumsyCrucibleFullDataTestCase);
RegisterTest('TClumsyCrucible', TClumsyCrucibleExample2TestCase); //RegisterTest(TClumsyCrucibleExampleTestCase);
end. end.

34
tests/UCosmicExpansionTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TCosmicExpansionFullDataTestCase }
TCosmicExpansionFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TCosmicExpansionExampleTestCase } { TCosmicExpansionExampleTestCase }
TCosmicExpansionExampleTestCase = class(TExampleEngineBaseTest) TCosmicExpansionExampleTestCase = class(TExampleEngineBaseTest)
@ -55,6 +65,23 @@ type
implementation implementation
{ TCosmicExpansionFullDataTestCase }
function TCosmicExpansionFullDataTestCase.CreateSolver: ISolver;
begin
Result := TCosmicExpansion.Create;
end;
procedure TCosmicExpansionFullDataTestCase.TestPart1;
begin
AssertEquals(9686930, FSolver.GetResultPart1);
end;
procedure TCosmicExpansionFullDataTestCase.TestPart2;
begin
AssertEquals(630728425490, FSolver.GetResultPart2);
end;
{ TCosmicExpansionExampleTestCase } { TCosmicExpansionExampleTestCase }
function TCosmicExpansionExampleTestCase.CreateSolver: ISolver; function TCosmicExpansionExampleTestCase.CreateSolver: ISolver;
@ -93,8 +120,9 @@ end;
initialization initialization
RegisterTest('TCosmicExpansion', TCosmicExpansionExampleTestCase); RegisterTest(TCosmicExpansionFullDataTestCase);
RegisterTest('TCosmicExpansion', TCosmicExpansionExampleFactor10TestCase); RegisterTest(TCosmicExpansionExampleTestCase);
RegisterTest('TCosmicExpansion', TCosmicExpansionExampleFactor100TestCase); RegisterTest(TCosmicExpansionExampleFactor10TestCase);
RegisterTest(TCosmicExpansionExampleFactor100TestCase);
end. end.

30
tests/UCubeConundrumTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TCubeConundrumFullDataTestCase }
TCubeConundrumFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TCubeConundrumExampleTestCase } { TCubeConundrumExampleTestCase }
TCubeConundrumExampleTestCase = class(TExampleEngineBaseTest) TCubeConundrumExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TCubeConundrumFullDataTestCase }
function TCubeConundrumFullDataTestCase.CreateSolver: ISolver;
begin
Result := TCubeConundrum.Create;
end;
procedure TCubeConundrumFullDataTestCase.TestPart1;
begin
AssertEquals(2563, FSolver.GetResultPart1);
end;
procedure TCubeConundrumFullDataTestCase.TestPart2;
begin
AssertEquals(70768, FSolver.GetResultPart2);
end;
{ TCubeConundrumExampleTestCase } { TCubeConundrumExampleTestCase }
function TCubeConundrumExampleTestCase.CreateSolver: ISolver; function TCubeConundrumExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TCubeConundrum', TCubeConundrumExampleTestCase); RegisterTest(TCubeConundrumFullDataTestCase);
RegisterTest(TCubeConundrumExampleTestCase);
end. end.

30
tests/UFloorWillBeLavaTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TFloorWillBeLavaFullDataTestCase }
TFloorWillBeLavaFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TFloorWillBeLavaExampleTestCase } { TFloorWillBeLavaExampleTestCase }
TFloorWillBeLavaExampleTestCase = class(TExampleEngineBaseTest) TFloorWillBeLavaExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TFloorWillBeLavaFullDataTestCase }
function TFloorWillBeLavaFullDataTestCase.CreateSolver: ISolver;
begin
Result := TFloorWillBeLava.Create;
end;
procedure TFloorWillBeLavaFullDataTestCase.TestPart1;
begin
AssertEquals(7392, FSolver.GetResultPart1);
end;
procedure TFloorWillBeLavaFullDataTestCase.TestPart2;
begin
AssertEquals(7665, FSolver.GetResultPart2);
end;
{ TFloorWillBeLavaExampleTestCase } { TFloorWillBeLavaExampleTestCase }
function TFloorWillBeLavaExampleTestCase.CreateSolver: ISolver; function TFloorWillBeLavaExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TFloorWillBeLava', TFloorWillBeLavaExampleTestCase); RegisterTest(TFloorWillBeLavaFullDataTestCase);
RegisterTest(TFloorWillBeLavaExampleTestCase);
end. end.

32
tests/UGearRatiosTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TGearRatiosFullDataTestCase }
TGearRatiosFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TGearRatiosExampleTestCase } { TGearRatiosExampleTestCase }
TGearRatiosExampleTestCase = class(TExampleEngineBaseTest) TGearRatiosExampleTestCase = class(TExampleEngineBaseTest)
@ -47,6 +57,23 @@ type
implementation implementation
{ TGearRatiosFullDataTestCase }
function TGearRatiosFullDataTestCase.CreateSolver: ISolver;
begin
Result := TGearRatios.Create;
end;
procedure TGearRatiosFullDataTestCase.TestPart1;
begin
AssertEquals(530495, FSolver.GetResultPart1);
end;
procedure TGearRatiosFullDataTestCase.TestPart2;
begin
AssertEquals(80253814, FSolver.GetResultPart2);
end;
{ TGearRatiosExampleTestCase } { TGearRatiosExampleTestCase }
function TGearRatiosExampleTestCase.CreateSolver: ISolver; function TGearRatiosExampleTestCase.CreateSolver: ISolver;
@ -81,6 +108,7 @@ end;
initialization initialization
RegisterTest('TGearRatios', TGearRatiosExampleTestCase); RegisterTest(TGearRatiosFullDataTestCase);
RegisterTest('TGearRatios', TGearRatiosTestCase); RegisterTest(TGearRatiosExampleTestCase);
RegisterTest(TGearRatiosTestCase);
end. end.

30
tests/UGiveSeedFertilizerTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TGiveSeedFertilizerFullDataTestCase }
TGiveSeedFertilizerFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TGiveSeedFertilizerExampleTestCase } { TGiveSeedFertilizerExampleTestCase }
TGiveSeedFertilizerExampleTestCase = class(TExampleEngineBaseTest) TGiveSeedFertilizerExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TGiveSeedFertilizerFullDataTestCase }
function TGiveSeedFertilizerFullDataTestCase.CreateSolver: ISolver;
begin
Result := TGiveSeedFertilizer.Create;
end;
procedure TGiveSeedFertilizerFullDataTestCase.TestPart1;
begin
AssertEquals(51580674, FSolver.GetResultPart1);
end;
procedure TGiveSeedFertilizerFullDataTestCase.TestPart2;
begin
AssertEquals(99751240, FSolver.GetResultPart2);
end;
{ TGiveSeedFertilizerExampleTestCase } { TGiveSeedFertilizerExampleTestCase }
function TGiveSeedFertilizerExampleTestCase.CreateSolver: ISolver; function TGiveSeedFertilizerExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TGiveSeedFertilizer', TGiveSeedFertilizerExampleTestCase); RegisterTest(TGiveSeedFertilizerFullDataTestCase);
RegisterTest(TGiveSeedFertilizerExampleTestCase);
end. end.

34
tests/UHauntedWastelandTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ THauntedWastelandFullDataTestCase }
THauntedWastelandFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ THauntedWastelandExampleTestCase } { THauntedWastelandExampleTestCase }
THauntedWastelandExampleTestCase = class(TExampleEngineBaseTest) THauntedWastelandExampleTestCase = class(TExampleEngineBaseTest)
@ -67,6 +77,23 @@ type
implementation implementation
{ THauntedWastelandFullDataTestCase }
function THauntedWastelandFullDataTestCase.CreateSolver: ISolver;
begin
Result := THauntedWasteland.Create;
end;
procedure THauntedWastelandFullDataTestCase.TestPart1;
begin
AssertEquals(14257, FSolver.GetResultPart1);
end;
procedure THauntedWastelandFullDataTestCase.TestPart2;
begin
AssertEquals(16187743689077, FSolver.GetResultPart2);
end;
{ THauntedWastelandExampleTestCase } { THauntedWastelandExampleTestCase }
function THauntedWastelandExampleTestCase.CreateSolver: ISolver; function THauntedWastelandExampleTestCase.CreateSolver: ISolver;
@ -119,7 +146,8 @@ end;
initialization initialization
RegisterTest('THauntedWasteland', THauntedWastelandExampleTestCase); RegisterTest(THauntedWastelandFullDataTestCase);
RegisterTest('THauntedWasteland', THauntedWastelandExample2TestCase); RegisterTest(THauntedWastelandExampleTestCase);
RegisterTest('THauntedWasteland', THauntedWastelandExample3TestCase); RegisterTest(THauntedWastelandExample2TestCase);
RegisterTest(THauntedWastelandExample3TestCase);
end. end.

121
tests/UHotSpringsTestCases.pas
View File

@ -26,6 +26,15 @@ uses
type type
{ THotSpringsFullDataTestCase }
THotSpringsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ THotSpringsExampleTestCase } { THotSpringsExampleTestCase }
THotSpringsExampleTestCase = class(TExampleEngineBaseTest) THotSpringsExampleTestCase = class(TExampleEngineBaseTest)
@ -33,7 +42,6 @@ type
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
published published
procedure TestPart1; procedure TestPart1;
procedure TestPart2;
end; end;
{ THotSpringsTestCase } { THotSpringsTestCase }
@ -41,24 +49,30 @@ type
THotSpringsTestCase = class(TSolverTestCase) THotSpringsTestCase = class(TSolverTestCase)
protected protected
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
procedure TestSingleLine(const ALine: string); procedure TestSingleLine(const ALine: string; const AValue: Integer);
published published
procedure TestExampleLine1Part1; procedure TestExampleLine1;
procedure TestExampleLine2Part1; procedure TestExampleLine2;
procedure TestExampleLine3Part1; procedure TestExampleLine3;
procedure TestExampleLine4Part1; procedure TestExampleLine4;
procedure TestExampleLine5Part1; procedure TestExampleLine5;
procedure TestExampleLine6Part1; procedure TestExampleLine6;
procedure TestExampleLine1Part2;
procedure TestExampleLine2Part2;
procedure TestExampleLine3Part2;
procedure TestExampleLine4Part2;
procedure TestExampleLine5Part2;
procedure TestExampleLine6Part2;
end; end;
implementation implementation
{ THotSpringsFullDataTestCase }
function THotSpringsFullDataTestCase.CreateSolver: ISolver;
begin
Result := THotSprings.Create;
end;
procedure THotSpringsFullDataTestCase.TestPart1;
begin
AssertEquals(7344, FSolver.GetResultPart1);
end;
{ THotSpringsExampleTestCase } { THotSpringsExampleTestCase }
function THotSpringsExampleTestCase.CreateSolver: ISolver; function THotSpringsExampleTestCase.CreateSolver: ISolver;
@ -71,11 +85,6 @@ begin
AssertEquals(21, FSolver.GetResultPart1); AssertEquals(21, FSolver.GetResultPart1);
end; end;
procedure THotSpringsExampleTestCase.TestPart2;
begin
AssertEquals(525152, FSolver.GetResultPart2);
end;
{ THotSpringsTestCase } { THotSpringsTestCase }
function THotSpringsTestCase.CreateSolver: ISolver; function THotSpringsTestCase.CreateSolver: ISolver;
@ -83,88 +92,48 @@ begin
Result := THotSprings.Create; Result := THotSprings.Create;
end; end;
procedure THotSpringsTestCase.TestSingleLine(const ALine: string); procedure THotSpringsTestCase.TestSingleLine(const ALine: string; const AValue: Integer);
begin begin
FSolver.Init; FSolver.Init;
FSolver.ProcessDataLine(ALine); FSolver.ProcessDataLine(ALine);
FSolver.Finish; FSolver.Finish;
AssertEquals(AValue, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine1Part1; procedure THotSpringsTestCase.TestExampleLine1;
begin begin
TestSingleLine('???.### 1,1,3'); TestSingleLine('???.### 1,1,3', 1);
AssertEquals(1, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine2Part1; procedure THotSpringsTestCase.TestExampleLine2;
begin begin
TestSingleLine('.??..??...?##. 1,1,3'); TestSingleLine('.??..??...?##. 1,1,3', 4);
AssertEquals(4, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine3Part1; procedure THotSpringsTestCase.TestExampleLine3;
begin begin
TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6'); TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6', 1);
AssertEquals(1, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine4Part1; procedure THotSpringsTestCase.TestExampleLine4;
begin begin
TestSingleLine('????.#...#... 4,1,1'); TestSingleLine('????.#...#... 4,1,1', 1);
AssertEquals(1, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine5Part1; procedure THotSpringsTestCase.TestExampleLine5;
begin begin
TestSingleLine('????.######..#####. 1,6,5'); TestSingleLine('????.######..#####. 1,6,5', 4);
AssertEquals(4, FSolver.GetResultPart1);
end; end;
procedure THotSpringsTestCase.TestExampleLine6Part1; procedure THotSpringsTestCase.TestExampleLine6;
begin begin
TestSingleLine('?###???????? 3,2,1'); TestSingleLine('?###???????? 3,2,1', 10);
AssertEquals(10, FSolver.GetResultPart1);
end;
procedure THotSpringsTestCase.TestExampleLine1Part2;
begin
TestSingleLine('???.### 1,1,3');
AssertEquals(1, FSolver.GetResultPart2);
end;
procedure THotSpringsTestCase.TestExampleLine2Part2;
begin
TestSingleLine('.??..??...?##. 1,1,3');
AssertEquals(16384, FSolver.GetResultPart2);
end;
procedure THotSpringsTestCase.TestExampleLine3Part2;
begin
TestSingleLine('?#?#?#?#?#?#?#? 1,3,1,6');
AssertEquals(1, FSolver.GetResultPart2);
end;
procedure THotSpringsTestCase.TestExampleLine4Part2;
begin
TestSingleLine('????.#...#... 4,1,1');
AssertEquals(16, FSolver.GetResultPart2);
end;
procedure THotSpringsTestCase.TestExampleLine5Part2;
begin
TestSingleLine('????.######..#####. 1,6,5');
AssertEquals(2500, FSolver.GetResultPart2);
end;
procedure THotSpringsTestCase.TestExampleLine6Part2;
begin
TestSingleLine('?###???????? 3,2,1');
AssertEquals(506250, FSolver.GetResultPart2);
end; end;
initialization initialization
RegisterTest('THotSprings', THotSpringsExampleTestCase); RegisterTest(THotSpringsFullDataTestCase);
RegisterTest('THotSprings', THotSpringsTestCase); RegisterTest(THotSpringsExampleTestCase);
RegisterTest(THotSpringsTestCase);
end. end.

32
tests/ULavaductLagoonTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TLavaductLagoonFullDataTestCase }
TLavaductLagoonFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TLavaductLagoonExampleTestCase } { TLavaductLagoonExampleTestCase }
TLavaductLagoonExampleTestCase = class(TExampleEngineBaseTest) TLavaductLagoonExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TLavaductLagoonFullDataTestCase }
function TLavaductLagoonFullDataTestCase.CreateSolver: ISolver;
begin
Result := TLavaductLagoon.Create;
end;
procedure TLavaductLagoonFullDataTestCase.TestPart1;
begin
AssertEquals(-1, FSolver.GetResultPart1);
end;
procedure TLavaductLagoonFullDataTestCase.TestPart2;
begin
AssertEquals(-1, FSolver.GetResultPart2);
end;
{ TLavaductLagoonExampleTestCase } { TLavaductLagoonExampleTestCase }
function TLavaductLagoonExampleTestCase.CreateSolver: ISolver; function TLavaductLagoonExampleTestCase.CreateSolver: ISolver;
@ -52,11 +79,12 @@ end;
procedure TLavaductLagoonExampleTestCase.TestPart2; procedure TLavaductLagoonExampleTestCase.TestPart2;
begin begin
AssertEquals(952408144115, FSolver.GetResultPart2); AssertEquals(-1, FSolver.GetResultPart2);
end; end;
initialization initialization
RegisterTest('TLavaductLagoon', TLavaductLagoonExampleTestCase); //RegisterTest(TLavaductLagoonFullDataTestCase);
//RegisterTest(TLavaductLagoonExampleTestCase);
end. end.

30
tests/ULensLibraryTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TLensLibraryFullDataTestCase }
TLensLibraryFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TLensLibraryExampleTestCase } { TLensLibraryExampleTestCase }
TLensLibraryExampleTestCase = class(TExampleEngineBaseTest) TLensLibraryExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TLensLibraryFullDataTestCase }
function TLensLibraryFullDataTestCase.CreateSolver: ISolver;
begin
Result := TLensLibrary.Create;
end;
procedure TLensLibraryFullDataTestCase.TestPart1;
begin
AssertEquals(519041, FSolver.GetResultPart1);
end;
procedure TLensLibraryFullDataTestCase.TestPart2;
begin
AssertEquals(260530, FSolver.GetResultPart2);
end;
{ TLensLibraryExampleTestCase } { TLensLibraryExampleTestCase }
function TLensLibraryExampleTestCase.CreateSolver: ISolver; function TLensLibraryExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TLensLibrary', TLensLibraryExampleTestCase); RegisterTest(TLensLibraryFullDataTestCase);
RegisterTest(TLensLibraryExampleTestCase);
end. end.

32
tests/ULongWalkTestCases.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -26,6 +26,15 @@ uses
type type
{ TLongWalkFullDataTestCase }
TLongWalkFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TLongWalkExampleTestCase } { TLongWalkExampleTestCase }
TLongWalkExampleTestCase = class(TExampleEngineBaseTest) TLongWalkExampleTestCase = class(TExampleEngineBaseTest)
@ -33,11 +42,22 @@ type
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
published published
procedure TestPart1; procedure TestPart1;
procedure TestPart2;
end; end;
implementation implementation
{ TLongWalkFullDataTestCase }
function TLongWalkFullDataTestCase.CreateSolver: ISolver;
begin
Result := TLongWalk.Create;
end;
procedure TLongWalkFullDataTestCase.TestPart1;
begin
AssertEquals(2218, FSolver.GetResultPart1);
end;
{ TLongWalkExampleTestCase } { TLongWalkExampleTestCase }
function TLongWalkExampleTestCase.CreateSolver: ISolver; function TLongWalkExampleTestCase.CreateSolver: ISolver;
@ -50,13 +70,9 @@ begin
AssertEquals(94, FSolver.GetResultPart1); AssertEquals(94, FSolver.GetResultPart1);
end; end;
procedure TLongWalkExampleTestCase.TestPart2;
begin
AssertEquals(154, FSolver.GetResultPart2);
end;
initialization initialization
RegisterTest('TLongWalk', TLongWalkExampleTestCase); RegisterTest(TLongWalkFullDataTestCase);
RegisterTest(TLongWalkExampleTestCase);
end. end.

30
tests/UMirageMaintenanceTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TMirageMaintenanceFullDataTestCase }
TMirageMaintenanceFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TMirageMaintenanceExampleTestCase } { TMirageMaintenanceExampleTestCase }
TMirageMaintenanceExampleTestCase = class(TExampleEngineBaseTest) TMirageMaintenanceExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TMirageMaintenanceFullDataTestCase }
function TMirageMaintenanceFullDataTestCase.CreateSolver: ISolver;
begin
Result := TMirageMaintenance.Create;
end;
procedure TMirageMaintenanceFullDataTestCase.TestPart1;
begin
AssertEquals(1877825184, FSolver.GetResultPart1);
end;
procedure TMirageMaintenanceFullDataTestCase.TestPart2;
begin
AssertEquals(1108, FSolver.GetResultPart2);
end;
{ TMirageMaintenanceExampleTestCase } { TMirageMaintenanceExampleTestCase }
function TMirageMaintenanceExampleTestCase.CreateSolver: ISolver; function TMirageMaintenanceExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TMirageMaintenance', TMirageMaintenanceExampleTestCase); RegisterTest(TMirageMaintenanceFullDataTestCase);
RegisterTest(TMirageMaintenanceExampleTestCase);
end. end.

34
tests/UNeverTellMeTheOddsTestCases.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -26,6 +26,16 @@ uses
type type
{ TNeverTellMeTheOddsFullDataTestCase }
TNeverTellMeTheOddsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TNeverTellMeTheOddsExampleTestCase } { TNeverTellMeTheOddsExampleTestCase }
TNeverTellMeTheOddsExampleTestCase = class(TExampleEngineBaseTest) TNeverTellMeTheOddsExampleTestCase = class(TExampleEngineBaseTest)
@ -57,6 +67,23 @@ type
implementation implementation
{ TNeverTellMeTheOddsFullDataTestCase }
function TNeverTellMeTheOddsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TNeverTellMeTheOdds.Create;
end;
procedure TNeverTellMeTheOddsFullDataTestCase.TestPart1;
begin
AssertEquals(15107, FSolver.GetResultPart1);
end;
procedure TNeverTellMeTheOddsFullDataTestCase.TestPart2;
begin
AssertEquals(-1, FSolver.GetResultPart2);
end;
{ TNeverTellMeTheOddsExampleTestCase } { TNeverTellMeTheOddsExampleTestCase }
function TNeverTellMeTheOddsExampleTestCase.CreateSolver: ISolver; function TNeverTellMeTheOddsExampleTestCase.CreateSolver: ISolver;
@ -151,7 +178,8 @@ end;
initialization initialization
RegisterTest('TNeverTellMeTheOdds', TNeverTellMeTheOddsExampleTestCase); RegisterTest(TNeverTellMeTheOddsFullDataTestCase);
RegisterTest('TNeverTellMeTheOdds', TNeverTellMeTheOddsTestCase); RegisterTest(TNeverTellMeTheOddsExampleTestCase);
RegisterTest(TNeverTellMeTheOddsTestCase);
end. end.

30
tests/UParabolicReflectorDishTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TParabolicReflectorDishFullDataTestCase }
TParabolicReflectorDishFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TParabolicReflectorDishExampleTestCase } { TParabolicReflectorDishExampleTestCase }
TParabolicReflectorDishExampleTestCase = class(TExampleEngineBaseTest) TParabolicReflectorDishExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TParabolicReflectorDishFullDataTestCase }
function TParabolicReflectorDishFullDataTestCase.CreateSolver: ISolver;
begin
Result := TParabolicReflectorDish.Create;
end;
procedure TParabolicReflectorDishFullDataTestCase.TestPart1;
begin
AssertEquals(103614, FSolver.GetResultPart1);
end;
procedure TParabolicReflectorDishFullDataTestCase.TestPart2;
begin
AssertEquals(83790, FSolver.GetResultPart2);
end;
{ TParabolicReflectorDishExampleTestCase } { TParabolicReflectorDishExampleTestCase }
function TParabolicReflectorDishExampleTestCase.CreateSolver: ISolver; function TParabolicReflectorDishExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TParabolicReflectorDish', TParabolicReflectorDishExampleTestCase); RegisterTest(TParabolicReflectorDishFullDataTestCase);
RegisterTest(TParabolicReflectorDishExampleTestCase);
end. end.

44
tests/UPipeMazeTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TPipeMazeFullDataTestCase }
TPipeMazeFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TPipeMazeExampleTestCase } { TPipeMazeExampleTestCase }
TPipeMazeExampleTestCase = class(TExampleEngineBaseTest) TPipeMazeExampleTestCase = class(TExampleEngineBaseTest)
@ -142,6 +152,23 @@ type
implementation implementation
{ TPipeMazeFullDataTestCase }
function TPipeMazeFullDataTestCase.CreateSolver: ISolver;
begin
Result := TPipeMaze.Create;
end;
procedure TPipeMazeFullDataTestCase.TestPart1;
begin
AssertEquals(7097, FSolver.GetResultPart1);
end;
procedure TPipeMazeFullDataTestCase.TestPart2;
begin
AssertEquals(355, FSolver.GetResultPart2);
end;
{ TPipeMazeExampleTestCase } { TPipeMazeExampleTestCase }
function TPipeMazeExampleTestCase.CreateSolver: ISolver; function TPipeMazeExampleTestCase.CreateSolver: ISolver;
@ -289,12 +316,13 @@ end;
initialization initialization
RegisterTest('TPipeMaze', TPipeMazeExampleTestCase); RegisterTest(TPipeMazeFullDataTestCase);
RegisterTest('TPipeMaze', TPipeMazeExample2TestCase); RegisterTest(TPipeMazeExampleTestCase);
RegisterTest('TPipeMaze', TPipeMazeExample3TestCase); RegisterTest(TPipeMazeExample2TestCase);
RegisterTest('TPipeMaze', TPipeMazeExample4TestCase); RegisterTest(TPipeMazeExample3TestCase);
RegisterTest('TPipeMaze', TPipeMazeExample5TestCase); RegisterTest(TPipeMazeExample4TestCase);
RegisterTest('TPipeMaze', TPipeMazeExample6TestCase); RegisterTest(TPipeMazeExample5TestCase);
RegisterTest('TPipeMaze', TPipeMazeExample7TestCase); RegisterTest(TPipeMazeExample6TestCase);
RegisterTest('TPipeMaze', TPipeMazeExample8TestCase); RegisterTest(TPipeMazeExample7TestCase);
RegisterTest(TPipeMazeExample8TestCase);
end. end.

30
tests/UPointOfIncidenceTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TPointOfIncidenceFullDataTestCase }
TPointOfIncidenceFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TPointOfIncidenceExampleTestCase } { TPointOfIncidenceExampleTestCase }
TPointOfIncidenceExampleTestCase = class(TExampleEngineBaseTest) TPointOfIncidenceExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TPointOfIncidenceFullDataTestCase }
function TPointOfIncidenceFullDataTestCase.CreateSolver: ISolver;
begin
Result := TPointOfIncidence.Create;
end;
procedure TPointOfIncidenceFullDataTestCase.TestPart1;
begin
AssertEquals(37718, FSolver.GetResultPart1);
end;
procedure TPointOfIncidenceFullDataTestCase.TestPart2;
begin
AssertEquals(40995, FSolver.GetResultPart2);
end;
{ TPointOfIncidenceExampleTestCase } { TPointOfIncidenceExampleTestCase }
function TPointOfIncidenceExampleTestCase.CreateSolver: ISolver; function TPointOfIncidenceExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TPointOfIncidence', TPointOfIncidenceExampleTestCase); RegisterTest(TPointOfIncidenceFullDataTestCase);
RegisterTest(TPointOfIncidenceExampleTestCase);
end. end.

138
tests/UPolynomialRootsTestCases.pas
View File

@ -1,138 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UPolynomialRootsTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, UPolynomial, UPolynomialRoots, UBigInt;
type
{ TPolynomialRootsTestCase }
TPolynomialRootsTestCase = class(TTestCase)
private
procedure AssertBisectIntervals(AIsolatingIntervals: TIsolatingIntervalArray; constref AExpectedRoots:
array of Cardinal);
procedure AssertBisectIntegers(ARoots: TBigIntArray; constref AExpectedRoots: array of Cardinal);
published
procedure TestBisectNoBound;
procedure TestBisectWithBound;
procedure TestBisectInteger;
end;
implementation
{ TPolynomialRootsTestCase }
procedure TPolynomialRootsTestCase.AssertBisectIntervals(AIsolatingIntervals: TIsolatingIntervalArray;
constref AExpectedRoots: array of Cardinal);
var
exp: Cardinal;
found: Boolean;
i, foundIndex: Integer;
begin
AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), Length(AIsolatingIntervals));
for exp in AExpectedRoots do
begin
found := False;
for i := 0 to Length(AIsolatingIntervals) - 1 do
if (AIsolatingIntervals[i].A <= exp) and (exp <= AIsolatingIntervals[i].B) then
begin
found := True;
foundIndex := i;
Break;
end;
AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found);
Delete(AIsolatingIntervals, foundIndex, 1);
end;
end;
procedure TPolynomialRootsTestCase.AssertBisectIntegers(ARoots: TBigIntArray; constref AExpectedRoots:
array of Cardinal);
var
exp: Cardinal;
found: Boolean;
i, foundIndex: Integer;
begin
AssertEquals('Unexpected number of integer roots.', Length(AExpectedRoots), Length(ARoots));
for exp in AExpectedRoots do
begin
found := False;
for i := 0 to Length(ARoots) - 1 do
if ARoots[i] = exp then
begin
found := True;
foundIndex := i;
Break;
end;
AssertTrue('Expected root ' + IntToStr(exp) + ' not found.', found);
Delete(ARoots, foundIndex, 1);
end;
end;
procedure TPolynomialRootsTestCase.TestBisectNoBound;
const
expRoots: array of Cardinal = (34000, 23017, 5);
var
a: TBigIntPolynomial;
r: TIsolatingIntervalArray;
begin
// y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112)
// = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000
a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]);
r := TPolynomialRoots.BisectIsolation(a);
AssertBisectIntervals(r, expRoots);
end;
procedure TPolynomialRootsTestCase.TestBisectWithBound;
const
expRoots: array of Cardinal = (23017, 5);
var
a: TBigIntPolynomial;
r: TIsolatingIntervalArray;
begin
// y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112)
// = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000
a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]);
r := TPolynomialRoots.BisectIsolation(a, 15);
AssertBisectIntervals(r, expRoots);
end;
procedure TPolynomialRootsTestCase.TestBisectInteger;
const
expRoots: array of Cardinal = (23017, 5);
var
a: TBigIntPolynomial;
r: TBigIntArray;
begin
// y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112)
// = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000
a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]);
r := TPolynomialRoots.BisectInteger(a, 15);
AssertBisectIntegers(r, expRoots);
end;
initialization
RegisterTest('Helper', TPolynomialRootsTestCase);
end.

187
tests/UPolynomialTestCases.pas
View File

@ -1,187 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit UPolynomialTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, UPolynomial, UBigInt;
type
{ TBigIntPolynomialTestCase }
TBigIntPolynomialTestCase = class(TTestCase)
private
procedure TestCreateWithDegree(const ACoefficients: array of TBigInt; const ADegree: Integer);
published
procedure TestCreate;
procedure TestCreateDegreeZero;
procedure TestEqual;
procedure TestUnequalSameLength;
procedure TestUnequalDifferentLength;
procedure TestTrimLeadingZeros;
procedure TestCalcValueAt;
procedure TestSignVariations;
procedure TestScaleByPowerOfTwo;
procedure TestScaleVariable;
procedure TestScaleVariableByPowerOfTwo;
procedure TestTranslateVariableByOne;
procedure TestRevertOrderOfCoefficients;
procedure TestDivideByVariable;
end;
implementation
{ TBigIntPolynomialTestCase }
procedure TBigIntPolynomialTestCase.TestCreateWithDegree(const ACoefficients: array of TBigInt; const ADegree: Integer);
var
a: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create(ACoefficients);
AssertEquals('Degree of created polynomial incorrect.', ADegree, a.Degree);
end;
procedure TBigIntPolynomialTestCase.TestCreate;
begin
TestCreateWithDegree([992123, 7, 20, 4550022], 3);
end;
procedure TBigIntPolynomialTestCase.TestCreateDegreeZero;
begin
TestCreateWithDegree([4007], 0);
TestCreateWithDegree([], 0);
TestCreateWithDegree([0], 0);
end;
procedure TBigIntPolynomialTestCase.TestEqual;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034]);
b := TBigIntPolynomial.Create([10, 7, 5, 1034]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestUnequalSameLength;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([103, 7, 5, 10]);
b := TBigIntPolynomial.Create([1034, 7, 5, 10]);
AssertTrue('Polynomials are equal.', a <> b);
end;
procedure TBigIntPolynomialTestCase.TestUnequalDifferentLength;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([40000, 10, 7, 5, 1034]);
b := TBigIntPolynomial.Create([10, 7, 5, 1034]);
AssertTrue('Polynomials are equal.', a <> b);
end;
procedure TBigIntPolynomialTestCase.TestTrimLeadingZeros;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034, 0, 0]);
b := TBigIntPolynomial.Create([10, 7, 5, 1034]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestCalcValueAt;
var
a: TBigIntPolynomial;
exp: TBigInt;
begin
a := TBigIntPolynomial.Create([80, 892477222, 0, 921556, 7303]);
exp:= TBigInt.FromInt64(16867124285);
AssertTrue('Polynomial evaluation unexpected.', a.CalcValueAt(15) = exp);
end;
procedure TBigIntPolynomialTestCase.TestSignVariations;
var
a: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([-10, 15, 0, 10, -20, -15, 0, 0, 5, 10, -10]);
AssertEquals(4, a.CalcSignVariations);
end;
procedure TBigIntPolynomialTestCase.TestScaleByPowerOfTwo;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleByPowerOfTwo(7);
b := TBigIntPolynomial.Create([128 * 10, 128 * 7, 128 * 5, 128 * 1034]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestScaleVariable;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleVariable(TBigInt.FromInt64(10));
b := TBigIntPolynomial.Create([10, 70, 500, 1034000]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestScaleVariableByPowerOfTwo;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleVariableByPowerOfTwo(5);
b := TBigIntPolynomial.Create([10, 7 * 32, 5 * 32 * 32, 1034 * 32 * 32 * 32]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestTranslateVariableByOne;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([10, 7, 5, 1034]).TranslateVariableByOne;
b := TBigIntPolynomial.Create([1056, 3119, 3107, 1034]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestRevertOrderOfCoefficients;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([0, 10, 7, 5, 1034]).RevertOrderOfCoefficients;
b := TBigIntPolynomial.Create([1034, 5, 7, 10]);
AssertTrue('Polynomials are not equal.', a = b);
end;
procedure TBigIntPolynomialTestCase.TestDivideByVariable;
var
a, b: TBigIntPolynomial;
begin
a := TBigIntPolynomial.Create([0, 10, 7, 5, 1034]).DivideByVariable;
b := TBigIntPolynomial.Create([10, 7, 5, 1034]);
AssertTrue('Polynomials are not equal.', a = b);
end;
initialization
RegisterTest('Helper', TBigIntPolynomialTestCase);
end.

26
tests/UPulsePropagationTestCases.pas
View File

@ -26,6 +26,15 @@ uses
type type
{ TPulsePropagationFullDataTestCase }
TPulsePropagationFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
{ TPulsePropagationExampleTestCase } { TPulsePropagationExampleTestCase }
TPulsePropagationExampleTestCase = class(TExampleEngineBaseTest) TPulsePropagationExampleTestCase = class(TExampleEngineBaseTest)
@ -52,6 +61,18 @@ type
implementation implementation
{ TPulsePropagationFullDataTestCase }
function TPulsePropagationFullDataTestCase.CreateSolver: ISolver;
begin
Result := TPulsePropagation.Create;
end;
procedure TPulsePropagationFullDataTestCase.TestPart1;
begin
AssertEquals(949764474, FSolver.GetResultPart1);
end;
{ TPulsePropagationExampleTestCase } { TPulsePropagationExampleTestCase }
function TPulsePropagationExampleTestCase.CreateSolver: ISolver; function TPulsePropagationExampleTestCase.CreateSolver: ISolver;
@ -85,7 +106,8 @@ end;
initialization initialization
RegisterTest('TPulsePropagation', TPulsePropagationExampleTestCase); RegisterTest(TPulsePropagationFullDataTestCase);
RegisterTest('TPulsePropagation', TPulsePropagationExample2TestCase); RegisterTest(TPulsePropagationExampleTestCase);
RegisterTest(TPulsePropagationExample2TestCase);
end. end.

30
tests/USandSlabsTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TSandSlabsFullDataTestCase }
TSandSlabsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TSandSlabsExampleTestCase } { TSandSlabsExampleTestCase }
TSandSlabsExampleTestCase = class(TExampleEngineBaseTest) TSandSlabsExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TSandSlabsFullDataTestCase }
function TSandSlabsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TSandSlabs.Create;
end;
procedure TSandSlabsFullDataTestCase.TestPart1;
begin
AssertEquals(389, FSolver.GetResultPart1);
end;
procedure TSandSlabsFullDataTestCase.TestPart2;
begin
AssertEquals(70609, FSolver.GetResultPart2);
end;
{ TSandSlabsExampleTestCase } { TSandSlabsExampleTestCase }
function TSandSlabsExampleTestCase.CreateSolver: ISolver; function TSandSlabsExampleTestCase.CreateSolver: ISolver;
@ -57,6 +84,7 @@ end;
initialization initialization
RegisterTest('TSandSlabs', TSandSlabsExampleTestCase); RegisterTest(TSandSlabsFullDataTestCase);
RegisterTest(TSandSlabsExampleTestCase);
end. end.

30
tests/UScratchcardsTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TScratchcardsFullDataTestCase }
TScratchcardsFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TScratchcardsExampleTestCase } { TScratchcardsExampleTestCase }
TScratchcardsExampleTestCase = class(TExampleEngineBaseTest) TScratchcardsExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TScratchcardsFullDataTestCase }
function TScratchcardsFullDataTestCase.CreateSolver: ISolver;
begin
Result := TScratchcards.Create;
end;
procedure TScratchcardsFullDataTestCase.TestPart1;
begin
AssertEquals(21821, FSolver.GetResultPart1);
end;
procedure TScratchcardsFullDataTestCase.TestPart2;
begin
AssertEquals(5539496, FSolver.GetResultPart2);
end;
{ TScratchcardsExampleTestCase } { TScratchcardsExampleTestCase }
function TScratchcardsExampleTestCase.CreateSolver: ISolver; function TScratchcardsExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TScratchcards', TScratchcardsExampleTestCase); RegisterTest(TScratchcardsFullDataTestCase);
RegisterTest(TScratchcardsExampleTestCase);
end. end.

56
tests/USnowverloadTestCases.pas
View File

@ -1,56 +0,0 @@
{
Solutions to the Advent Of Code.
Copyright (C) 2024 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 <http://www.gnu.org/licenses/>.
}
unit USnowverloadTestCases;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, USnowverload;
type
{ TSnowverloadExampleTestCase }
TSnowverloadExampleTestCase = class(TExampleEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
end;
implementation
{ TSnowverloadExampleTestCase }
function TSnowverloadExampleTestCase.CreateSolver: ISolver;
begin
Result := TSnowverload.Create;
end;
procedure TSnowverloadExampleTestCase.TestPart1;
begin
AssertEquals(54, FSolver.GetResultPart1);
end;
initialization
RegisterTest('TSnowverload', TSnowverloadExampleTestCase);
end.

35
tests/UStepCounterTestCases.pas
View File

@ -1,6 +1,6 @@
{ {
Solutions to the Advent Of Code. Solutions to the Advent Of Code.
Copyright (C) 2023-2024 Stefan Müller Copyright (C) 2023 Stefan Müller
This program is free software: you can redistribute it and/or modify it under 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 the terms of the GNU General Public License as published by the Free Software
@ -25,22 +25,19 @@ uses
Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UStepCounter; Classes, SysUtils, fpcunit, testregistry, USolver, UBaseTestCases, UStepCounter;
type type
// Note that the solver implementation does not work with the examples presented
// in the puzzle description for part 2, therefore they are not represented here
// as test cases.
{ TStepCounterExampleSteps3TestCase } { TStepCounterFullDataTestCase }
TStepCounterExampleSteps3TestCase = class(TExampleEngineBaseTest) TStepCounterFullDataTestCase = class(TEngineBaseTest)
protected protected
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
published published
procedure TestPart1; procedure TestPart1;
end; end;
{ TStepCounterExampleSteps6TestCase } { TStepCounterMax6ExampleTestCase }
TStepCounterExampleSteps6TestCase = class(TExampleEngineBaseTest) TStepCounterMax6ExampleTestCase = class(TExampleEngineBaseTest)
protected protected
function CreateSolver: ISolver; override; function CreateSolver: ISolver; override;
published published
@ -49,33 +46,33 @@ type
implementation implementation
{ TStepCounterExampleSteps3TestCase } { TStepCounterFullDataTestCase }
function TStepCounterExampleSteps3TestCase.CreateSolver: ISolver; function TStepCounterFullDataTestCase.CreateSolver: ISolver;
begin begin
Result := TStepCounter.Create(3, 3); Result := TStepCounter.Create;
end; end;
procedure TStepCounterExampleSteps3TestCase.TestPart1; procedure TStepCounterFullDataTestCase.TestPart1;
begin begin
AssertEquals(6, FSolver.GetResultPart1); AssertEquals(3809, FSolver.GetResultPart1);
end; end;
{ TStepCounterExampleSteps6TestCase } { TStepCounterMax6ExampleTestCase }
function TStepCounterExampleSteps6TestCase.CreateSolver: ISolver; function TStepCounterMax6ExampleTestCase.CreateSolver: ISolver;
begin begin
Result := TStepCounter.Create(6, 6); Result := TStepCounter.Create(6);
end; end;
procedure TStepCounterExampleSteps6TestCase.TestPart1; procedure TStepCounterMax6ExampleTestCase.TestPart1;
begin begin
AssertEquals(16, FSolver.GetResultPart1); AssertEquals(16, FSolver.GetResultPart1);
end; end;
initialization initialization
RegisterTest('TStepCounter', TStepCounterExampleSteps3TestCase); RegisterTest(TStepCounterFullDataTestCase);
RegisterTest('TStepCounter', TStepCounterExampleSteps6TestCase); RegisterTest(TStepCounterMax6ExampleTestCase);
end. end.

34
tests/UTrebuchetTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TTrebuchetFullDataTestCase }
TTrebuchetFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TTrebuchetExampleTestCase } { TTrebuchetExampleTestCase }
TTrebuchetExampleTestCase = class(TExampleEngineBaseTest) TTrebuchetExampleTestCase = class(TExampleEngineBaseTest)
@ -52,6 +62,23 @@ type
implementation implementation
{ TTrebuchetFullDataTestCase }
function TTrebuchetFullDataTestCase.CreateSolver: ISolver;
begin
Result := TTrebuchet.Create;
end;
procedure TTrebuchetFullDataTestCase.TestPart1;
begin
AssertEquals(56506, FSolver.GetResultPart1);
end;
procedure TTrebuchetFullDataTestCase.TestPart2;
begin
AssertEquals(56017, FSolver.GetResultPart2);
end;
{ TTrebuchetExampleTestCase } { TTrebuchetExampleTestCase }
function TTrebuchetExampleTestCase.CreateSolver: ISolver; function TTrebuchetExampleTestCase.CreateSolver: ISolver;
@ -68,7 +95,7 @@ end;
function TExample2Trebuchet.GetDataFileName: string; function TExample2Trebuchet.GetDataFileName: string;
begin begin
Result := 'trebuchet2.txt'; Result := 'trebuchet_calibration_document2.txt';
end; end;
{ TTrebuchetExample2TestCase } { TTrebuchetExample2TestCase }
@ -85,6 +112,7 @@ end;
initialization initialization
RegisterTest('TTrebuchet', TTrebuchetExampleTestCase); RegisterTest(TTrebuchetFullDataTestCase);
RegisterTest('TTrebuchet', TTrebuchetExample2TestCase); RegisterTest(TTrebuchetExampleTestCase);
RegisterTest(TTrebuchetExample2TestCase);
end. end.

30
tests/UWaitForItTestCases.pas
View File

@ -26,6 +26,16 @@ uses
type type
{ TWaitForItFullDataTestCase }
TWaitForItFullDataTestCase = class(TEngineBaseTest)
protected
function CreateSolver: ISolver; override;
published
procedure TestPart1;
procedure TestPart2;
end;
{ TWaitForItExampleTestCase } { TWaitForItExampleTestCase }
TWaitForItExampleTestCase = class(TExampleEngineBaseTest) TWaitForItExampleTestCase = class(TExampleEngineBaseTest)
@ -38,6 +48,23 @@ type
implementation implementation
{ TWaitForItFullDataTestCase }
function TWaitForItFullDataTestCase.CreateSolver: ISolver;
begin
Result := TWaitForIt.Create;
end;
procedure TWaitForItFullDataTestCase.TestPart1;
begin
AssertEquals(4811940, FSolver.GetResultPart1);
end;
procedure TWaitForItFullDataTestCase.TestPart2;
begin
AssertEquals(30077773, FSolver.GetResultPart2);
end;
{ TWaitForItExampleTestCase } { TWaitForItExampleTestCase }
function TWaitForItExampleTestCase.CreateSolver: ISolver; function TWaitForItExampleTestCase.CreateSolver: ISolver;
@ -57,5 +84,6 @@ end;
initialization initialization
RegisterTest('TWaitForIt', TWaitForItExampleTestCase); RegisterTest(TWaitForItFullDataTestCase);
RegisterTest(TWaitForItExampleTestCase);
end. end.