TWC277

Challenge Link

Task1

We count the array elements in a hash and check which ones are equal to two:

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

sub count_common{
  my %h;
  $h{$_}++ foreach @{$_[0]},@{$_[1]};
  (grep{$_ == 2}values %h) // 0
}

printf "%d\n",
  count_common(['Perl','is','my','friend'],
	       ['Perl','and','Raku','are','friend']);
printf "%d\n",
  count_common(['Perl','and','Python','are','very','similar'],
	       ['Python','is','top','in','guest','languages']);
printf "%d\n",
  count_common(['Perl','is','imperative','Lisp','is','functional'],
	       ['Crystal','is','similar','to','Ruby']);

Task2

We count how many times the given condition is met, for each combination of pairs of elements:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(combinations);
use List::AllUtils qw(min uniq);

sub strong_pairs{
  scalar grep{abs($$_[0] - $$_[1]) < min(@$_)}
    combinations([uniq @{$_[0]}],2)
}

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

TWC276

Challenge Link

Task1

If the sum of any of the pairs is divisible by 24, we increment the count value:

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

sub complete_day{
  my ($arr) = @_;
  my $count = 0;
  foreach my $i(0..$#$arr-1){
    foreach my $j($i+1..$#$arr){
      $count++ if(($arr->[$i] + $arr->[$j]) % 24 == 0)
    }
  }
  $count
}

printf "%d\n",complete_day([12,12,30,24,24]);
printf "%d\n",complete_day([72,48,24,55]);
printf "%d\n",complete_day([12,18,24]);

Task2

We count the values, and sum the ones which have a weight equal to the max weight of the elements:

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

sub maximum_frequency{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  my $max = max values %h;
  sum0 grep {$_ if $_ == $max} values %h
}

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

TWC273

Challenge Link

Task1

We count the character's occurrences and calculate its percentage:

#!/usr/bin/env perl
use strict;
use warnings;
use POSIX qw(round);

sub percentage_of_character{
  my ($str,$char) = @_;
  my $count =()= $str =~ /\Q$char/g;
  round(100 * $count / length $str)
}

printf "%d\n",percentage_of_character('perl','e');
printf "%d\n",percentage_of_character('java','a');
printf "%d\n",percentage_of_character('python','m');
printf "%d\n",percentage_of_character('ada','a');
printf "%d\n",percentage_of_character('ballerina','l');
printf "%d\n",percentage_of_character('analitik','k');

Task2

We see if there's no 'a' character after the last 'b' character:

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

sub b_after_a{
  (-1 != index($_[0],'b')) >= rindex($_[0],'a')
}

printf "%d\n",b_after_a('aabb');
printf "%d\n",b_after_a('abab');
printf "%d\n",b_after_a('aaa');
printf "%d\n",b_after_a('bbb');

TWC272

Challenge Link

Task1

Replacing each . with [.]:

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

sub defrag_ip_address{
  $_[0] =~ s/\./[.]/gr
}

printf "%s\n",defrag_ip_address('1.1.1.1');
printf "%s\n",defrag_ip_address('255.101.1.0');

Task2

Subtracting the absolute values of pairs and taking their sum:

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

sub string_score{
  sum0 slide {abs(ord($b) - ord($a))} split '',$_[0]
}

printf "%d\n",string_score('hello');
printf "%d\n",string_score('perl');
printf "%d\n",string_score('raku');

TWC271

Challenge Link

Task1

We return the index of the array with the largest sum:

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

sub maximum_ones{
  my $max = 0;
  map{my $c = sum0 @{$_[0]->[$_]}; $max = $_+1 if $c > $max} 0..$#{$_[0]};
  $max
}

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

Task2

We first sort by the pop count of the items then if they were equal, by the elements themselves:

#!/usr/bin/env perl
use strict;
use warnings;
use ntheory qw(hammingweight);
use Data::Show;

sub sort_by_one_bits{
  sort{hammingweight($a) <=> hammingweight($b) || $a <=> $b} @{$_[0]}
}

print show sort_by_one_bits([0,1,2,3,4,5,6,7,8]);
print show sort_by_one_bits([1024,512,256,128,64]);

TWC269

Challenge Link

Task1

We count the number of even numbers because an even number's right most bit is 0, and see if that count is greater than one:

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

sub bitwise_or{
  (grep{($_ & 1) == 0} @{$_[0]}) > 1
}

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

Task2

We keep pushing elements into two arrays as the requirements and concatenate and return the results:

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

sub distribute_elements{
  my @ret1 = shift @{$_[0]};
  my @ret2 = shift @{$_[0]};
  while(@{$_[0]}){
    my $e = shift @{$_[0]};
    $ret1[-1] > $ret2[-1] ? push @ret1,$e : push @ret2,$e;
  }
  @ret1,@ret2
}

print show distribute_elements([2,1,3,4,5]);
print show distribute_elements([3,2,4]);
print show distribute_elements([5,4,3,8]);

TWC268

Challenge Link

Task1

We take the absolute value of the first elements of arrays after sorting them:

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

sub magic_number{
  my @x = sort{$a <=> $b} @{$_[0]};
  my @y = sort{$a <=> $b} @{$_[1]};
  abs($x[0] - $y[0])
}

printf "%d\n",magic_number([3,7,5],[9,5,7]);
printf "%d\n",magic_number([1,2,1],[5,4,4]);
printf "%d\n",magic_number([2],[5]);

Task2

After sorting the array, we keep removing pairs of elements and push its reverse to the array that we want to return:

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

sub number_game{
  my @arr = sort{$a <=> $b} @{$_[0]};
  my @ret;
  push @ret,reverse splice @arr,0,2 while(@arr);
  @ret
}

print show number_game([2,5,3,4]);
print show number_game([9,4,1,3,6,4,6,1]);
print show number_game([1,2,2,3]);