TWC262

Challenge Link

Task1

We count the number of negative and positive numbers in the array and return the maximum:

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

sub max_positive_negative{
  my ($neg,$pos) = 0 x 2;
  map{$neg++ if $_ < 0;$pos++ if $_ > 0}@{$_[0]};
  max $neg,$pos
}

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

Task2

For each (i,j) pair we check if the condition (i * j mod k == 0) holds and count them:

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

sub count_equal_divisible{
  my ($arr,$k) = @_;
  my $count = 0;
  foreach my $i(0..@$arr-2){
    foreach my $j($i+1..@$arr-1){
      ++$count if $arr->[$i] == $arr->[$j] && ($i*$j) % $k == 0
    }
  }
  $count
}

printf "%d\n",count_equal_divisible([3,1,2,2,2,1,3],2);
printf "%d\n",count_equal_divisible([1,2,3],1);

TWC261

Challenge Link

Task1

We subtract the sum of each digit in each number from the sum of the numbers and take its absolute value:

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

sub element_digit_sum{
  abs(sum0(map{split ''}@{$_[0]}) - sum0(@{$_[0]}))
}

printf "%d\n",element_digit_sum([1,2,3,45]);
printf "%d\n",element_digit_sum([1,12,3]);
printf "%d\n",element_digit_sum([1,2,3,4]);
printf "%d\n",element_digit_sum([236,416,336,350]);

Task2

While $start is in the list, we keep multiplying it by 2:

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

sub multiply_by_two{
  my ($arr,$start) = @_;
  $start *= 2 while((firstidx{$start == $_}@$arr)!=-1);
  $start
}

printf "%d\n",multiply_by_two([5,3,6,1,12],3);
printf "%d\n",multiply_by_two([1,2,4,3],1);
printf "%d\n",multiply_by_two([5,6,7],2);

TWC260

Challenge Link

Task1

We count the occurrences of each integer in a hash, then check if the length of the values of that hash is equal to the length of the unique values,  if so we return 1 else 0:

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

sub unique_occurences{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  my @values = values %h;
  @values == (uniq @values) || 0
}

printf "%d\n",unique_occurences([1,2,2,1,1,3]);
printf "%d\n",unique_occurences([1,2,3]);
printf "%d\n",unique_occurences([-2,0,1,-2,1,1,0,1,-2,9]);

Task2

We construct an array of all permutations of the given string, join each tuple to a string, and remove the duplicates, then sort and find the index of the string which is equal to the argument of the subroutine:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(permutations);
use List::MoreUtils qw(onlyidx uniq);

sub dictionary_rank{
  1+onlyidx{$_ eq $_[0]}
    sort{$a cmp $b}
    uniq map{join'',@$_}
    permutations([split '',$_[0]])
}

printf "%d\n",dictionary_rank('CAT');
printf "%d\n",dictionary_rank('GOOGLE');
printf "%d\n",dictionary_rank('SECRET');

TWC258

 Challenge Link

Task1

we split the number into its digits and check if it is even:

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

sub count_even_digits_number{
  scalar grep{(split'',$_)%2==0}@{$_[0]}
}

printf "%d\n",count_even_digits_number([10,1,111,24,1000]);
printf "%d\n",count_even_digits_number([111,1,11111]);
printf "%d\n",count_even_digits_number([2,8,1024,256]);

Task2

We get the popcount of each index and if it is equal to $k, we include the number at that index in the resultant array, else we skip it:

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

sub sum_of_values{
  sum0 map{hammingweight$_==$_[1]?$_[0]->[$_]:()}0..$#{$_[0]}
}

printf "%d\n",sum_of_values([2,5,9,11,3],1);
printf "%d\n",sum_of_values([2,5,9,11,3],2);
printf "%d\n",sum_of_values([2,5,9,11,3],0);

TWC256

Challenge Link

Task1

We check each string with the reverse of all others and increment the count if they are equal:

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

sub maximum_pairs{
  my ($a) = @_;
  my $c = 0;
  map{my $i = $_;
      map{$c++ if $a->[$i] eq reverse $a->[$_]}$i+1..$#$a}0..$#$a;
  $c
}

printf "%d\n", maximum_pairs(['ab','de','ed','bc']);
printf "%d\n", maximum_pairs(['aa','ba','cd','ed']);
printf "%d\n", maximum_pairs(['uv','qp','st','vu','mn','pq']);

Task2

We keep picking a character from each string alternatively until we exhaust the strings:

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

sub merge_strings{
  my ($res,$m,$n) = ('',length $_[0],length $_[1]);
  for(my $i = 0; $i < $m || $i < $n; ++$i){
    $res .= substr $_[0],$i,1 if $i < $m;
    $res .= substr $_[1],$i,1 if $i < $n;
  }
  $res
}

printf "%s\n",merge_strings('abcd','1234');
printf "%s\n",merge_strings('abc','12345');
printf "%s\n",merge_strings('abcde','123');

TWC255

Challenge Link

Task1

We count the characters' occurrences of the first string, and do the same thing for the second string too but this time we decrement the count or if we hit 0 (false), then we delete that hash entry, leaving us with the only odd character as the remaining key to be returned:

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

sub odd_character{
  my %h;
  map{++$h{$_}}split '',$_[0];
  map{--$h{$_}||delete $h{$_}}split '',$_[1];
  keys %h
}

printf "%s\n",odd_character("Perl","Preel");
printf "%s\n",odd_character("Weekly","Weeakly");
printf "%s\n",odd_character("Box","Boxy");

Task2

We count the occurrences of each word excluding the banned word, and return the one with the highest count:

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

sub most_frequent_word{
  my %h;
  map{$h{$_}++ if $_ ne $_[1]} split /[^\w]/,$_[0];
  (sort{$h{$b}<=>$h{$a}}keys %h)[0]
}

printf "%s\n",most_frequent_word("Joe hit a ball, the hit ball ".
				 "flew far after it was hit.",
				 "hit");
printf "%s\n",most_frequent_word("Perl and Raku belong to the same family.".
				 " Perl is the most popular language ".
				 "in the weekly challenge.",
				 "the");

TWC254

Challenge Link

Task1

First one is a math trick that we use to find out if a number is a power of 3 or not:

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

sub three_power{
  $_[0] == int($_[0]**(1/3))**3
}

printf "%d\n",three_power(27);
printf "%d\n",three_power(0);
printf "%d\n",three_power(6);

Task2

We reverse the list of vowels and replace them in the string, and capitalize the first letter:

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

sub reverse_vowels{
  my ($str) = @_;
  my @vowels = $str =~ /[aeiou]/gi;
  $str =~ s/([aeiou])/pop @vowels/egi;
  ucfirst $str
}

printf "%s\n",reverse_vowels('Raku');
printf "%s\n",reverse_vowels('Perl');
printf "%s\n",reverse_vowels('Julia');
printf "%s\n",reverse_vowels('Uiua');