TWC328

 Challenge Link

Task1

We replace the ? mark with the first letter that isn't in the string already:

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

sub replace_all{
  my %h = map{$_ => 1} split '',$_[0];
  my @chars = grep{!exists $h{$_}} 'a'..'z';
  $_[0] =~ s/\?/$chars[0]/r
}

printf "%s\n",replace_all('a?z');
printf "%s\n",replace_all('pe?k');
printf "%s\n",replace_all('gra?te');

Task2

As long as there are pairs of consecutive capital and lowercase letters (irrespective of their order), we remove it from the string:

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

sub good_string{
  my ($str) = @_;
  my $chars = join '|',map{"$_\u$_|\u$_$_"} 'a'..'z';
  1 while $str =~ s/$chars//;
  $str
}

printf "%s\n",good_string('WeEeekly');
printf "%s\n",good_string('abBAdD');
printf "%s\n",good_string('abc');

TWC327

Challenge Link

Task1

Symmetric difference of two sets gives the missing integers:

#!/usr/bin/env perl
use strict;
use warnings;
use Set::Scalar;
use feature qw(say);

sub missing_integers{
  Set::Scalar->new(@{$_[0]}) / Set::Scalar->new(1..@{$_[0]})
}

say missing_integers([1,2,1,3,2,5]);
say missing_integers([1,1,1]);
say missing_integers([2,2,1]);

Task2

We return the pairs of numbers with minimum absolute value difference:

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

sub mad{
  my @s = sort{$a <=> $b} @{$_[0]};
  my @mad = $s[1] - $s[0];
  foreach my $i(1..$#s){
    my $diff = abs $s[$i] - $s[$i-1];
    $mad[0] = $diff if $diff < $mad[0];
    push @mad,[@s[$i-1,$i]] if $diff == $mad[0]
  }
  @mad[1..$#mad]
}

print show mad([4,1,2,3]);
print show mad([1,3,7,11,15]);
print show mad([1,5,3,8]);

TWC326

Challenge Link

Task1

We find day number using Time::Piece module:

#!/usr/bin/env perl
use strict;
use warnings;
use Time::Piece;

sub day_of_the_year{
  Time::Piece->strptime($_[0],'%Y-%m-%d')->yday + 1
}

printf "%d\n",day_of_the_year('2025-02-02');
printf "%d\n",day_of_the_year('2025-04-10');
printf "%d\n",day_of_the_year('2025-09-07');

Task2

For each pair of numbers, we append the j value i times to the result:

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

sub decompressed_list{
  my ($arr) = @_;
  my ($i,@res) = (0);
  while($i < $#{$arr}){
    push @res, ($arr->[$i+1]) x $arr->[$i];
    $i += 2
  }
  @res
}

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

TWC325

Challenge Link

Task1

We find the count of maximum runs of ones:

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

sub consecutive_one{
  max 0,map length,split /[^1]+/,join '',@{$_[0]}
}

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

Task2

We subtract each price from its immediate smaller price to find the discounts:

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

sub final_price {
  my ($p) = @_;
  my @stack;
  my @res = @$p;
  foreach my $i(0..$#$p){
    while(@stack && ($p->[$stack[-1]] >= $p->[$i])) {
      my $j = pop @stack;
      $res[$j] = $p->[$j] - $p->[$i]
    }
    push @stack,$i
  }
  @res
}

print show final_price([8,4,6,2,3]);
print show final_price([1,2,3,4,5]);
print show final_price([7,1,1,5]);

TWC324

Challenge Link

Task1

We take $c columns from the array each $r time through the map:

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

sub twod_array{
  my ($arr,$r,$c) = @_;
  map{[splice @$arr,0,$c]} 1..$r
}

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

Task2

We find the sum of xoring each subset of the array:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(subsets);
use List::Util qw(reduce);

sub total_xor{
  my $it = subsets($_[0]);
  my $sum = 0;
  while(my $s = $it->next){
    $sum += reduce {$a ^ $b} 0, @$s
  }
  $sum
}

printf "%d\n",total_xor([1,3]);
printf "%d\n",total_xor([5,1,6]);
printf "%d\n",total_xor([3,4,5,6,7,8]);