{ 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 ULensLibrary; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, Generics.Collections, USolver; type { TLens } TLens = record Key: string; FocalLength: Byte; end; TBoxContent = specialize TList; TBoxes = specialize TObjectList; { THashMap } THashMap = class private FBoxes: TBoxes; function IndexOf(const AHash: Byte; const AKey: string): Integer; public constructor Create; destructor Destroy; override; function CalcHash(const AInput: string): Byte; procedure AddLens(const AKey: string; const AFocalLength: Byte); procedure RemoveLens(const AKey: string); function CalcFocusingPower: Int64; end; { TLensLibrary } TLensLibrary = class(TSolver) private FHashMap: THashMap; procedure ProcessInstruction(const AInstruction: string); 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 { THashMap } function THashMap.IndexOf(const AHash: Byte; const AKey: string): Integer; var i: Integer; begin Result := -1; i := 0; while (i < FBoxes[AHash].Count) and (Result < 0) do begin if FBoxes[AHash][i].Key = AKey then Result := i; Inc(i); end; end; constructor THashMap.Create; var i: Integer; begin FBoxes := TBoxes.Create; FBoxes.Count := 256; for i := 0 to FBoxes.Count - 1 do begin FBoxes[i] := TBoxContent.Create; end; end; destructor THashMap.Destroy; begin FBoxes.Free; inherited Destroy; end; function THashMap.CalcHash(const AInput: string): Byte; var c: Char; begin Result := 0; for c in AInput do Result := ((Result + Ord(c)) * 17) and 255; end; procedure THashMap.AddLens(const AKey: string; const AFocalLength: Byte); var hash: Byte; i: Integer; lens: TLens; begin hash := CalcHash(AKey); i := IndexOf(hash, AKey); if i >= 0 then begin lens := FBoxes[hash][i]; lens.FocalLength := AFocalLength; FBoxes[hash][i] := lens; end else begin lens.Key := AKey; lens.FocalLength := AFocalLength; FBoxes[hash].Add(lens); end; end; procedure THashMap.RemoveLens(const AKey: string); var hash: Byte; i: Integer; begin hash := CalcHash(AKey); i := IndexOf(hash, AKey); if i >= 0 then FBoxes[hash].Delete(i); end; function THashMap.CalcFocusingPower: Int64; var i, j: Integer; begin Result := 0; for i := 0 to FBoxes.Count - 1 do for j := 0 to FBoxes[i].Count - 1 do Inc(Result, (i + 1) * (j + 1) * FBoxes[i][j].FocalLength); end; { TLensLibrary } procedure TLensLibrary.ProcessInstruction(const AInstruction: string); var len: Integer; begin len := Length(AInstruction); if AInstruction[len] = '-' then FHashMap.RemoveLens(Copy(AInstruction, 1, len - 1)) else FHashMap.AddLens(Copy(AInstruction, 1, len - 2), StrToInt(AInstruction[len])); end; constructor TLensLibrary.Create; begin FHashMap := THashMap.Create; end; destructor TLensLibrary.Destroy; begin FHashMap.Free; inherited Destroy; end; procedure TLensLibrary.ProcessDataLine(const ALine: string); var split: TStringArray; s: string; begin split := ALine.Split(','); for s in split do begin Inc(FPart1, FHashMap.CalcHash(s)); ProcessInstruction(s); end; end; procedure TLensLibrary.Finish; begin FPart2 := FHashMap.CalcFocusingPower; end; function TLensLibrary.GetDataFileName: string; begin Result := 'lens_library.txt'; end; function TLensLibrary.GetPuzzleName: string; begin Result := 'Day 15: Lens Library'; end; end.