TWC342

Challenge Link

Task1

We keep on alternating between digits and letters:

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

sub balance_string{
  my @chars = split '',$_[0];
  my @ds = grep{/\d/} @chars;
  my @ls = grep{/\D/} @chars;
  my ($m,$n) = (scalar @ds,scalar @ls);
  return '' if abs($m-$n) > 1;
  my $res;
  foreach my $i(0..min($m,$n)-1){
    if($m > $n) {
      $res .= $ds[$i] . $ls[$i]
    } else {
      $res .= $ds[$i] . $ls[$i]
    }
  }
  $res .= $ds[$m-1] if($m > $n);
  $res .= $ls[$n-1] if($m < $n);
  $res
}

printf "%s\n",balance_string('a0b1c2');
printf "%s\n",balance_string('abc12');
printf "%s\n",balance_string('0a2b1c3');
printf "%s\n",balance_string('1a23');
printf "%s\n",balance_string('ab123')

Task2

We find the max score by prefix sum:

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

sub max_score{
  my $res = 0;
  foreach my $i(1..(length $_[0])-1) {
    my $temp = 0;
    foreach my $j(0..$i-1) {
      $temp++ if (substr $_[0],$j,1) eq '0'
    }
    foreach my $j($i..(length $_[0])-1) {
      $temp++ if (substr $_[0],$j,1) eq '1'
    }
    $res = max $res,$temp;
  }
  $res
}

printf "%d\n",max_score('0011');
printf "%d\n",max_score('0000');
printf "%d\n",max_score('1111');
printf "%d\n",max_score('0101');
printf "%d\n",max_score('011101')

TWC341

Challenge Link

Task1

We count the words that doesn't include given chars:

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

sub broken_keyboard{
  my $chars = join '',@{$_[1]};
  scalar grep {$chars eq '' || !/[$chars]/i} split /\W+/,$_[0];
}

printf "%d\n",broken_keyboard('Hello World',['d']);
printf "%d\n",broken_keyboard('apple banana cherry',['a','e']);
printf "%d\n",broken_keyboard('Coding is fun',['']);
printf "%d\n",broken_keyboard('The Weekly Challenge',['a','b']);
printf "%d\n",broken_keyboard('Perl and Python',['p'])

Task2

We reverse the prefix before and including the given char and append to the rest of the string:

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

sub reverse_prefix{
  my ($str) = @_;
  $str =~ s/^(.*?$_[1])/reverse $1/e;
  $str
}

printf "%s\n",reverse_prefix('programming','g');
printf "%s\n",reverse_prefix('hello','h');
printf "%s\n",reverse_prefix('abcdefghij','h');
printf "%s\n",reverse_prefix('reverse','s');
printf "%s\n",reverse_prefix('perl','r')

TWC340

Challenge Link

Task1

We repeatedly remove adjacent duplicate characters until there's none left:

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

sub duplicate_removals{
  my ($str) = @_;
  while(1) {
    my $c = 0;
    $str =~ s/(.)\1//g and $c = 1;
    last unless $c
  }
  $str
}

printf "%s\n",duplicate_removals('abbaca');
printf "%s\n",duplicate_removals('azxxzy');
printf "%s\n",duplicate_removals('aaaaaaaa');
printf "%s\n",duplicate_removals('aabccba');
printf "%s\n",duplicate_removals('abcddcba')

Task2

We extract the numbers into an array, and check if that array is ascending:

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

sub is_ascending{
  foreach my $i(1..$#{$_[0]}) {
    return 0 if $_[0]->[$i] <= $_[0]->[$i-1]
  }
  1
}

sub ascending_numbers{
  my @arr = grep {/\d+/} split /\s+/,$_[0];
  is_ascending(\@arr)
}

printf "%d\n",ascending_numbers('The cat has 3 kittens 7 toys 10 beds');
printf "%d\n",ascending_numbers('Alice bought 5 apples 2 oranges 9 bananas');
printf "%d\n",ascending_numbers('I ran 1 mile 2 days 3 weeks 4 months');
printf "%d\n",ascending_numbers('Bob has 10 cars 10 bikes');
printf "%d\n",ascending_numbers('Zero is 0 one is 1 two is 2');

TWC339

Challenge Link

Task1

We sort the array then find the difference of the two smallest and largest pairs:

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

sub max_diff{
  my ($arr) = @_;
  @$arr = sort{$a <=> $b} @$arr;
  $arr->[-1] * $arr->[-2] - $arr->[0] * $arr->[1]
}

printf "%d\n",max_diff([5,9,3,4,6]);
printf "%d\n",max_diff([1,-2,3,-4]);
printf "%d\n",max_diff([-3,-1,-2,-4]);
printf "%d\n",max_diff([10,2,0,5,1]);
printf "%d\n",max_diff([7,8,9,10,10]);

Task2

We take the maximum of the running sum of the given array:

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

sub peak_point{
  my $s = 0;
  max 0,map {$s += $_} @{$_[0]}
}

printf "%d\n",peak_point([-5,1,5,-9,2]);
printf "%d\n",peak_point([10,10,10,-25]);
printf "%d\n",peak_point([3,-4,2,5,-6,1]);
printf "%d\n",peak_point([-1,-2,-3,-4]);
printf "%d\n",peak_point([-10,15,5]);

TWC338

Challenge Link

Task1

Sum each row and find their maximum:

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

sub highest_row{
  max map{sum0 @$_} @{$_[0]}
}

printf "%d\n",highest_row([[4,4,4,4],
			   [10,0,0,0],
			   [2,2,2,9]]);
printf "%d\n",highest_row([[1,5],
			   [7,3],
			   [3,5]]);
printf "%d\n",highest_row([[1,2,3],
			   [3,2,1]]);
printf "%d\n",highest_row([[2,8,7],
			   [7,1,3],
			   [1,9,5]]);
printf "%d\n",highest_row([[10,20,30],
			   [5,5,5],
			   [0,100,0],
			   [25,25,25]]);

Task2

Find maximum distance between all elements of two lists:

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

sub max_distance{
  my @pairs = map{
    my $x = $_;
    map {[$x,$_]} @{$_[1]}
  } @{$_[0]};
  max map {abs $_->[0] - $_->[1]} @pairs;
}

printf "%d\n",max_distance([4,5,7],[9,1,3,4]);
printf "%d\n",max_distance([2,3,5,4],[3,2,5,5,8,7]);
printf "%d\n",max_distance([2,1,11,3],[2,5,10,2]);
printf "%d\n",max_distance([1,2,3],[3,2,1]);
printf "%d\n",max_distance([1,0,2,3],[5,0]);

TWC337

Challenge Link

Task1

We count the numbers which are less than each element and store them at that element's index:

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

sub smaller_than_current{
  my %h = frequency(@{$_[0]});
  my @arr;
  foreach my $i(0..$#{$_[0]}) {
    my %h2 = %h{grep{$_ <= $_[0]->[$i]} keys %h};
    @arr[$i] = sum0(values %h2) - 1
  }
  @arr
}

print show smaller_than_current([6,5,4,8]);
print show smaller_than_current([7,7,7,7]);
print show smaller_than_current([5,4,3,2,1]);
print show smaller_than_current([-1,0,3,-2,1]);
print show smaller_than_current([0,1,1,2,0]);

Task2

We do the simulation on a row x col matrix and count the odd numbers:

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

sub odd_matrix{
  my ($row,$col,$m) = @_;
  my @g;
  push @g,[(0) x $col] foreach(0..$row-1);
  foreach my $p(@$m){
    foreach(0..$col-1) {
      ++$g[$p->[0]]->[$_]
    }
    foreach(0..$row-1){
      ++$g[$_]->[$p->[1]]
    }
  }
  my $res = 0;
  foreach my $i(0..$row-1){
    foreach my $j(0..$col-1) {
      $res++ if $g[$i][$j] % 2
    }
  }
  $res
}

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

TWC336

Challenge Link

Task1

We check if the gcd of the frequencies of the elements is greater than one:

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Show;
use List::Util qw(reduce);
use ntheory qw(gcd);

sub equal_group{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  (reduce{gcd($a,$b)} values %h) > 1
}

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

Task2

We use a stack to evaluate the RPN expression:

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

sub final_score{
  my @stk;
  for(@{$_[0]}) {
    if(/\d+/) {
      push @stk,$_
    } elsif($_ eq 'C') {
      pop @stk
    } elsif($_ eq 'D') {
      push @stk,$stk[-1] * 2
    } else {
      push @stk,$stk[-2] + $stk[-1]
    }
  }
  sum0 @stk
}

printf "%d\n",final_score(['5','2','C','D','+']);
printf "%d\n",final_score(['5','-2','4','C','D','9','+','+']);
printf "%d\n",final_score(['7','D','D','C','+','3']);
printf "%d\n",final_score(['-5','-10','+','D','C','+']);
printf "%d\n",final_score(['3','6','+','D','C','8','+','D',
			   '-2','C','+']);