warrence/AdventOfCode2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Stefan Müller
2023-12-20 19:25:21 +01:00
committed by Stefan Müller
parent c3019613bd
commit b2bfbf1993
5 changed files with 447 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

226
solvers/UAplenty.pas
View File

@@ -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;
FThreshold: Integer;
FMatches: TIntervalSet;
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 := AMachinePart.Category[FCategory] < FThreshold
else
Result := AMachinePart.Category[FCategory] > FThreshold;
Result := FMatches.Contains(AMachinePart.Category[FCategory]);
end;
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
for search in FWorkflows do
if search.Name = effect.MoveDestinationName then
begin
effect.MoveDestination := search;
Break;
end;
CheckMoveDestination(effect);
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;

1
solvers/UGiveSeedFertilizer.pas
View File

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