AdventOfCode2023/solvers/ULensLibrary.pas

{
  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 <http://www.gnu.org/licenses/>.
}

unit ULensLibrary;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Generics.Collections, USolver;

type

  { TLens }

  TLens = record
    Key: string;
    FocalLength: Byte;
  end;

  TBoxContent = specialize TList<TLens>;

  TBoxes = specialize TObjectList<TBoxContent>;

  { 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.