TWC315

Challenge Link

Task1

We return the indices of the words where the character is present in that word:

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

sub find_words{
  grep {$_[0]->[$_] =~ $_[1]} 0..$#{$_[0]}
}

print show find_words(['the','weekly','challenge'],'e');
print show find_words(['perl','raku','python'],'p');
print show find_words(['abc','def','bbb','bcd'],'b');

Task2

If the words first and second happen consecutively we accumulate the word after it:

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

sub find_third{
  my ($s,$first,$second) = @_;
  my (@words,@ret) = split ' ',$s;
  foreach my $i(0..$#words-1){
    push @ret,$words[$i+2] =~ /\W$/ ? substr($words[$i+2],0,-1) : $words[$i+2]
      if ($words[$i] eq $first) && ($words[$i+1] eq $second)
  }
  @ret
}

print show find_third('Perl is a my favourite language but Python is my favourite too.',
		      'my',
		      'favourite');
print show find_third('Barbie is a beautiful doll also also a beautiful princess.',
		      'a',
		      'beautiful');
print show find_third('we will we will rock you rock you.','we','will');

TWC314

Challenge Link

Task1

We look for common prefixes:

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

sub equal_strings{
  my @lens = map{length} @_;
  my $sum = sum0 @lens;
  my $n = min @lens;
  foreach my $i(0..$n){
    if(!(substr($_[0],$i,1) eq substr($_[1],$i,1) &&
       substr($_[1],$i,1) eq substr($_[2],$i,1))){
      return $i == 0 ? -1 : $sum - 3 * $i
    }
  }
  $sum - 3 * $n
}

printf "%d\n",equal_strings('abc','abb','ab');
printf "%d\n",equal_strings('ayz','cyz','xyz');
printf "%d\n",equal_strings('yza','yzb','yzc');

Task2

We count sorted columns:

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

sub sort_column{
  my ($arr) = @_;
  my $ret = 0;
  foreach my $j(0..length($arr->[0])-1){
    foreach my $i(1..$#$arr){
      if(substr($arr->[$i],$j,1) lt substr($arr->[$i-1],$j,1)){
	$ret++;
	last
      }
    }
  }
  $ret
}

printf "%d\n",sort_column(['swpc','tyad','azbe']);
printf "%d\n",sort_column(['cba','daf','ghi']);
printf "%d\n",sort_column(['a','b','c']);

TWC313

Challenge Link

Task1

We check if name is a subset of typed:

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

sub broken_keys{
  my $s1 = Set::Scalar->new(split '',$_[0]);
  my $s2 = Set::Scalar->new(split '',$_[1]);
  $s1 <= $s2
}

printf "%d\n",broken_keys('perl','perrrl');
printf "%d\n",broken_keys('raku','rrakuuuu');
printf "%d\n",broken_keys('python','perl');
printf "%d\n",broken_keys('coffeescript','cofffeescccript');

Task2

We make an array from the input string and only reverse the letters:

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

sub reverse_letters{
  my @chars = split '',$_[0];
  my ($i,$j) = (0,$#chars);
  while($i < $j){
    $i++ while($i < $j and $chars[$i] !~ /[[:alpha:]]/);
    $j-- while($i < $j and $chars[$j] !~ /[[:alpha:]]/);
    ($chars[$i++],$chars[$j--]) = ($chars[$j],$chars[$i]) if $i < $j;
  }
  join '',@chars
}

printf "%s\n",reverse_letters('p-er?l');
printf "%s\n",reverse_letters('wee-k!L-y');
printf "%s\n",reverse_letters('_c-!h_all-en!g_e');

TWC312

Challenge Link

Task1

We calculate the distance by keeping track of the last letter written:

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

sub minimum_time{
  my ($str) = @_;
  my ($res,$prev) = (0,0);
  foreach my $c(split '',$str){
    my $curr = ord($c) - ord('a');
    my $t = abs($prev - $curr);
    $t = min($t,26-$t);
    $res += $t+1;
    $prev = $curr
  }
  $res
}

printf "%d\n",minimum_time('abc');
printf "%d\n",minimum_time('bza');
printf "%d\n",minimum_time('zjpc');

Task2

We check if a box contains balls of all the three given colors:

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

sub balls_and_boxes{
  my ($sum,%h) = (0);
  $h{$2} .= $1 while($_[0] =~ /([RGB])(\d)/g);
  foreach my $v(values %h){
    $sum++ if all{index($v,$_) != -1} ('R','G','B')
  }
  $sum
}

printf "%d\n",balls_and_boxes('G0B1R2R0B0');
printf "%d\n",balls_and_boxes('G1R3R6B3G6B1B6R1G3');
printf "%d\n",balls_and_boxes('B3B2G1B3');

TWC311

Challenge Link

Task1

We swap the case of each letter in the string:

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

sub upper_lower{
  $_[0] =~ tr/A-Za-z/a-zA-Z/r
}

printf "%s\n",upper_lower('pERl');
printf "%s\n",upper_lower('rakU');
printf "%s\n",upper_lower('PyThOn');

Task2

We sum the digits of each group while the length of the string is greater than n:

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

sub group_digit_sum{
  my ($str,$n) = @_;
  while(length $str > $n){
    my @gps = unpack("(A$n)*",$str);
    $str = join('',map{sum0 split '',$_} @gps)
  }
  $str
}

printf "%s\n",group_digit_sum('111122333',3);
printf "%s\n",group_digit_sum('1222312',2);
printf "%s\n",group_digit_sum('100012121001',4);

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