Added solution for "Day 19: Aplenty", part 2

AdventOfCode.lpi

@@ -113,6 +113,10 @@
         <Filename Value="solvers\ULavaductLagoon.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="UIntervals.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

UIntervals.pas

@@ -0,0 +1,232 @@
+{
+  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 UIntervals;
+
+{$mode ObjFPC}{$H+}
+{$modeswitch AdvancedRecords+}
+
+interface
+
+uses
+  Classes, SysUtils, Generics.Collections, Math;
+
+type
+
+  { TInterval }
+
+  TInterval = record
+    Start, Length: Cardinal;
+    function GetLast: Cardinal;
+  end;
+
+  TIntervals = specialize TList<TInterval>;
+
+  { TIntervalSet }
+
+  TIntervalSet = class
+  private
+    FIntervals: TIntervals;
+    function GetCount: Cardinal;
+    procedure Intersect(const AInterval1, AInterval2: TInterval; out OIntersection: TInterval);
+    procedure Difference(const AInterval1, AInterval2: TInterval; out OBefore, OAfter: TInterval);
+  public
+    property Count: Cardinal read GetCount;
+    constructor Create;
+    constructor Create(constref AInterval: TInterval);
+    constructor Create(const AIntervals: TIntervals);
+    constructor Create(const AStart, ALength: Cardinal);
+    destructor Destroy; override;
+    function Contains(const AValue: Cardinal): Boolean;
+    function IsEmpty: Boolean;
+    function Intersect(const AOther: TIntervalSet): TIntervalSet;
+    function Difference(const AOther: TIntervalSet): TIntervalSet;
+    function Clone: TIntervalSet;
+  end;
+
+implementation
+
+{ TInterval }
+
+function TInterval.GetLast: Cardinal;
+begin
+  if Start <= Cardinal.MaxValue - Length + 1 then
+    Result := Start + Length - 1
+  else
+    Result := Cardinal.MaxValue;
+end;
+
+{ TIntervalSet }
+
+function TIntervalSet.GetCount: Cardinal;
+var
+  interval: TInterval;
+begin
+  Result := 0;
+  for interval in FIntervals do
+    Inc(Result, interval.Length);
+end;
+
+procedure TIntervalSet.Intersect(const AInterval1, AInterval2: TInterval; out OIntersection: TInterval);
+var
+  minLast: Cardinal;
+begin
+  minLast := Min(AInterval1.GetLast, AInterval2.GetLast);
+
+  if minLast >= Max(AInterval1.Start, AInterval2.Start) then
+  begin
+    OIntersection.Start := Max(AInterval1.Start, AInterval2.Start);
+    OIntersection.Length := minLast - OIntersection.Start + 1;
+  end
+  else begin
+    OIntersection.Start := 0;
+    OIntersection.Length := 0;
+  end;
+end;
+
+// Returns in OBefore the part of AInterval1 that lies before AInterval2, and in OAfter the part of AInterval1 that lies
+// after AInterval2. Either could be empty. OBefore + OAfter would be equivalent to AInterval1 - AInterval2.
+procedure TIntervalSet.Difference(const AInterval1, AInterval2: TInterval; out OBefore, OAfter: TInterval);
+var
+  last1, last2: Cardinal;
+begin
+    if AInterval2.Start > AInterval1.Start then
+    begin
+      OBefore.Start := AInterval1.Start;
+      OBefore.Length := Min(AInterval2.Start - AInterval1.Start, AInterval1.Length);
+    end
+    else begin
+      OBefore.Start := 0;
+      OBefore.Length := 0;
+    end;
+
+    last1 := AInterval1.GetLast;
+    last2 := AInterval2.GetLast;
+    if last1 > last2 then
+    begin
+      OAfter.Start := Max(last2 + 1, AInterval1.Start);
+      OAfter.Length := Min(last1 - last2, AInterval1.Length);
+    end
+    else begin
+      OAfter.Start := 0;
+      OAfter.Length := 0;
+    end;
+end;
+
+constructor TIntervalSet.Create;
+begin
+  FIntervals := TIntervals.Create;
+end;
+
+constructor TIntervalSet.Create(constref AInterval: TInterval);
+begin
+  Create;
+  if AInterval.Length > 0 then
+    FIntervals.Add(AInterval);
+end;
+
+constructor TIntervalSet.Create(const AIntervals: TIntervals);
+begin
+  Create;
+  FIntervals.AddRange(AIntervals);
+end;
+
+constructor TIntervalSet.Create(const AStart, ALength: Cardinal);
+var
+  interval: TInterval;
+begin
+  interval.Start := AStart;
+  interval.Length := ALength;
+  Create(interval);
+end;
+
+destructor TIntervalSet.Destroy;
+begin
+  FIntervals.Free;
+  inherited Destroy;
+end;
+
+function TIntervalSet.Contains(const AValue: Cardinal): Boolean;
+var
+  interval: TInterval;
+begin
+  Result := False;
+  for interval in FIntervals do
+    if (interval.Start <= AValue) and (AValue <= interval.GetLast) then
+    begin
+      Result := True;
+      Exit;
+    end;
+end;
+
+function TIntervalSet.IsEmpty: Boolean;
+begin
+  Result := FIntervals.Count = 0;
+end;
+
+function TIntervalSet.Intersect(const AOther: TIntervalSet): TIntervalSet;
+var
+  interval1, interval2, intersection: TInterval;
+begin
+  Result := TIntervalSet.Create;
+  for interval2 in AOther.FIntervals do
+    for interval1 in FIntervals do
+    begin
+      Intersect(interval1, interval2, intersection);
+      if intersection.Length > 0 then
+        Result.FIntervals.Add(intersection);
+    end;
+end;
+
+function TIntervalSet.Difference(const AOther: TIntervalSet): TIntervalSet;
+var
+  interval1, interval2, before, after: TInterval;
+  current, next, temp: TIntervals;
+begin
+  current := TIntervals.Create(FIntervals);
+  next := TIntervals.Create;
+  for interval2 in AOther.FIntervals do
+  begin
+    for interval1 in current do
+    begin
+      Difference(interval1, interval2, before, after);
+      if before.Length > 0 then
+        next.Add(before);
+      if after.Length > 0 then
+        next.Add(after);
+    end;
+    current.Clear;
+    temp := current;
+    current := next;
+    next := temp;
+  end;
+  Result := TIntervalSet.Create(current);
+  current.Free;
+  next.Free;
+end;
+
+function TIntervalSet.Clone: TIntervalSet;
+var
+  interval: TInterval;
+begin
+  Result := TIntervalSet.Create;
+  for interval in FIntervals do
+    Result.FIntervals.Add(interval);
+end;
+
+end.
+

solvers/UAplenty.pas

@@ -22,7 +22,7 @@ unit UAplenty;
 interface
 
 uses
-  Classes, SysUtils, Generics.Collections, USolver;
+  Classes, SysUtils, Generics.Collections, USolver, UIntervals;
 
 type
   TMachinePartCategory = (mpcExtremelyCoolLookingCategoryIndex, mpcMusicalCategoryIndex, mpcAerodynamicCategoryIndex,
@@ -40,6 +40,29 @@ type
     function CalcRating: Integer;
   end;
 
+  TWorkflowRuleEffect = class;
+
+  { TMultiMachinePart }
+
+  TMultiMachinePart = class
+  private
+    FCategories: array[TMachinePartCategory] of TIntervalSet;
+    FNextEffect: TWorkflowRuleEffect;
+    function GetCategory(const AIndex: TMachinePartCategory): TIntervalSet;
+  public
+    property Category[AIndex: TMachinePartCategory]: TIntervalSet read GetCategory;
+    property NextEffect: TWorkflowRuleEffect read FNextEffect write FNextEffect;
+    constructor CreateEmpty;
+    constructor Create;
+    destructor Destroy; override;
+    function IsEmpty: Boolean;
+    function CalcCombinations: Int64;
+    function Clone(const AReplaceCategory: TMachinePartCategory; const AReplaceCategoryValue: TIntervalSet):
+      TMultiMachinePart;
+  end;
+
+  TMultiMachineParts = specialize TObjectList<TMultiMachinePart>;
+
   TWorkflow = class;
 
   TWorkflowRuleEffectType = (wetAccept, wetReject, wetMove);
@@ -64,14 +87,15 @@ type
   TWorkflowRule = class
   private
     FCategory: TMachinePartCategory;
-    FLessThan: Boolean;
+    FMatches: TIntervalSet;
-    FThreshold: Integer;
     FEffect: TWorkflowRuleEffect;
   public
     property Effect: TWorkflowRuleEffect read FEffect;
     constructor Create(const ALine: string);
     destructor Destroy; override;
     function IsMatch(const AMachinePart: TMachinePart): Boolean;
+    function GetMatched(const AMultiMachinePart: TMultiMachinePart): TMultiMachinePart;
+    function GetUnmatched(const AMultiMachinePart: TMultiMachinePart): TMultiMachinePart;
   end;
 
   TWorkflowRules = specialize TObjectList<TWorkflowRule>;
@@ -88,6 +112,7 @@ type
     constructor Create(const ALine: string);
     destructor Destroy; override;
     function Process(const AMachinePart: TMachinePart): TWorkflowRuleEffect;
+    function Process(const AMultiMachinePart: TMultiMachinePart): TMultiMachineParts;
   end;
 
   TWorkflows = specialize TObjectList<TWorkflow>;
@@ -101,6 +126,8 @@ type
     FStart: TWorkflow;
     procedure ProcessWorkflowLine(const ALine: string);
     procedure ProcessMachinePartLine(const ALine: string);
+    function CalcAcceptedMachinePartCount: Int64;
+    procedure CheckMoveDestination(const AEffect: TWorkflowRuleEffect);
   public
     constructor Create;
     destructor Destroy; override;
@@ -116,6 +143,8 @@ const
   CRejected = 'R';
   CLessThanChar = '<';
   CStartWorkflowName = 'in';
+  CCategoryMinimum = 1;
+  CCategoryMaximum = 4000;
 
 implementation
 
@@ -146,6 +175,70 @@ begin
     Inc(Result, cat);
 end;
 
+{ TMultiMachinePart }
+
+function TMultiMachinePart.GetCategory(const AIndex: TMachinePartCategory): TIntervalSet;
+begin
+  Result := FCategories[AIndex];
+end;
+
+constructor TMultiMachinePart.CreateEmpty;
+begin
+
+end;
+
+constructor TMultiMachinePart.Create;
+var
+  cat: TMachinePartCategory;
+begin
+  for cat in TMachinePartCategory do
+    FCategories[cat] := TIntervalSet.Create(CCategoryMinimum, CCategoryMaximum - CCategoryMinimum + 1);
+end;
+
+destructor TMultiMachinePart.Destroy;
+var
+  cat: TMachinePartCategory;
+begin
+  for cat in TMachinePartCategory do
+    FCategories[cat].Free;
+  inherited Destroy;
+end;
+
+function TMultiMachinePart.IsEmpty: Boolean;
+var
+  cat: TIntervalSet;
+begin
+  Result := False;
+  for cat in FCategories do
+    if cat.IsEmpty then
+    begin
+      Result := True;
+      Exit;
+    end;
+end;
+
+function TMultiMachinePart.CalcCombinations: Int64;
+var
+  cat: TIntervalSet;
+begin
+  Result := 1;
+  for cat in FCategories do
+    Result := Result * cat.Count;
+end;
+
+function TMultiMachinePart.Clone(const AReplaceCategory: TMachinePartCategory; const AReplaceCategoryValue:
+  TIntervalSet): TMultiMachinePart;
+var
+  cat: TMachinePartCategory;
+begin
+  Result := TMultiMachinePart.CreateEmpty;
+  for cat in TMachinePartCategory do
+    if cat = AReplaceCategory then
+      Result.FCategories[cat] := AReplaceCategoryValue
+    else
+      Result.FCategories[cat] := FCategories[cat].Clone;
+end;
+
 { TWorkflowRuleEffect }
 
 constructor TWorkflowRuleEffect.Create(const ALine: string);
@@ -171,6 +264,7 @@ end;
 constructor TWorkflowRule.Create(const ALine: string);
 var
   split: TStringArray;
+  threshold: Cardinal;
 begin
   case ALine[1] of
     'x': FCategory := mpcExtremelyCoolLookingCategoryIndex;
@@ -178,25 +272,44 @@ begin
     'a': FCategory := mpcAerodynamicCategoryIndex;
     's': FCategory := mpcShinyCategoryIndex;
   end;
-  FLessThan := Aline[2] = CLessThanChar;
 
   split := ALine.Split(':');
-  FThreshold := StrToInt(Copy(split[0], 3, Length(split[0]) - 2));
+  threshold := StrToInt(Copy(split[0], 3, Length(split[0]) - 2));
+  if Aline[2] = CLessThanChar then
+    FMatches := TIntervalSet.Create(CCategoryMinimum, threshold - 1)
+  else
+    FMatches := TIntervalSet.Create(threshold + 1, CCategoryMaximum - threshold);
+
   FEffect := TWorkflowRuleEffect.Create(split[1]);
 end;
 
 destructor TWorkflowRule.Destroy;
 begin
   FEffect.Free;
+  FMatches.Free;
   inherited Destroy;
 end;
 
 function TWorkflowRule.IsMatch(const AMachinePart: TMachinePart): Boolean;
 begin
-  if FLessThan then
+  Result := FMatches.Contains(AMachinePart.Category[FCategory]);
-    Result := AMachinePart.Category[FCategory] < FThreshold
+end;
-  else
+
-    Result := AMachinePart.Category[FCategory] > FThreshold;
+function TWorkflowRule.GetMatched(const AMultiMachinePart: TMultiMachinePart): TMultiMachinePart;
+var
+  new: TIntervalSet;
+begin
+  new := AMultiMachinePart.Category[FCategory].Intersect(FMatches);
+  Result := AMultiMachinePart.Clone(FCategory, new);
+  Result.NextEffect := FEffect;
+end;
+
+function TWorkflowRule.GetUnmatched(const AMultiMachinePart: TMultiMachinePart): TMultiMachinePart;
+var
+  new: TIntervalSet;
+begin
+  new := AMultiMachinePart.Category[FCategory].Difference(FMatches);
+  Result := AMultiMachinePart.Clone(FCategory, new);
 end;
 
 { TWorkflow }
@@ -240,6 +353,42 @@ begin
   Result := FLastEffect;
 end;
 
+function TWorkflow.Process(const AMultiMachinePart: TMultiMachinePart): TMultiMachineParts;
+var
+  rule: TWorkflowRule;
+  current, new: TMultiMachinePart;
+begin
+  Result := TMultiMachineParts.Create(False);
+  current := AMultiMachinePart;
+  for rule in FRules do
+  begin
+    if rule.Effect.EffectType <> wetReject then
+    begin
+      new := rule.GetMatched(current);
+      if new.IsEmpty then
+        new.Free
+      else
+        Result.Add(new);
+    end;
+    new := rule.GetUnmatched(current);
+    current.Free;
+    if new.IsEmpty then
+    begin
+      new.Free;
+      Exit;
+    end
+    else
+      current := new;
+  end;
+  if FLastEffect.EffectType <> wetReject then
+  begin
+    current.NextEffect := FLastEffect;
+    Result.Add(current);
+  end
+  else
+    current.Free;
+end;
+
 { TAplenty }
 
 procedure TAplenty.ProcessWorkflowLine(const ALine: string);
@@ -255,7 +404,7 @@ end;
 procedure TAplenty.ProcessMachinePartLine(const ALine: string);
 var
   part: TMachinePart;
-  workflow, search: TWorkflow;
+  workflow: TWorkflow;
   effect: TWorkflowRuleEffect;
 begin
   part := TMachinePart.Create(ALine);
@@ -264,13 +413,7 @@ begin
     effect := workflow.Process(part);
     if effect.EffectType = wetMove then
     begin
-      if effect.MoveDestination = nil then
+      CheckMoveDestination(effect);
-        for search in FWorkflows do
-          if search.Name = effect.MoveDestinationName then
-          begin
-            effect.MoveDestination := search;
-            Break;
-          end;
       workflow := effect.MoveDestination;
     end;
   until effect.EffectType <> wetMove;
@@ -280,6 +423,53 @@ begin
   part.Free;
 end;
 
+function TAplenty.CalcAcceptedMachinePartCount: Int64;
+var
+  part: TMultiMachinePart;
+  parts: TMultiMachineParts;
+  stack: specialize TStack<TMultiMachinePart>;
+  workflow: TWorkflow;
+begin
+  Result := 0;
+  stack := specialize TStack<TMultiMachinePart>.Create;
+  stack.Push(TMultiMachinePart.Create);
+
+  repeat
+    part := stack.Pop;
+    if part.NextEffect = nil then
+      workflow := FStart
+    else begin
+      CheckMoveDestination(part.NextEffect);
+      workflow := part.NextEffect.MoveDestination;
+    end;
+    parts := workflow.Process(part);
+    for part in parts do
+      if part.NextEffect.EffectType = wetAccept then
+      begin
+        Inc(Result, part.CalcCombinations);
+        part.Free;
+      end
+      else
+        stack.Push(part);
+    parts.Free;
+  until stack.Count = 0;
+
+  stack.Free;
+end;
+
+procedure TAplenty.CheckMoveDestination(const AEffect: TWorkflowRuleEffect);
+var
+  destination: TWorkflow;
+begin
+  if AEffect.MoveDestination = nil then
+    for destination in FWorkflows do
+      if destination.Name = AEffect.MoveDestinationName then
+      begin
+        AEffect.MoveDestination := destination;
+        Break;
+      end;
+end;
+
 constructor TAplenty.Create;
 begin
   FWorkflows := TWorkflows.Create;
@@ -309,7 +499,7 @@ end;
 
 procedure TAplenty.Finish;
 begin
-
+  FPart2 := CalcAcceptedMachinePartCount;
 end;
 
 function TAplenty.GetDataFileName: string;

solvers/UGiveSeedFertilizer.pas

@@ -29,6 +29,7 @@ type
 
   { TValueRange }
 
+  // TODO: Use TIntervalSet instead.
   TValueRange = record
     Part: Integer;
     Start, Length: Cardinal;

tests/UAplentyTestCases.pas

@@ -62,7 +62,7 @@ end;
 
 procedure TAplentyFullDataTestCase.TestPart2;
 begin
-  AssertEquals(-1, FSolver.GetResultPart2);
+  AssertEquals(121464316215623, FSolver.GetResultPart2);
 end;
 
 { TAplentyExampleTestCase }
@@ -79,7 +79,7 @@ end;
 
 procedure TAplentyExampleTestCase.TestPart2;
 begin
-  AssertEquals(-1, FSolver.GetResultPart2);
+  AssertEquals(167409079868000, FSolver.GetResultPart2);
 end;
 
 initialization