AdventOfCode2023/solvers/UGiveSeedFertilizer.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 UGiveSeedFertilizer;

{$mode ObjFPC}{$H+}
{$modeswitch AdvancedRecords+}

interface

uses
  Classes, SysUtils, Generics.Collections, Math, USolver;

type

  { TValueRange }

  // TODO: Use TIntervalSet instead.
  TValueRange = record
    Part: Integer;
    Start, Length: Cardinal;
    class operator = (Left, Right : TValueRange): Boolean;
  end;

  TValueRanges = specialize TList<TValueRange>;

  { TAlmanacMapRange }

  TAlmanacMapRange = class
  private
    FDestinationStart, FSourceStart, FSourceLast, FLength, FDifference1, FDifference2: Cardinal;
  public
    constructor Create(const ALine: string);
    constructor Create(const ADestinationStart, ASourceStart, ALength: Cardinal);
    procedure TryConvert(const AInput: TValueRange; const AUnconverted, AConverted: TValueRanges);
  end;

  { TGiveSeedFertilizer }

  TGiveSeedFertilizer = class(TSolver)
  private
    FNew, FUnconverted, FConverted: TValueRanges;
    procedure ProcessSeeds(const ALine: string);
    procedure ProcessMapRange(const ALine: string);
    procedure FinishMap;
  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

{ TValueRange }

class operator TValueRange. = (Left, Right: TValueRange): Boolean;
begin
  Result := (Left.Part = Right.Part) and (Left.Start = Right.Start) and (Left.Length = Right.Length);
end;

{ TAlmanacMapRange }

constructor TAlmanacMapRange.Create(const ALine: string);
var
  split: TStringArray;
begin
  split := ALine.Split(' ');
  Create(StrToDWord(split[0]), StrToDWord(split[1]), StrToDWord(split[2]));
end;

constructor TAlmanacMapRange.Create(const ADestinationStart, ASourceStart, ALength: Cardinal);
begin
  FDestinationStart := ADestinationStart;
  FSourceStart := ASourceStart;
  FLength := ALength;

  // All input values are within Cardinal range, but the calculation results might not be.
  if ASourceStart <= Cardinal.MaxValue - ALength + 1 then
    FSourceLast := ASourceStart + ALength - 1
  else
    FSourceLast := Cardinal.MaxValue;

  if ADestinationStart >= ASourceStart then
  begin
    FDifference1 := ADestinationStart - ASourceStart;
    FDifference2 := 0;
  end
  else begin
    FDifference1 := 0;
    FDifference2 := ASourceStart - ADestinationStart;
  end;
end;

procedure TAlmanacMapRange.TryConvert(const AInput: TValueRange; const AUnconverted, AConverted: TValueRanges);
var
  inputLast: Cardinal;
  splitValue: TValueRange;
begin
  if AInput.Start <= Cardinal.MaxValue - AInput.Length + 1 then
    inputLast := AInput.Start + AInput.Length - 1
  else
    inputLast := Cardinal.MaxValue;

  splitValue.Part := AInput.Part;

  // Converts the convertible part of the value range, if any.
  if Min(FSourceLast, inputLast) >= Max(FSourceStart, AInput.Start) then
  begin
    splitValue.Start := Max(FSourceStart, AInput.Start);
    splitValue.Length := Min(FSourceLast, inputLast) - splitValue.Start + 1;
    if FDifference1 > 0 then
      Inc(splitValue.Start, FDifference1)
    else
      Dec(splitValue.Start, FDifference2);
    AConverted.Add(splitValue);
  end;

  // Splits off the part before the convertible part, if any.
  if FSourceStart > AInput.Start then
  begin
    splitValue.Start := AInput.Start;
    splitValue.Length := Min(FSourceStart - AInput.Start, AInput.Length);
    AUnconverted.Add(splitValue);
  end;

  // Splits off the part after the convertible part, if any.
  if inputLast > FSourceLast then
  begin
    splitValue.Start := Max(FSourceLast + 1, AInput.Start);
    splitValue.Length := Min(inputLast - FSourceLast, AInput.Length);
    AUnconverted.Add(splitValue);
  end;
end;

{ TGiveSeedFertilizer }

procedure TGiveSeedFertilizer.ProcessSeeds(const ALine: string);
var
  split: TStringArray;
  i: Integer;
  value: TValueRange;
begin
  split := Aline.Split(' ');
  for i := 1 to Length(split) div 2 do
  begin
    // Adds values for part 1.
    value.Part := 1;
    value.Length := 1;
    value.Start := StrToDWord(split[2 * i - 1]);
    FNew.Add(value);
    value.Start := StrToDWord(split[2 * i]);
    FNew.Add(value);

    // Adds values for part 2.
    value.Part := 2;
    value.Start := StrToDWord(split[2 * i - 1]);
    value.Length := StrToDWord(split[2 * i]);
    FNew.Add(value);
  end;
end;

procedure TGiveSeedFertilizer.ProcessMapRange(const ALine: string);
var
  range: TAlmanacMapRange;
  value: TValueRange;
  temp: TValueRanges;
begin
  // Tries to convert all value ranges that have not yet been converted by the current map.
  range := TAlmanacMapRange.Create(ALine);
  for value in FNew do
  begin
    range.TryConvert(value, FUnconverted, FConverted);
  end;
  range.Free;

  // Discards all new and moves unconverted back as new.
  FNew.Clear;
  temp := FNew;
  FNew := FUnconverted;
  FUnconverted := temp;
end;

procedure TGiveSeedFertilizer.FinishMap;
var
  value: TValueRange;
begin
  // Resets the lists for the next map, remaining values stay unconverted.
  for value in FConverted do
  begin
    FNew.Add(value);
  end;
  FConverted.Clear;
end;

constructor TGiveSeedFertilizer.Create;
begin
  FNew := TValueRanges.Create;
  FUnconverted := TValueRanges.Create;
  FConverted := TValueRanges.Create;
end;

destructor TGiveSeedFertilizer.Destroy;
begin
  FNew.Free;
  FUnconverted.Free;
  FConverted.Free;
  inherited Destroy;
end;

procedure TGiveSeedFertilizer.ProcessDataLine(const ALine: string);
begin
  if LeftStr(ALine, 6) = 'seeds:' then
    ProcessSeeds(ALine)
  else if RightStr(ALine, 4) = 'map:' then
    FinishMap
  else if Aline <> '' then
    ProcessMapRange(ALine);
end;

procedure TGiveSeedFertilizer.Finish;
var
  value: TValueRange;
begin
  FinishMap;
  for value in FNew do
  begin
    if value.Part = 1 then
    begin
      if (FPart1 = 0) or (value.Start < FPart1) then
        FPart1 := value.Start;
    end
    else begin
      if (FPart2 = 0) or (value.Start < FPart2) then
        FPart2 := value.Start;
    end;
  end;
end;

function TGiveSeedFertilizer.GetDataFileName: string;
begin
  Result := 'if_you_give_a_seed_a_fertilizer.txt';
end;

function TGiveSeedFertilizer.GetPuzzleName: string;
begin
  Result := 'Day 5: If You Give A Seed A Fertilizer';
end;

end.