TWC380

Challenge Link

Task1

We count the maximum frequencies of vowels and consonants and sum them:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);
use Test::More tests => 5;

sub sum_of_frequencies {
  my %h;
  $h{$_}++ foreach split '', lc $_[0];
  my ($c, $v) = (0, 0);
  foreach (keys %h) {
    /[aeiou]/ ? ($v = max($v, $h{$_})) : ($c = max($c, $h{$_}));
  }
  $c + $v;
}

is sum_of_frequencies('banana'),5,'Example 1';
is sum_of_frequencies('teestett'),7,'Example 2';
is sum_of_frequencies('aeiouuaa'),3,'Example 3';
is sum_of_frequencies('rhythm'),2,'Example 4';
is sum_of_frequencies('x'),1,'Example 5';

Task2

We calculate the score of each letter according to its position in the string and reverse alphabet enumeration and then sum the result:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(sum0);
use Test::More tests => 5;

sub reverse_degree{
  my ($i,%h) = (1);
  @h{'a'..'z'} = reverse 1..26;
  sum0 map {$h{$_} * $i++} split '',lc $_[0]
}

is reverse_degree('z'),1,'Example 1';
is reverse_degree('a'),26,'Example 2';
is reverse_degree('bbc'),147,'Example 3';
is reverse_degree('racecar'),560,'Example 4';
is reverse_degree('zyx'),14,'Example 5';

done_testing();

TWC368

Challenge Link

Task1

We find the index of the number which if removed, makes the number the maximum possible:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);
use Test::More tests => 5;

sub make_it_bigger{
  my $idx = -1;
  my @res;
  while(($idx = index $_[0],$_[1],$idx+1) != -1){
    substr my $s = $_[0],$idx,1,'';
    push @res,$s
  }
  max(@res)
}

is make_it_bigger('15456','5'),'1546','Example 1';
is make_it_bigger('7332','3'),'732','Example 2';
is make_it_bigger('2231','2'),'231','Example 3';
is make_it_bigger('543251','5'),'54321','Example 4';
is make_it_bigger('1921','1'),'921','Example 5';

Task2

We calculate the little or big omega of the number according to the given instructions:

#!/usr/bin/env perl
use strict;
use warnings;
use ntheory qw(factor factor_exp);
use Test::More tests => 5;

sub big_and_little_omega{
  my @funcs = (\&factor_exp,\&factor);
  scalar($funcs[!!$_[1]]($_[0]))
}

is big_and_little_omega(100061,0),3,'Example 1';
is big_and_little_omega(971088,0),3,'Example 2';
is big_and_little_omega(63640,1),6,'Example 3';
is big_and_little_omega(988841,1),2,'Example 4';
is big_and_little_omega(211529,0),2,'Example 5';

TWC366

Challenge Link

Task1

We count the strings which are prefixes of the given string:

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub count_prefixes{
  scalar grep {index($_[1], $_) == 0} @{$_[0]}
}

is count_prefixes(['a','ap','app','apple','banana'],'apple'),
  4,'Example 1';
is count_prefixes(['cat','dog','fish'],'bird'),0,'Example 2';
is count_prefixes(['hello','he','hell','heaven','he'],'hello'),
  4,'Example 3';
is count_prefixes(['','code','coding','cod'],'coding'),
  3,'Example 4';
is count_prefixes(['p','pr','pro','prog','progr','progra','program'],
		  'program'),7,'Example 5';

Task2

We check for valid times by enumerating different possibilities of hours and minutes:

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub valid_times{
  my $res = 1;
  my @t = split '',$_[0];
  if($t[0] eq '?') {
    $res = $t[1] eq '?' ? 24 : $t[1] lt '4' ? 3 : 2
  } elsif($t[1] eq '?') {
    $res = $t[0] lt '2' ? 10 : 4
  }
  $res * ($t[3] eq '?' ? 6 : 1) * ($t[4] eq '?' ? 10 : 1)
}

is valid_times('?2:34'),3,'Example 1';
is valid_times('?4:?0'),12,'Example 2';
is valid_times('??:??'),1440,'Example 3';
is valid_times('?3:45'),3,'Example 4';
is valid_times('2?:15'),4,'Example 5';

TWC365

Challenge Link

Task1

We assign to each letter its positional value and sum its digits k times:

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub digits_sum{
  my ($n) = @_;
  my $sum = 0;
  while($n > 0){
    $sum += $n % 10;
    $n /= 10
  }
  $sum
}

sub alphabet_index_digit_sum{
  my $n = '';
  foreach(split '',$_[0]){
    $n .= int(ord($_) - ord('a') + 1)
  }
  for(my $i = 0; $i < $_[1]; ++$i){
    $n = digits_sum($n)
  }
  $n
}

is alphabet_index_digit_sum('abc',1),6,'Example 1';
is alphabet_index_digit_sum('az',2),9,'Example 2';
is alphabet_index_digit_sum('cat',1),6,'Example 3';
is alphabet_index_digit_sum('dog',2),8,'Example 4';
is alphabet_index_digit_sum('perl',3),6,'Example 5';

Task2

We check for the given conditions and count each word that satisfies it:

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub valid_token_counter{
  scalar grep {/^(?:[a-z]+-)?[a-z]+[?!.,]?$/} split /\s+/,$_[0];
}

is valid_token_counter("cat and dog"),3,'Example 1';
is valid_token_counter("a-b c! d,e"),2,'Example 2';
is valid_token_counter("hello-world! this is fun"),4,'Example 3';
is valid_token_counter("ab- cd-ef gh- ij!"),2,'Example 4';
is valid_token_counter("wow! a-b-c nice."),2,'Example 5';

TWC364

Challenge Link

Task1

We decrypt the string according to the given rules, were single digits are handled differently from two-digit sequences:

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub decrypt_string{
  my %h;
  my ($i,$c) = (1,'a');
  $h{$i++} = $c++ foreach 1..9;
  $h{$i++ . '#'} = $c++ foreach 10..26;
  $_[0] =~ s/((?:1\d|2[0-6])#|\d)/$h{$1}/gr
}

is decrypt_string('10#11#12'),'jkab','Example 1';
is decrypt_string('1326#'),'acz','Example 2';
is decrypt_string('25#24#123'),'yxabc','Example 3';
is decrypt_string('20#5'),'te','Example 4';
is decrypt_string('1910#26#'),'aijz','Example 5';

Task2

We replace "()" with "o" and "(al)" with "al":

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 5;

sub goal_parser{
  my %h = ('' => 'o',al => 'al');
  $_[0] =~ s/\(((?:al)?)\)/$h{$1}/gr
}

is goal_parser('G()(al)'),'Goal','Example 1';
is goal_parser('G()()()()(al)'),'Gooooal','Example 2';
is goal_parser('(al)G(al)()()'),'alGaloo','Example 3';
is goal_parser('()G()G'),'oGoG','Example 4';
is goal_parser('(al)(al)G()()'),'alalGoo','Example 5';

TWC379

Challenge Link

Task1

We reverse the string:

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

sub reverse_string{
  my ($s) = @_;
  my $res = '';
  $res .= chop $s while length $s;
  $res
}

printf "%s\n",reverse_string('');
printf "%s\n",reverse_string('reverse the given string');
printf "%s\n",reverse_string('Perl is Awesome');
printf "%s\n",reverse_string('v1.0.0-Beta!');
printf "%s\n",reverse_string('racecar');

Task2

We find all armstrong numbers under the given limit:

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

sub is_armstrong{
  my ($base,$limit) = @_;
  grep{
    my ($v,$sum,@digits) = (0,0,split '',$_);
    $v = $v * $base + $_,$sum += $_ ** @digits for @digits;
    $v == $sum
  } 0..$limit
}

show is_armstrong(10,1000);
show is_armstrong(7,1000);
show is_armstrong(16,1000);

TWC373

Challenge Link

Task1

We concatenate two string lists to strings and check for equality:

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

sub equal_list{
  (join '',@{$_[0]}) eq (join '',@{$_[1]})
}

printf "%d\n",equal_list(['a','bc'],['ab','c']);
printf "%d\n",equal_list(['a','b','c'],['a','bc']);
printf "%d\n",equal_list(['a','bc'],['a','c','b']);
printf "%d\n",equal_list(['ab','c',''],['','a','bc']);
printf "%d\n",equal_list(['p','e','r','l'],['perl']);

Task2

We try to divide the list two equal parts as long as possible:

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

sub list_division{
  my ($arr,$n) = @_;
  my $sz = int(@$arr / $n);
  return -1 if $n > @$arr;

  my $rest = @$arr % $n;
  my @res;
  foreach my $i(1..$n){
    push @res,[splice @$arr,0,$sz + ($i <= $rest)]
  }
  @res
}

show list_division([1..5],2);
show list_division([1..6],3);
show list_division([1..3],2);
show list_division([1..10],5);
show list_division([1..3],4);
show list_division([72,57,89,55,36,84,10,95,99,35],7);