Solve day 7 part 2

1 files changed, 28 insertions, 0 deletions

diff --git a/2023/day07.pl b/2023/day07.pl
index aa36965..d65dda1 100644
--- a/2023/day07.pl
+++ b/2023/day07.pl
@@ -1,5 +1,6 @@
 use strict;
 use warnings;
+use List::Util qw(max);
 sub handType {
 	my $hand = join("", sort(split(//, shift)));
 	return 7 if $hand =~ /(.)\g1{4}/;
@@ -10,10 +11,22 @@ sub handType {
 	return 2 if $hand =~ /(.)\g1/;
 	return 1;
 }
+sub handType2 {
+	my $hand = shift;
+	max(map {
+		my $h = $hand;
+		$h =~ s/J/$_/g;
+		handType($h);
+	} qw(A K Q T 9 8 7 6 5 4 3 2));
+}
 sub handRanks {
 	my %ranks = (T => 10, J => 11, Q => 12, K => 13, A => 14);
 	map { $ranks{$_} // $_ } split(//, shift);
 }
+sub handRanks2 {
+	my %ranks = (T => 10, J => 1, Q => 12, K => 13, A => 14);
+	map { $ranks{$_} // $_ } split(//, shift);
+}
 sub handSort {
 	my $aType = handType($a);
 	my $bType = handType($b);
@@ -23,6 +36,15 @@ sub handSort {
 	$aRanks[1] <=> $bRanks[1] || $aRanks[2] <=> $bRanks[2] ||
 	$aRanks[3] <=> $bRanks[3] || $aRanks[4] <=> $bRanks[4];
 }
+sub handSort2 {
+	my $aType = handType2($a);
+	my $bType = handType2($b);
+	my @aRanks = handRanks2($a);
+	my @bRanks = handRanks2($b);
+	$aType <=> $bType || $aRanks[0] <=> $bRanks[0] ||
+	$aRanks[1] <=> $bRanks[1] || $aRanks[2] <=> $bRanks[2] ||
+	$aRanks[3] <=> $bRanks[3] || $aRanks[4] <=> $bRanks[4];
+}
 my (@hands, %bids);
 while (<>) {
 	my ($hand, $bid) = split(/ /);
@@ -35,3 +57,9 @@ for (0 .. $#ranked) {
 	$winnings += (1 + $_) * $bids{$ranked[$_]};
 }
 print $winnings, "\n";
+$winnings = 0;
+@ranked = sort handSort2 @hands;
+for (0 .. $#ranked) {
+	$winnings += (1 + $_) * $bids{$ranked[$_]};
+}
+print $winnings, "\n";