TWC336

Challenge Link

Task1

We check if the gcd of the frequencies of the elements is greater than one:

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

sub equal_group{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  (reduce{gcd($a,$b)} values %h) > 1
}

printf "%d\n",equal_group([1,1,2,2,2,2]);
printf "%d\n",equal_group([1,1,1,2,2,2,3,3]);
printf "%d\n",equal_group([5,5,5,5,5,5,7,7,7,7,7,7]);
printf "%d\n",equal_group([1,2,3,4]);
printf "%d\n",equal_group([8,8,9,9,10,10,11,11]);

Task2

We use a stack to evaluate the RPN expression:

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

sub final_score{
  my @stk;
  for(@{$_[0]}) {
    if(/\d+/) {
      push @stk,$_
    } elsif($_ eq 'C') {
      pop @stk
    } elsif($_ eq 'D') {
      push @stk,$stk[-1] * 2
    } else {
      push @stk,$stk[-2] + $stk[-1]
    }
  }
  sum0 @stk
}

printf "%d\n",final_score(['5','2','C','D','+']);
printf "%d\n",final_score(['5','-2','4','C','D','9','+','+']);
printf "%d\n",final_score(['7','D','D','C','+','3']);
printf "%d\n",final_score(['-5','-10','+','D','C','+']);
printf "%d\n",final_score(['3','6','+','D','C','8','+','D',
			   '-2','C','+']);

TWC335

Challenge Link

Task1

We find the common characters between all words:

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

sub common_characters{
  my @f = map{{frequency split ''}} @{$_[0]};
  map{my $l = $_;
      ($l) x min map{$_->{$l} // 0} @f
    } 'a'..'z'
}

print show common_characters(["bella","label","roller"]);
print show common_characters(["cool","lock","cook"]);
print show common_characters(["hello","world","pole"]);
print show common_characters(["abc","def","ghi"]);
print show common_characters(["aab","aac","aaa"]);

Task2

We find the winner by only keeping track of the moves, instead of simulating the whole grid:

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

sub find_winner{
  my ($m) = @_;
  my @cnt = (0) x 8;
  for(my $k = $#$m; $k >= 0; $k -= 2){
    my ($i,$j) = ($m->[$k][0],$m->[$k][1]);
    $cnt[$i]++;
    $cnt[$j+3]++;
    $cnt[6]++ if $i == $j;
    $cnt[7]++ if $i + $j == 2;
    if(any{$_ == 3} ($cnt[$i],$cnt[$j+3],$cnt[6],$cnt[7])) {
      return $k % 2 == 0 ? 'A' : 'B'
    }
  }
  @$m == 9 ? 'Draw' : 'Pending'
}

printf "%s\n",find_winner([[0,0],[2,0],[1,1],[2,1],[2,2]]);
printf "%s\n",find_winner([[0,0],[1,1],[0,1],[0,2],[1,0],[2,0]]);
printf "%s\n",find_winner([[0,0],[1,1],[2,0],[1,0],[1,2],[2,1],
			   [0,1],[0,2],[2,2]]);
printf "%s\n",find_winner([[0,0],[1,1]]);
printf "%s\n",find_winner([[1,1],[0,0],[2,2],[0,1],[1,0],[0,2]]);

TWC334

Challenge Link

Task1

We find the sum of the given range:

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

sub range_sum{
  sum0 @{$_[0]}[$_[1]..$_[2]];
}

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

Task2

We find the nearest point to the given x and y using Manhattan distance:

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

sub nearest_valid_point{
  my ($p,$x,$y) = @_;
  my ($res,$min) = (-1,1000);
  foreach my $i(0..$#$p) {
    my ($a,$b) = ($p->[$i][0],$p->[$i][1]);
    if($a == $x || $b == $y){
      my $d = abs($a - $x) + abs($b - $y);
      if($d < $min) {
	$min = $d;
	$res = $i
      }
    }
  }
  $res
}

printf "%d\n",nearest_valid_point([[1,2],[3,1],[2,4],[2,3]],3,4);
printf "%d\n",nearest_valid_point([[3,4],[2,3],[1,5],[2,5]],2,5);
printf "%d\n",nearest_valid_point([[2,2],[3,3],[4,4]],1,1);
printf "%d\n",nearest_valid_point([[0,1],[1,0],[0,2],[2,0]],0,0);
printf "%d\n",nearest_valid_point([[5,6],[6,5],[5,4],[4,5]],5,5);

TWC333

Challenge Link

Task1

We check if the coordinates form a straight line:

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

sub straight_line{
  my ($m) = @_;
  my ($x1,$y1,$x2,$y2) = ($m->[0][0],$m->[0][1],$m->[1][0],$m->[1][1]);
  for(my $i = 2; $i < @$m; ++$i) {
    my ($x,$y) = ($m->[$i][0],$m->[$i][1]);
    return 0 if(($x - $x1) * ($y2 - $y1) != ($y - $y1) * ($x2 - $x1))
  }
  1
}

printf "%d\n",straight_line([[2,1],[2,3],[2,5]]);
printf "%d\n",straight_line([[1,4],[3,4],[10,4]]);
printf "%d\n",straight_line([[0,0],[1,1],[2,3]]);
printf "%d\n",straight_line([[1,1],[1,1],[1,1]]);
printf "%d\n",straight_line([[1000000,1000000],
			     [2000000,2000000],
			     [3000000,3000000]]);

Task2

We duplicate each zero twice until we reach array size and stop:

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

sub duplicate_zeros{
  my ($arr) = @_;
  my ($i,@stk) = (0);
  while($i < @$arr && @stk != @$arr){
    if($arr->[$i] == 0 && (@stk+1 < @$arr)) {
      push @stk,0 for 0..1;
      $i++
    } else {
      push @stk,$arr->[$i++]
    }
  }
  @stk
}

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

TWC332

Challenge Link

Task1

We convert each number into binary and join them with dashes:

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

sub binary_date{
  $_[0] =~ s/(\d+)/{sprintf "%b",$1}/rge
}

printf "%s\n",binary_date('2025-07-26');
printf "%s\n",binary_date('2000-02-02');
printf "%s\n",binary_date('2024-12-31');

Task2

We check if each letters occurred odd number of times:

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

sub odd_letters{
  my %h;
  $h{$_}++ foreach split '',$_[0];
  all{$h{$_} & 1} keys %h
}

printf "%d\n",odd_letters('weekly');
printf "%d\n",odd_letters('perl');
printf "%d\n",odd_letters('challenge');

TWC331

Challenge Link

Task1

We return length of the last word in the string:

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

sub last_word{
  length((split /\s/,$_[0])[-1])
}

printf "%d\n",last_word('The Weekly Challenge');
printf "%d\n",last_word('    Hello World    ');
printf "%d\n",last_word('Let\'s begin the fun');

Task2

We check if the strings are of the same length and only differ in one position:

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

sub buddy_strings{
  return 0 if length($_[0]) != length($_[1]);
  my @s1 = split '',$_[0];
  return 1 if $_[0] eq $_[1] and @s1 > uniq(@s1);
  my @s2 = split '',$_[1];
  return 0 if (join('',sort @s1) ne join('',sort @s2));
  (grep{$_ != 0} (pairwise{$a cmp $b} @s1,@s2)) == 2
}

printf "%d\n",buddy_strings('fuck','fcuk');
printf "%d\n",buddy_strings('love','love');
printf "%d\n",buddy_strings('fodo','food');
printf "%d\n",buddy_strings('feed','feed');

TWC330

Challenge Link

Task1

We keep on clearing adjacent letter and digit pairs:

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

sub clear_digits{
  my ($str) = @_;
  1 while($str =~ s/\D\d//);
  $str
}

printf "%s\n",clear_digits('cab12');
printf "%s\n",clear_digits('xy99');
printf "%s\n",clear_digits('pa1erl');

Task2

We make each word lowercase if its length is less than 3, otherwise make it titlecase:

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

sub title_capital{
  join ' ',map{length($_) < 3 ? lc : ucfirst lc} split ' ',$_[0];
}

printf "%s\n",title_capital('PERL IS gREAT');
printf "%s\n",title_capital('THE weekly challenge');
printf "%s\n",title_capital('YoU ARE A stAR');