TWC305

Challenge Link

Task1

We check for primality of the binary prefixes:

#!/usr/bin/env perl
use strict;
use warnings;
use Math::Prime::Util qw(is_prime);
use Data::Show;

sub binary_prefix{
  my ($arr) = @_;
  my ($bin,@res) = ('');
  map{$bin .= $_; push @res,is_prime(oct("0b$bin")) ? 1 : 0} @$arr;
  @res
}

print show binary_prefix([1,0,1]);
print show binary_prefix([1,1,0]);
print show binary_prefix([1,1,1,1,0,1,0,0,0,0,1,0,1,0,0,1,0,0,0,1]);

Task2

We sort the array according to the alien dictionary:

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Show;

sub alien_dictionary{
  my ($words,$alien) = @_;
  my $r = join '',@$alien;
  sort{eval "\$a =~ tr/a-z/$r/r" cmp
       eval "\$b =~ tr/a-z/$r/r"} @$words
}

print show alien_dictionary(['perl','python','raku'],
			    [qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/]);
print show alien_dictionary(['the','weekly','challenge'],
			    [qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/]);

TWC303

Challenge Link

Task1

We find all 3 variations of digits, and check if it is even, then remove the duplicates:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(variations);
use List::Util qw(uniq);
use Data::Show;

sub three_digits_even{
  @{$_[0]} = sort{$a <=> $b} @{$_[0]};
  uniq map{join '',@$_} grep{$_->[0] && !($_->[2] % 2)}
    variations($_[0],3)
}

print show three_digits_even([2,1,3,0]);
print show three_digits_even([2,2,8,8,2]);

Task2

We keep deleting and keeping points to get the final result:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);

sub delete_and_earn{
  my $max = max @{$_[0]};
  my @total = (0) x ($max+1);
  map{$total[$_] += $_} @{$_[0]};
  my $first = $total[0];
  my $second = max($total[0],$total[1]);
  foreach my $i(2..$max){
    my $curr = max(($first+$total[$i]),$second);
    $first = $second;
    $second = $curr
  }
  $second
}

printf "%d\n",delete_and_earn([3,4,2]);
printf "%d\n",delete_and_earn([2,2,3,3,3,4]);

TWC302

Challenge Link

Task1

For each combination of the array of size 1 to N, we check to see if the count of zeros and ones are subset of the given x and y:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(combinations);

sub ones_and_zeros{
  foreach my $s(reverse 1..@{$_[0]}){
    my $it = combinations($_[0],$s);
    while(my $comb = $it->next){
      my $joined = join '',@$comb;
      my $zeroes = $joined =~ tr/0//;
      my $ones = $joined =~ tr/1//;
      return $s if $zeroes <= $_[1] && $ones <= $_[2]
    }
  }
  0
}

printf "%d\n",ones_and_zeros(["10","0001","111001","1","0"],5,3);
printf "%d\n",ones_and_zeros(["10","1","0"],1,1);

Task2

We find the minimum value needed so that step-wide sum won't become less than 1:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(min max);

sub step_by_step{
  my $s = 0;
  my $t = $_[0]->[0];
  map{$s += $_; $t = min $t,$s} @{$_[0]};
  max 1,1-$t
}

printf "%d\n",step_by_step([-3,2,-3,4,2]);
printf "%d\n",step_by_step([1,2]);
printf "%d\n",step_by_step([1,-2,-3]);