Perl Weekly Challenge 291.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 291.

Task 1: Middle Index

Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.

Write a script to find the leftmost middle index (MI) i.e. the smallest amongst all
the possible ones.

A middle index is an index where ints[0] + ints[1] + … + ints[MI-1] == ints[MI+1] +
ints[MI+2] + … + ints[ints.length-1].

If MI == 0, the left side sum is considered to be 0. Similarly,
if MI == ints.length - 1, the right side sum is considered to be 0.
Return the leftmost MI that satisfies the condition, or -1 if there is no such index.

Example 1
Input: @ints = (2, 3, -1, 8, 4)
Output: 3

The sum of the numbers before index 3 is: 2 + 3 + -1 = 4
The sum of the numbers after index 3 is: 4 = 4
Example 2
Input: @ints = (1, -1, 4)
Output: 2

The sum of the numbers before index 2 is: 1 + -1 = 0
The sum of the numbers after index 2 is: 0
Example 3
Input: @ints = (2, 5)
Output: -1

There is no valid MI.

I can initialize a left and a right sum, and as I scan the array subtract the current element from the right sum and add the previous to the left sum. This yields a one-liner.

Example 1:

perl -MList::Util=sum0 -E '
@i=@ARGV;$l=0;$r=sum0@i;$c=0;{$c=-1,last if$c==@i;$r-=$i[$c];last if$r==$l;$l+=$i[$c++];redo}say"@i->$c";
'  2 3 -1 8 4

Results:

2 3 -1 8 4 -> 3

I used a curious loop construction with a block and redo to simplify the logic.

Example 2:

perl -MList::Util=sum0 -E '
@i=@ARGV;$l=0;$r=sum0@i;$c=0;{$c=-1,last if$c==@i;$r-=$i[$c];last if$r==$l;$l+=$i[$c++];redo}say"@i->$c";
'  1 -1 4

Results:

1 -1 4 -> 2

Example 3:

perl -MList::Util=sum0 -E '
@i=@ARGV;$l=0;$r=sum0@i;$c=0;{$c=-1,last if$c==@i;$r-=$i[$c];last if$r==$l;$l+=$i[$c++];redo}say"@i->$c";
'  2 5

Results:

2 5 -> -1

The full code is:

 1  # Perl weekly challenge 291
 2  # Task 1:  Middle Index
 3  #
 4  # See https://wlmb.github.io/2024/10/14/PWC291/#task-1-middle-index
 5  use v5.36;
 6  use List::Util qw(sum0);
 7  say <<~"FIN" unless @ARGV;
 8      Usage: $0 N0 N1...
 9      to find the middle index of the array of numbers N0, N1...
10      FIN
11  my $left=0;
12  my $right=sum0(@ARGV);
13  my $current=0;
14  while(1){
15      $current = -1, last if $current==@ARGV;
16      $right -= $ARGV[$current];
17      last if $right == $left;
18      $left += $ARGV[$current++];
19  }
20  say "@ARGV -> $current";

Examples:

./ch-1.pl 2 3 -1 8 4
./ch-1.pl 1 -1 4
./ch-1.pl 2 5

Results:

2 3 -1 8 4 -> 3
1 -1 4 -> 2
2 5 -> -1
2 -> 0

Task 2: Poker Hand Rankings

Submitted by: Robbie Hatley
A draw poker hand consists of 5 cards, drawn from a pack of 52: no jokers, no wild cards.
An ace can rank either high or low.

Write a script to determine the following three things:

1. How many different 5-card hands can be dealt?
2. How many different hands of each of the 10 ranks can be dealt?
   See here for descriptions of the 10 ranks of Poker hands:
   https://en.wikipedia.org/wiki/List_of_poker_hands#Hand-ranking_categories
3. Check the ten numbers you get in step 2 by adding them together
   and showing that they're equal to the number you get in step 1.

The number of 5 cards that can be dealt is the number of combinations of 52 taken 5 at a time, i.e. 52!/((52-5)!5!=2598960.

To count the number of possible hands, I first make a dumb program to test all combinations of cards and classify them and count them according to their hand:

 1  # Perl weekly challenge 291
 2  # Task 2:  Poker Hand Rankings
 3  #
 4  # See https://wlmb.github.io/2024/10/14/PWC291/#task-2-poker-hand-rankings
 5  use v5.36;
 6  use Algorithm::Combinatorics qw(combinations);
 7  use List::Util qw(any all sum);
 8  my @cards=map {my $x=$_; map {[$x, $_]}('a'..'d')}(1..13);
 9  my $iter=combinations([@cards],5);
10  my $count=0;
11  my $fiveofakind=0;
12  my $straightflush=0;
13  my $fourofakind=0;
14  my $fullhouse=0;
15  my $flush=0;
16  my $straight=0;
17  my $threeofakind=0;
18  my $twopair=0;
19  my $onepair=0;
20  my $highcard=0;
21  while(my $hand=$iter->next){
22      my %ranks;
23      my %suits;
24      $ranks{$_}++ for map {$_->[0]} @$hand;
25      $suits{$_}++ for map {$_->[1]} @$hand;
26      my @ranks=sort{$a<=>$b}keys %ranks;
27      my @suits=keys %suits;
28      my %counts;
29      $counts{$_}++ for map {$_->[0]} @$hand;
30      my @counts=values %counts;
31      ++$count;
32      ++$fiveofakind, next if fiveofakind(\@ranks, \@suits);
33      ++$straightflush, next if straightflush(\@ranks, \@suits);
34      ++$fourofakind, next if fourofakind(\@counts);
35      ++$fullhouse, next if fullhouse(\@counts);
36      ++$flush, next if flush(\@suits);
37      ++$straight, next if straight(\@ranks);
38      ++$threeofakind, next if threeofakind(\@counts);
39      ++$twopair, next if twopair(\@counts);
40      ++$onepair, next if onepair(\@counts);
41      ++$highcard, next if highcard();
42  }
43  say "Five of a kind: $fiveofakind";
44  say "Straightflush: $straightflush";
45  say "Four of a kind: $fourofakind";
46  say "Full house: $fullhouse";
47  say "Flush: $flush";
48  say "Straight: $straight";
49  say "Three of a kind: $threeofakind";
50  say "Two pair: $twopair";
51  say "One pair: $onepair";
52  say "High card: $highcard";
53  say "Total: $count";
54  say "Sum: ", sum ($fiveofakind, $straightflush, $fourofakind, $fullhouse, $flush, $straight,
55      $threeofakind, $twopair, $onepair, $highcard);
56  sub fiveofakind($ranks, $suits){
57      return @$ranks==1 && @$suits==1;
58  }
59  sub straightflush($ranks, $suits){
60      return 0 unless @$suits==1;
61      return 1 if $ranks->[0]==1 && $ranks->[1]==10;
62      return 1 if $ranks->[-1]-$ranks->[0]==4;
63      return 0;
64  }
65  sub fourofakind($counts){
66      return any {$_==4} @$counts;
67  }
68  sub fullhouse($counts){
69      return all {$_==3 || $_==2} @$counts;
70  }
71  sub flush($suits){
72      return @$suits==1;
73  }
74  sub straight($ranks){
75      return 0 unless @$ranks==5;
76      my @diffs=map{$ranks->[$_+1]-$ranks->[$_]} 0..3;
77      return  "@diffs" eq "1 1 1 1" || "@diffs" eq "9 1 1 1";
78  }
79  sub threeofakind($counts){
80      return any {$_==3} @$counts;
81  }
82  sub twopair($counts){
83      my @pairs=grep{$_==2}@$counts;
84      return @pairs==2;
85  }
86  sub onepair($counts){
87      my @pairs=grep{$_==2}@$counts;
88      return @pairs==1;
89  }
90  sub highcard(){
91      return 1;
92  }

I run it:

./ch-2.pl

Results:

Five of a kind: 0
Straightflush: 40
Four of a kind: 624
Full house: 3744
Flush: 5108
Straight: 10200
Three of a kind: 54912
Two pair: 123552
One pair: 1098240
High card: 1302540
Total: 2598960
Sum: 2598960

The run took about half a minute in my old laptop.

Now I can think a little bit and try to understand the results above. The 10 ranks are

  1. Five of a kind: impossible with no wild cards.
  2. Straight flush: All cards are determined by the lowest one, which can be in the range 1 to 14-5+1=10, i.e., 10 numbers, 4 kinds, 10*4 possibilities (An ace can be at the beggining or at the end of a sequence).
  3. Four of a kind: There are 13 kinds and the fifth card can be any of the remaining 52-4 cards, 13*48 possibilities.
  4. Full house: three cards of one rank and two cards of another. The kind of the three cards can be any of the 13 possible ranks, and the missing suit any of the 4 suits. The other rank is any of the 12 remaining and the two suits can be chosen as any of the 4!/(2! 2!)=6 combinations of four taken two at a time. Thus there are 13*4*12*6 full houses.
  5. Flush: five cards of the same suit not all sequential. There are 4 suits. There are 13!/((13-5)! 5!) combinations of 13 ranks of a given suit taken 5 at a time, from which we have to remove the 14-5+1=10 sequential choices, yielding 4*(13!/(8! 5!)-10) possible flushes.
  6. Straight: five sequential cards not all of the same suit. There are 14-5+1=10 contiguous subsequences of length 5 taken from the set 1-14. Each card can be of any of 4 suits, yielding 10*45 ordered continuous sequences of cards. From those, we should subtract the 40 straight flushes, so there are 10*45-40 straights.
  7. Three of a kind: three cards of one rank and two cards of different ranks. There are 13 cards and 4 choices for the missing suit, yielding 13*4 ways of choosing three cards of equal rank. There are 4*12 ways to choose the first of the other cards and 4*11 ways to choose the other. I arbitrarily order the suits and assume that the first pair has a lower suit than the second, thus dividing the number of combinations by 2. Thus there are 13*12*11*43/2 combinations.
  8. Two pairs: Two cards of one rank, two cards of another and a third card of still another. There are 13 possible ranks for the first pair, and 4!/(2! 2!)=6 choices for their suits. There are 12 possible ranks for the second pair and 6 choices for their suits, and there are 11 remaining ranks and 4 suits for the last card. Assuming the first pair has a lower rank than the second, I must divide the result by two, yielding 13*6*12*6*11*4/2.
  9. One pair: The pair can be of any of the 13 ranks and any of the six pairs of suits. The remaining three cards should be a combination of the remaining 12 ranks and any combination of 4 suites (including repetitions), thus there are 13*6*12!/(9!3!)*43.
  10. High card: None of the above. Each card should have a different rank than the others. There should be no contiguous sequences and at least one card should have a different suit. So I take the combinations of 13 taken 5 at a time, 13!/(8!5!). Remove the 10 combinations that are consecutive sequences. Multiply by all possible choices of suits 45 but removing first the 4 cases where all suites are equal (45-4). (13!/(8! 5!)-10)(45-4).

I make a small program to compute these quantities. The result fits a three-liner:

perl -MList::Util=product,sum -E '
@r=(0,10*4, 13*(52-4),13*4*12*6, 4*(f(13)/f(8)/f(5)-10), 10*4**5-40, 13*12*11*4**3/2,13*6*12*6*11*4/2,
13*6*f(12)/f(9)/f(3)*4**3,(f(13)/f(8)/f(5)-10)*(4**5-4)); say $_+1,": $r[$_]" for 0..@r-1;
say "Sum: ",sum(@r), ", expected: ",f(52)/f(52-5)/f(5); sub f($n){product(1..$n)}'

Results:

1: 0
2: 40
3: 624
4: 3744
5: 5108
6: 10200
7: 54912
8: 123552
9: 1098240
10: 1302540
Sum: 2598960, expected: 2598960

The corresponding full code is:

 1  # Perl weekly challenge 291
 2  # Task 2:  Poker Hand Rankings
 3  #
 4  # See https://wlmb.github.io/2024/10/14/PWC291/#task-2-poker-hand-rankings
 5  use v5.36;
 6  use List::Util qw(product sum);
 7  my @hand_names= ("Five_of_a_hand",
 8                   "Straight flush",
 9                   "Four of a kind",
10                   "Full house",
11                   "Flush",
12                   "Straight",
13                   "Three of a kind",
14                   "Two pairs",
15                   "One pair",
16                   "High card"
17      );
18  my @hand_counts=(0,
19                   10*4,
20                   13*(52-4),
21                   13*4*12*6,
22                   4*(fact(13)/fact(8)/fact(5)-10),
23                   10*4**5-40,
24                   13*12*11*4**3/2,
25                   13*6*12*6*11*4/2,
26                   13*6*fact(12)/fact(9)/fact(3)*4**3,
27                   (fact(13)/fact(8)/fact(5)-10)*(4**5-4)
28      );
29  say "$hand_names[$_]: $hand_counts[$_]" for 0..@hand_names-1;
30  say "Sum: ", sum(@hand_counts),
31      "\nExpected: ",
32      fact(52)/fact(52-5)/fact(5);
33  
34  sub fact($n){
35      product(1..$n)
36  }
37

Run it:

./ch-2a.pl

Results:

Five_of_a_hand: 0
Straight flush: 40
Four of a kind: 624
Full house: 3744
Flush: 5108
Straight: 10200
Three of a kind: 54912
Two pairs: 123552
One pair: 1098240
High card: 1302540
Sum: 2598960
Expected: 2598960
Written on October 14, 2024