{ Solutions to the Advent Of Code. Copyright (C) 2023 Stefan Müller This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . } unit UStepCounter; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, Generics.Collections, USolver; type TPoints = specialize TList; { TStepCounter } TStepCounter = class(TSolver) private FLines: TStringList; FWidth, FHeight, FMaxSteps: Integer; function FindStart: TPoint; function IsInBounds(constref APoint: TPoint): Boolean; function GetPosition(constref APoint: TPoint): Char; procedure SetPosition(constref APoint: TPoint; const AValue: Char); public property MaxSteps: Integer read FMaxSteps write FMaxSteps; constructor Create; destructor Destroy; override; procedure ProcessDataLine(const ALine: string); override; procedure Finish; override; function GetDataFileName: string; override; function GetPuzzleName: string; override; end; const CStartChar = 'S'; CPlotChar = '.'; CTraversedChar = '+'; CDirections: array of TPoint = ((X: 1; Y: 0), (X: -1; Y: 0), (X: 0; Y: 1), (X: 0; Y: -1)); implementation { TStepCounter } function TStepCounter.FindStart: TPoint; var i, j: Integer; begin for i := 1 to FWidth do for j := 0 to FHeight - 1 do if FLines[j][i] = CStartChar then begin Result.X := i; Result.Y := j; Exit; end; end; function TStepCounter.IsInBounds(constref APoint: TPoint): Boolean; begin Result := (0 < APoint.X) and (APoint.X <= FWidth) and (0 <= APoint.Y) and (APoint.Y < FHeight); end; function TStepCounter.GetPosition(constref APoint: TPoint): Char; begin Result := FLines[APoint.Y][APoint.X]; end; procedure TStepCounter.SetPosition(constref APoint: TPoint; const AValue: Char); var s: string; begin s := FLines[APoint.Y]; s[APoint.X] := AValue; FLines[APoint.Y] := s; end; constructor TStepCounter.Create; begin FMaxSteps := 64; FLines := TStringList.Create; end; destructor TStepCounter.Destroy; begin FLines.Free; inherited Destroy; end; procedure TStepCounter.ProcessDataLine(const ALine: string); begin FLines.Add(ALine); end; procedure TStepCounter.Finish; var currentStep: Integer; currentPlots, nextPlots, temp: TPoints; plot, direction, next: TPoint; //s: string; begin FWidth := Length(FLines[0]); FHeight := FLines.Count; currentStep := 0; 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 //begin Inc(FPart1, currentPlots.Count); // for plot in currentPlots do // SetPosition(plot, 'O'); //end; //for s in FLines do // WriteLn(s); //WriteLn; end; currentPlots.Free; nextPlots.Free; end; function TStepCounter.GetDataFileName: string; begin Result := 'step_counter.txt'; end; function TStepCounter.GetPuzzleName: string; begin Result := 'Day 21: Step Counter'; end; end.