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

TWC329

Challenge Link

Task1

We extract the unique numbers:

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

sub counter_integers{
  uniq $_[0] =~ /(\d+)/g
}

print show counter_integers('the1weekly2challenge2');
print show counter_integers('go21od1lu5c7k');
print show counter_integers('4p3e2r1l');

Task2

We find letters which appear both in lower and upper case:

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

sub nice_string{
  my ($str) = @_;
  my %h;
  $h{lc $_} |= 1 + /[a-z]/ foreach split '',$str;
  foreach my $c(keys %h){
    next if $h{$c} == 3;
    $str =~ s/$c//gi;
  }
  $str
}

printf "%s\n",nice_string('YaaAho');
printf "%s\n",nice_string('cC');
printf "%s\n",nice_string('A');

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