TWC392

Challenge Link

Task1

We keep on adding characters till we find the palindrome:

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

sub convert_palindrome{
  my $r = reverse $_[0];
  my $n = length $_[0];
  foreach my $i(0..$n) {
    if(substr($_[0],0,$n-$i) eq substr($r,$i)) {
      return substr($r,0,$i) . $_[0]
    }
  }
}

is convert_palindrome('pinnipeds'),'sdepinnipeds','example 1';
is convert_palindrome('abcd'),'dcbabcd','example 2';
is convert_palindrome('bananas'),'sananabananas','example 3';
is convert_palindrome('dissident'),'tnedissident','example 4';
is convert_palindrome('cailliachs'),'shcailliachs','example 5';

done_testing();

Task2

We count the words that don't have any common letters and calculate the product of their lengths:

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

sub common_letters{
  my ($s1,$s2) = @_;
  my %h = map{$_ => 1} split '',$s1;
  any {$h{$_}} split '',$s2
}

sub words_length_product{
  my ($words) = @_;
  my $best = 0;
  foreach my $i(0..$#$words-1) {
    foreach my $j($i+1..$#$words) {
      my ($w1,$w2) = @{$words}[$i,$j];
      next if common_letters($w1,$w2);
      $best = max($best,length($w1) * length($w2))
    }
  }
  $best
}

is words_length_product(["a","ab","abc","d","de","def"]),9,
  'Example 1';
is words_length_product(["a","aa","aaa","aaaa"]),0,'Example 2';
is words_length_product(["meet","app","code","sky","bold"]),16,
  'Example 3';
is words_length_product(["a","ab","abc","abcd","efghi"]),20,
  'Example 4';
is words_length_product(["xyz","w","abcdefg","hij"]),21,'Example 5';

done_testing();

TWC391

Challenge Link

Task1

We merge and sort the arrays and then find the median:

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

sub array_median{
  my ($arr1,$arr2) = @_;
  my @merged = sort {$a <=> $b} (@$arr1,@$arr2);
  return 0.0 if @merged == 0;

  if(@merged % 2 == 1) {
    return $merged[int(@merged / 2)] + 0.0
  } else {
    my $left_middle = @merged / 2 - 1;
    return ($merged[$left_middle] + $merged[$left_middle+1]) / 2
  }
}

is array_median([2],[4]),3.0,'Example 1';
is array_median([1..3],[7..10]),7.0,'Example 2';
is array_median([],[10,20,30,40]),25.0,'Example 3';
is array_median([100],[1..7]),4.5,'Example 4';
is array_median([1,2,2],[2,2,3]),2.0,'Example 5';

done_testing();

Task2

We arrange the boxes so that they can fit in each other and count how many can:

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

sub arrange_box{
  my ($boxes) = @_;
  my @sorted = sort {$a->[0] <=> $b->[0] ||
		       $b->[1] <=> $a->[1]} @$boxes;
  
  my @heights = map {$_->[1]} @sorted;
  my $n = @heights;
  return 0 if $n == 0;
  
  my @dp = (1) x $n;
  my $max = 1;
  foreach my $i(0..$n-1) {
    foreach my $j(0..$i-1) {
      if($sorted[$j][0] < $sorted[$i][0] &&
	 $sorted[$j][1] < $sorted[$i][1] &&
	 $dp[$j] + 1 > $dp[$i]) {
	$dp[$i] = $dp[$j]+1;
	$max = $dp[$i] if $dp[$i] > $max
      }
    }
  }
  $max
}

is arrange_box([[1,3],[3,5],[6,8],[2,4]]),4,'Example 1';
is arrange_box([[4,5],[4,6],[6,7],[2,3],[4,3]]),3,'Example 2';
is arrange_box([[5,5],[5,5],[5,5]]),1,'Example 3';
is arrange_box([[2,100],[3,200],[4,300],[5,50],[5,400]]),
  4,'Example 4';
is arrange_box([[10,20],[15,10],[20,30],[12,18],[16,25]]),
  3,'Example 5';

done_testing();

TWC390

Challenge Link

Task1

We repeat each given character n times according to the given rules:

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

sub decode_string{
  my (@s1,@s2);
  my $num = 0;
  my $res = '';
  foreach my $c(split '',$_[0]){
    if($c =~ /\d/) {
      $num = $num * 10 + $c - '0'
    } elsif($c eq '[') {
      push @s1,$num;
      push @s2,$res;
      $num = 0;
      $res = ''
    } elsif($c eq ']') {
      my $t = '';
      for(my ($i,$n) = (0,pop @s1); $i < $n; ++$i) {
	$t .= $res
      }
      $res = (pop @s2) . $t
    } else {
      $res .= $c
    }
  }
  $res
}

is decode_string('2[3[a]]'),'aaaaaa','Example 1';
is decode_string('10[a]'),'aaaaaaaaaa','Example 2';
is decode_string('a2[b]c3[d]e'),'abbcddde','Example 3';
is decode_string('2[a2[b]c]'),'abbcabbc','Example 4';
is decode_string('1[a]2[b3[c]]'),'abcccbccc','Example 5';

done_testing();

Task2

We reorder characters until we find the smallest string:

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

sub order_characters{
  my ($s,$k) = @_;
  if ($k == 1) {
    my $n = length($s);
    my $doubled = $s . $s;
    my $best = substr($doubled,0,$n);
    foreach my $i(1..$n-1) {
      my $candidate = substr($doubled,$i,$n);
      $best = $candidate if $candidate lt $best
    }
    return $best
  } else {
    return join('',sort split '',$s)
  }
}

is order_characters('dbca',1),'adbc','Example 1';
is order_characters('geeks',2),'eegks','Example 2';
is order_characters('cbaed',3),'abcde','Example 3';
is order_characters('fedcba',4),'abcdef','Example 4';
is order_characters('perl',1),'erlp','Example 5';
is order_characters('oloolooo',1),'looloooo','Example 6';
is order_characters('oloooolo',1),'looloooo','Example 7';

done_testing();

TWC389

Challenge Link

Task1

We reorder notes according to the permutation array:

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

sub reorder_notes{
  my ($composer,$notes,$perm) = @{$_[0]};
  my @reordered;
  $reordered[$perm->[$_]-1] = $notes->[$_] foreach 0..$#$perm;
  uc($composer) . ' => ' . join ' ',@reordered
}

is reorder_notes(['Bach',['C','D','E','F#','G','A','B'],
		  [7,1,6,2,5,3,4]]),
  'BACH => D F# A B G E C','Example 1';
is reorder_notes(['Beethoven',
		  ['C','D','F#','G','Ab'],
		  [1, 3, 5, 2, 4]]),
  'BEETHOVEN => C G D Ab F#','Example 2';
is reorder_notes(['Brahms',
		  ['C','Db','Eb','F','G','Ab','Bb','C','D'],
		  [9,3,7,1,8,5,2,6,4]]),
  'BRAHMS => F Bb Db D Ab C Eb G C','Example 3';
is reorder_notes(['Bruckner',
		  ['G','F#','Bb','C','D','Eb','F'],
		  [4,7,2,6,1,5,3]]),
  'BRUCKNER => D Bb F G Eb C F#','Example 4';
is reorder_notes(['Berg',
		  ['C#'],
		  [1]]),'BERG => C#','Example 5';

done_testing();

Task2

We find the length of longest zig-zag subarray:

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

sub zig_zag_subarray{
  my ($arr) = @_;
  return 1 if @{$arr} == 1;
  return 2 if @{$arr} == 2 && $arr->[0] != $arr->[1];
  my ($max,$from,$to) = (1,0,0);
  while($to++ < $#$arr){
    $from = $to, next if $arr->[$to-1] == $arr->[$to];
    $from = $to-1, next if $to - $from > 1
      && ($arr->[$to] <=> $arr->[$to-1]) 
      == ($arr->[$to-1] <=> $arr->[$to-2]);
    my $curr = 1 + $to - $from;
    $max = $curr if $curr > $max
  }
  $max
}

is zig_zag_subarray([9,4,2,10,7,8,8,1,9]),5,'Example 1';
is zig_zag_subarray([1,7,4,9,2,5]),6,'Example 2';
is zig_zag_subarray([1..5]),2,'Example 3';
is zig_zag_subarray([4,4,4]),1,'Example 4';
is zig_zag_subarray([10,20,15,12,18]),3,'Example 5';

done_testing();