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

{$mode ObjFPC}{$H+}

interface

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

type
  TCardHandType = (htHighCard, htOnePair, htTwoPair, htThreeOfAKind, htFullHouse, htFourOfAKind, htFiveOfAKind);

  TCardCounter = record
    Card: Char;
    Count: Integer;
  end;

  TCardCounters = specialize TList<TCardCounter>;

  { TCardHand }

  TCardHand = class
  private
    FHand: string;
    FType, FJokerType: TCardHandType;
    FBid: Cardinal;
    procedure CalcCountersFromHand(constref counters: TCardCounters);
    function CalcTypeFromCounters(constref counters: TCardCounters): TCardHandType;
    function CalcJokerTypeFromCounters(constref counters: TCardCounters): TCardHandType;
  public
    constructor Create(const ALine: string);
    property Bid: Cardinal read FBid;
  end;

  TCardHands = specialize TObjectList<TCardHand>;

  { TCardHandComparer }

  TCardHandComparer = class(TInterfacedObject, specialize IComparer<TCardHand>)
  protected
    function CompareCardValue(constref AHand1, AHand2: TCardHand): Integer;
    function GetCardValue(const ACard: Char): Cardinal; virtual;
  public
    function Compare(constref AHand1, AHand2: TCardHand): Integer; virtual;
  end;

  { TJokerCardHandComparer }

  TJokerCardHandComparer = class(TCardHandComparer)
  protected
    function GetCardValue(const ACard: Char): Cardinal; override;
  public
    function Compare(constref AHand1, AHand2: TCardHand): Integer; override;
  end;

  { TCamelCards }

  TCamelCards = class(TSolver)
  private
    FHands: TCardHands;
  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

{ TCardHand }

procedure TCardHand.CalcCountersFromHand(constref counters: TCardCounters);
var
  counter: TCardCounter;
  i: Integer;
  c: Char;
  found: Boolean;
begin
  counters.Clear;

  // Creates a counter for each different card value and counts cards per card value.
  for c in FHand do
  begin
    found := False;
    i := 0;
    while not found and (i < counters.Count) do
    begin
      if counters[i].Card = c then
      begin
        found := True;
        counter := counters[i];
        Inc(counter.Count);
        counters[i] := counter;
      end;
      Inc(i);
    end;

    if not found then
    begin
      counter.Card := c;
      counter.Count := 1;
      counters.Add(counter);
    end;
  end;
end;

function TCardHand.CalcTypeFromCounters(constref counters: TCardCounters): TCardHandType;
begin
  // Determines the hand type from the counters.
  case counters.Count of
    1: Result := htFiveOfAKind;
    2:
      if (counters[0].Count = 4) or (counters[1].Count = 4) then
        Result := htFourOfAKind
      else
        Result := htFullHouse;
    3:
      if (counters[0].Count = 3) or (counters[1].Count = 3) or (counters[2].Count = 3) then
        Result := htThreeOfAKind
      else
        Result := htTwoPair;
    4: Result := htOnePair;
    5: Result := htHighCard;
  end;
end;

function TCardHand.CalcJokerTypeFromCounters(constref counters: TCardCounters): TCardHandType;
var
  i, maxCount, maxCountIndex, jokerIndex: Integer;
  jokerCounter, counter: TCardCounter;
begin
  if counters.Count > 1 then
  begin
    // Finds Jokers and the best card value.
    maxCount := 0;
    jokerIndex := -1;
    for i := 0 to counters.Count - 1 do
    begin
      if counters[i].Card = 'J' then
      begin
        jokerIndex := i;
        jokerCounter := counters[i];
      end
      else if maxCount < counters[i].Count then
      begin
        maxCount := counters[i].Count;
        maxCountIndex := i;
      end;
    end;

    // Uses Jokers for the best card value.
    if jokerIndex >= 0 then
    begin
      counter := counters[maxCountIndex];
      Inc(counter.Count, jokerCounter.Count);
      counters[maxCountIndex] := counter;
      counters.Delete(jokerIndex);
    end;
  end;

  Result := CalcTypeFromCounters(counters);
end;

constructor TCardHand.Create(const ALine: string);
var
  split: TStringArray;
  counters: TCardCounters;
begin
  split := ALine.Split(' ');
  FHand := split[0];
  FBid := StrToDWord(split[1]);

  counters := TCardCounters.Create;
  CalcCountersFromHand(counters);
  FType := CalcTypeFromCounters(counters);
  FJokerType := CalcJokerTypeFromCounters(counters);
  counters.Free;
end;

{ TCardHandComparer }

function TCardHandComparer.CompareCardValue(constref AHand1, AHand2: TCardHand): Integer;
var
  i: Integer;
begin
  Result := 0;
  i := 1;
  while (Result = 0) and (i <= AHand1.FHand.Length) do
  begin
    Result := GetCardValue(AHand1.FHand[i]) - GetCardValue(AHand2.FHand[i]);
    Inc(i);
  end;
end;

function TCardHandComparer.GetCardValue(const ACard: Char): Cardinal;
begin
  if not TryStrToDWord(ACard, Result) then
    case ACard of
      'A': Result := 14;
      'K': Result := 13;
      'Q': Result := 12;
      'J': Result := 11;
      'T': Result := 10;
      else Result := 0;
    end;
end;

function TCardHandComparer.Compare(constref AHand1, AHand2: TCardHand): Integer;
begin
  Result := Ord(AHand1.FType) - Ord(AHand2.FType);
  if Result = 0 then
    Result := CompareCardValue(AHand1, AHand2);
end;

{ TJokerCardHandComparer }

function TJokerCardHandComparer.GetCardValue(const ACard: Char): Cardinal;
begin
  if ACard = 'J' then
    Result := 1
  else
    Result := inherited GetCardValue(ACard);
end;

function TJokerCardHandComparer.Compare(constref AHand1, AHand2: TCardHand): Integer;
begin
  Result := Ord(AHand1.FJokerType) - Ord(AHand2.FJokerType);
  if Result = 0 then
    Result := CompareCardValue(AHand1, AHand2);
end;

{ TCamelCards }

constructor TCamelCards.Create;
begin
  FHands := TCardHands.Create;
end;

destructor TCamelCards.Destroy;
begin
  FHands.Free;
  inherited Destroy;
end;

procedure TCamelCards.ProcessDataLine(const ALine: string);
begin
  FHands.Add(TCardHand.Create(ALine));
end;

procedure TCamelCards.Finish;
var
  comparer: TCardHandComparer;
  jokerComparer: TJokerCardHandComparer;
  i: Integer;
begin
  comparer := TCardHandComparer.Create;
  FHands.Sort(comparer);
  comparer.Free;

  for i := 0 to FHands.Count - 1 do
    Inc(FPart1, FHands[i].Bid * (i + 1));

  jokerComparer := TJokerCardHandComparer.Create;
  FHands.Sort(jokerComparer);
  jokerComparer.Free;

  for i := 0 to FHands.Count - 1 do
    Inc(FPart2, FHands[i].Bid * (i + 1));
end;

function TCamelCards.GetDataFileName: string;
begin
  Result := 'camel_cards.txt';
end;

function TCamelCards.GetPuzzleName: string;
begin
  Result := 'Day 7: Camel Cards';
end;

end.