TWC353

Challenge Link

Task1

We find the sentence with maximum words:

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

sub max_words{
  max map{scalar split} @{$_[0]}
}

printf "%d\n",max_words(['Hello world',
			 'This is a test','Perl is great']);
printf "%d\n",max_words(['Single']);
printf "%d\n",max_words(['Short',
			 'This sentence has six words in total',
			 'A B C',
			 'Just four words here']);
printf "%d\n",max_words(['One','Two parts','Three part phrase','']);
printf "%d\n",max_words(['The quick brown fox jumps over the lazy dog',
			 'A',
			 'She sells seashells by the seashore',
			 'To be or not to be that is the question']);

Task2

We simulate the solution and check for the given conditions:

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

sub validate_coupon{
  my %valid;
  @valid{qw(electronics grocery pharmacy restaurant)} = 1;
  map {$_[0]->[$_] =~ /^[_0-9a-zA-Z]+$/ &&
	 exists $valid{$_[1]->[$_]} &&
	 $_[2]->[$_] eq 'true' ? 1 : 0} 0..$#{$_[0]}
}

printf "(%s)\n", join ',',
  validate_coupon(['A123','B_456','C789','D@1','E123'],
		  ['electronics','restaurant','electronics',
		   'pharmacy','grocery'],
		  ['true','false','true','true','true']);
printf "(%s)\n", join ',',
  validate_coupon(['Z_9','AB_12','G01','X99','test'],
		  ['pharmacy','electronics','grocery',
		   'electronics','unknown'],
		  ['true','true','false','true','true']);
printf "(%s)\n", join ',',
  validate_coupon(['_123','123','','Coupon_A','Alpha'],
		  ['restaurant','electronics','electronics',
		   'pharmacy','grocery'],
		  ['true','true','false','true','true']);
printf "(%s)\n", join ',',
  validate_coupon(['ITEM_1','ITEM_2','ITEM_3','ITEM_4'],
		  ['electronics','electronics','grocery','grocery'],
		  ['true','true','true','true']);
printf "(%s)\n", join ',',
  validate_coupon(['CAFE_X','ELEC_100','FOOD_1','DRUG_A','ELEC_99'],
		  ['restaurant','electronics','grocery',
		   'pharmacy','electronics'],
		  ['true','true','true','true','false']);

TWC352

Challenge Link

Task1

We return every string that is a substring of amother:

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

sub match_string{
  my ($arr) = @_;
  my @res;
  foreach my $i(0..$#$arr) {
    my $x = $arr->[$i];
    foreach my $j(0..$#$arr) {
      my $y = $arr->[$j];
      if($i != $j && index($y,$x) != -1 && !any{$_ eq $x} @res) {
	push @res,$x;
	last
      }
    }
  }
  @res
}

printf "(%s)\n",join ', ',match_string(['cat','cats','dog','dogcat',
				       'dogcat','rat','ratcatdogcat']);
printf "(%s)\n",join ', ',
  match_string(['hello','hell','world','wor','ellow','elloworld']);
printf "(%s)\n",join ', ',
  match_string(['a', 'aa', 'aaa', 'aaaa']);
printf "(%s)\n",join ', ',
  match_string(['flower','flow','flight','fl','fli','ig','ght']);
printf "(%s)\n",join ', ',
  match_string(['car','carpet','carpenter','pet',
		'enter','pen','pent']);

Task2

We check if the accumulated binary number is divisible by 5 and accumulate the boolean results in an array:

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

sub binary_prefix{
  my @res;
  my $x = 0;
  foreach(@{$_[0]}){
    $x = ($x << 1 | $_) % 5;
    push @res,$x == 0 ? 1 : 0;
  }
  @res
}

printf "(%s)\n", join ', ', binary_prefix([0,1,1,0,0,1,0,1,1,1]);
printf "(%s)\n", join ', ', binary_prefix([1,0,1,0,1,0]);
printf "(%s)\n", join ', ', binary_prefix([0,0,1,0,1]);
printf "(%s)\n", join ', ', binary_prefix([1,1,1,1,1]);
printf "(%s)\n", join ', ', binary_prefix([1,0,1,1,0,1,0,0,1,1]);

TWC351

Challenge Link

Task1

We sort the array and remove the minimum and maximum elements then take the average:

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

sub special_average{
  my ($arr) = @_;
  return 0 if @$arr < 2;
  @$arr = sort {$a <=> $b} @$arr;
  my @sub = splice @$arr,1,$#$arr-1;
  (sum0 @sub) / @sub
}

printf "%d\n",special_average([8000,5000,6000,2000,3000,7000]);
printf "%d\n",special_average([100_000,80_000,110_000,90_000]);
printf "%d\n",special_average([2500,2500,2500,2500]);
printf "%d\n",special_average([2000]);
printf "%d\n",special_average([1000,2000,3000,4000,5000,6000]);

Task2

We sort the array and then check if the distance of all elements is the same:

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

sub arithmetic_progression{
  my ($arr) = @_;
  @$arr = sort {$a <=> $b} @$arr;
  my $d = abs(shift(@$arr) - shift(@$arr));
  for(my $i = 0; $i < $#$arr-1; ++$i){
    return 0 if abs($arr->[$i] - $arr->[$i+1]) != $d
  }
  1
}

printf "%d\n",arithmetic_progression([1,3,5,7,9]);
printf "%d\n",arithmetic_progression([9,1,7,5,3]);
printf "%d\n",arithmetic_progression([1,2,4,8,16]);
printf "%d\n",arithmetic_progression([5,-1,3,1,-3]);
printf "%d\n",arithmetic_progression([1.5,3,0,4.5,6]);

TWC350

Challenge Link

Task1

We count all strings of length 3 with no repeating characters:

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

sub good_substrings{
  scalar grep {!/(.).*\1/} $_[0] =~ /(?=(...))/g
}

printf "%d\n",good_substrings('abcaefg');
printf "%d\n",good_substrings('xyzzabc');
printf "%d\n",good_substrings('aababc');
printf "%d\n",good_substrings('qwerty');
printf "%d\n",good_substrings('zzzaaa');

Task2

We find all shuffle pairs between the given ranges:

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

sub shuffle_pairs{
  my ($from,$to,$count) = @_;
  my $found = 0;
  foreach my $n($from..$to){
    my $c = 0;
    my $s = join '',sort split '',$n;
    foreach my $w(2..9){
      my $m = $n * $w;
      next if length $m > length $n;
      next if $s ne join '',sort split '',$m;
      ++$c
    }
    ++$found if $c >= $count
  }
  $found
}

printf "%d\n",shuffle_pairs(1,1000,1);
printf "%d\n",shuffle_pairs(1500,2500,1);
printf "%d\n",shuffle_pairs(1_000_000,1_500_000,5);
printf "%d\n",shuffle_pairs(13_427_000,14_100_000,2);
printf "%d\n",shuffle_pairs(1030,1130,1);

TWC349

Challenge Link

Task1

We count the longest sequence of equal characters:

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

sub power_string{
  my ($res,$temp) = (1,1);
  my @chars = split '',$_[0];
  foreach my $i(1..$#chars){
    if($chars[$i] eq $chars[$i-1]) {$res = max($res,++$temp)}
    else {$temp = 1}
  }
  $res
}

printf "%d\n",power_string("textbook");
printf "%d\n",power_string("aaaaa");
printf "%d\n",power_string("hoorayyy");
printf "%d\n",power_string("x");
printf "%d\n",power_string("aabcccddeeffffghijjk")

Task2

We simulate the rotations and check if both x and y are zero:

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

sub meeting_point{
  my ($x,$y) = (0,0);
  foreach my $c(split '',$_[0]){
    if($c eq 'U') {++$y}
    elsif($c eq 'R') {++$x}
    elsif($c eq 'D') {--$y}
    elsif($c eq 'L') {--$x}
  }
  $x == $y == 0
}

printf "%d\n",meeting_point("ULD");
printf "%d\n",meeting_point("ULDR");
printf "%d\n",meeting_point("UUURRRDDD");
printf "%d\n",meeting_point("UURRRDDLLL");
printf "%d\n",meeting_point("RRUULLDDRRUU")

TWC348

Challenge Link

Task1

We split the string in half and count the vowels of each half:

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

sub string_alike{
  my $h = length($_[0]) / 2;
  my $a = (substr $_[0],0,$h) =~ tr/aeiouAEIOU//;
  my $b = (substr $_[0],$h) =~ tr/aeiouAEIOU//;
  $a == $b && $a != 0
}

printf "%d\n",string_alike('textbook');
printf "%d\n",string_alike('book');
printf "%d\n",string_alike('AbCdEfGh');
printf "%d\n",string_alike('rhythmmyth');
printf "%d\n",string_alike('UmpireeAudio')

Task2

We calculate the result by applying the given operations:

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

sub to_min{
  my @parts = split ':',$_[0];
  $parts[0] * 60 + $parts[1]
}

sub convert_time{
  my $diff = (to_min($_[1]) - to_min($_[0]) + 1440) % 1440;
  my $res = 0;
  foreach my $i(qw(60 15 5 1)) {
    $res += $diff / $i;
    $diff %= $i
  }
  $res
}

printf "%d\n",convert_time('02:30','02:45');
printf "%d\n",convert_time('11:55','12:15');
printf "%d\n",convert_time('09:00','13:00');
printf "%d\n",convert_time('23:45','00:30');
printf "%d\n",convert_time('14:20','15:25')

TWC347

Challenge Link

Task1

We format the date accordingly:

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

sub format_date{
  my @s = split ' ',$_[0];
  my $months = "JanFebMarAprMayJunJulAugSepOctNovDec";
  my $day = substr $s[0],0,length($s[0]) - 2;
  my $month = index($months,$s[1]) / 3 + 1;
  sprintf "%s-%02d-%02d",$s[2],$month,$day
}

printf "%s\n",format_date("1st Jan 2025");
printf "%s\n",format_date("22nd Feb 2025");
printf "%s\n",format_date("15th Apr 2025");
printf "%s\n",format_date("23rd Oct 2025");
printf "%s\n",format_date("31st Dec 2025");

Task2

We format the phone number accordingly:

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

sub format_phone_number{
  my ($phone) = @_;
  s/[- ]//g,
  s/(...)/$1-/g,
  s/-(.?)$/$1/,
  s/(^|-)(\d{2})(\d{2})$/$1$2-$3/ for $phone;
  $phone
}

printf "%s\n",format_phone_number('1-23-45-6');
printf "%s\n",format_phone_number('1234');
printf "%s\n",format_phone_number('12 345-6789');
printf "%s\n",format_phone_number('123 4567');
printf "%s\n",format_phone_number('123 456-78')