TWC310

Challenge Link

Task1

We take the intersection of arrays:

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

sub arrays_intersection{
  my ($arr) = @_;
  return () unless @$arr;
  my $s = Set::Scalar->new($arr->[0]->@*);
  map{$s *= Set::Scalar->new(@$_)} @{$arr}[1..$#$arr];
  $s->elements
}

print show arrays_intersection([[1,2,3,4],[4,5,6,1],[4,2,1,3]]);
print show arrays_intersection([[1,0,2,3],[2,4,5]]);
print show arrays_intersection([[1,2,3],[4,5],[6]]);

Task2

We sort the array based on even and odd indices:

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

sub sort_even_odd{
  grep {defined}
    (mesh[sort{$a <=> $b}@{$_[0]}[grep{!($_%2)} 0..$#{$_[0]}]],
     [sort{$b <=> $a}@{$_[0]}[grep{$_%2} 0..$#{$_[0]}]]);
}

print show sort_even_odd([4,1,2,3]);
print show sort_even_odd([3,1]);
print show sort_even_odd([5,3,2,1,4]);

TWC309

Challenge Link

Task1

We look for the minimum difference between the pairs and return the found index:

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

sub min_gap{
  my ($arr) = @_;
  my $min = $arr->[0];
  my $min_gap = $arr->[1] - $arr->[0];
  foreach my $i(2..$#$arr){
    my $gap = $arr->[$i] - $arr->[$i-1];
    if($gap < $min_gap){
      $min = $arr->[$i];
      $min_gap = $gap
    }
  }
  $min
}

printf "%d\n",min_gap([2,8,10,11,15]);
printf "%d\n",min_gap([1,5,6,7,14]);
printf "%d\n",min_gap([8,20,25,28]);

Task2

We find the minimum difference of any two elements:

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

sub min_diff{
  my @sorted = sort{$a<=>$b}@{$_[0]};
  min(map{$sorted[$_] - $sorted[$_-1]}1..$#sorted)
}

printf "%d\n",min_diff([1,5,8,9]);
printf "%d\n",min_diff([9,4,1,7]);

TWC304

Challenge Link

Task1

We count the consecutive pairs of zeros and check if the count is greater than the given n:

#!/usr/bin/env perl
use strict;
use warnings;

sub arrange_binary{
  my $c = 0;
  map{$c++ if $_[0]->[$_] == 0 && $_[0]->[$_+1] == 0} 0..$#{$_[0]}-1;
  $c > $_[1]
}

printf "%d\n",arrange_binary([1,0,0,0,1],1);
printf "%d\n",arrange_binary([1,0,0,0,1],2);

Task2

We find the maximum sub array sum of the given length n:

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

sub maximum_average{
  my ($arr,$n) = @_;
  my $max = min @$arr;
  foreach my $start(0..@$arr-$n){
    my $subsum = sum0(@{$arr}[$start..$start+$n-1]);
    my $avg = $subsum / $n;
    $max = $avg if $avg > $max
  }
  $max
}

say maximum_average([1,12,-5,-6,50,3],4);
say maximum_average([5],1);

TWC308

Challenge Link

Task1

We find the intersection of two arrays:

#!/usr/bin/env perl
use strict;
use warnings;

sub count_common{
  my %h;
  $h{$_}++ for @{$_[0]};
  scalar grep{exists $h{$_} && $h{$_}++ < 2} @{$_[1]}
}

printf "%d\n",count_common(['perl','weekly','challenge'],
			   ['raku','weekly','challenge']);
printf "%d\n",count_common(['perl','raku','python'],
			   ['python','java']);
printf "%d\n",count_common(['guest','contribution'],
			   ['fun','weekly','challenge']);

Task2

We find the resultant array by xoring the elements starting with the given first:

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

sub decode_xor{
  my @res = ($_[1]);
  push @res,$res[-1] ^ $_ foreach @{$_[0]};
  @res
}

print show decode_xor([1,2,3],1);
print show decode_xor([6,2,7,3],4);

TWC307

Challenge Link

Task1

We sort the array and return those indices where elements differ:

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

sub check_order{
  my @sorted = sort{$a <=> $b} @{$_[0]};
  map{$sorted[$_] != $_[0]->[$_] ? $_ : ()} 0..$#sorted
}

print show check_order([5,2,4,3,1]);
print show check_order([1,2,1,1,3]);
print show check_order([3,1,3,2,3]);

Task2

We find the anagrams by sorting each string and counting any differing two consecutive elements:

#!/usr/bin/env perl
use strict;
use warnings;

sub find_anagrams{
  my ($arr) = @_;
  my @sorted = map {join'',sort split ''} @$arr;
  my $sum = 1;
  map{$sum++ if $sorted[$_-1] ne $sorted[$_]} 1..$#sorted;
  $sum
}

printf "%d\n",find_anagrams(['acca','dog','god','perl','repl']);
printf "%d\n",find_anagrams(['abba','baba','aabb','ab','ab']);

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]);