TWC394

Challenge Link

Task1

We find the minimum number of required swaps to make alternating string:

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

sub alternate_case{
  my ($s) = @_;
  my @upper;
  push @upper,$-[0] while($s =~ /[A-Z]/g);
  my $cost = sub {
    my ($start) = @_;
    my $total = 0;
    foreach my $i(0..$#upper) {
      my $target = $start + 2 * $i;
      $total += abs($upper[$i] - $target)
    }
    return $total
  };
  min($cost->(0),$cost->(1))
}

is alternate_case('aAbB'),0,'Example 1';
is alternate_case('AAbb'),1,'Example 2';
is alternate_case('AAAbbb'),3,'Example 3';
is alternate_case('aABb'),1,'Example 4';
is alternate_case('bBBAaa'),2,'Example 5';

done_testing();

Task2

We find the longest substring common to all elements of the array and which is alternating between consonants and vowels:

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

sub iv {return $_[0] =~ /[aeiou]/i ? 1 : 0}

sub alternating_vowels_consonants{
  my ($strs) = @_;
  my ($src,@others) = sort {length $a <=> length $b} @$strs;
  my $max = 0;
  my (@best,%seen);
  my $n = length $src;

  foreach my $i(0..$n-1){
    foreach my $j($i..$n-1){
      last if $j > $i &&
	iv(substr($src,$j,1)) 
	== iv(substr($src,$j-1,1));
      my $len = $j - $i + 1;
      next if $len < $max;

      my $sub = substr($src,$i,$len);
      next if grep {index(lc $_,lc $sub) < 0} @others;

      if($len > $max) {
	$max = $len;
	@best = ();
	%seen = ();
      }
      push @best,$sub unless $seen{$sub}++;
    }
  }
  \@best
}

is_deeply alternating_vowels_consonants(
  ['relocate','delocate','allocate']),['locate'],'Example 1';
is_deeply alternating_vowels_consonants(
  ['apple','banana','cherry']),[],'Example 2';
is_deeply alternating_vowels_consonants(
  ['navigate','cavity','gravity']),['avi'],'Example 3';
is_deeply alternating_vowels_consonants(
  ['pedalgia','pedalboard','pedantic']),['peda'],'Example 4';
is_deeply alternating_vowels_consonants(
  ['schoolmaster','schoolhouse','schooling']),['ho','ol'],'Example 5';

done_testing();

TWC393

Challenge Link

Task1

Solving this using Euclid's formula:

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

sub pythagoras_multiplied{
  my ($n) = @_;
  my $count = 0;
  for(my $m = 2; $m * $m + 1 <= $n; $m++){
    for(my $k = 1; $k < $m; $k++){
      next if (($m - $k) % 2 == 0) || gcd($m,$k) != 1;
      my $c = $m * $m + $k * $k;
      last if $c > $n && $k == 1;
      next if $c > $n;
      $count += 2 * int($n / $c)
    }
  }
  $count
}

is pythagoras_multiplied(20),12,'Example 1';
is pythagoras_multiplied(7),2,'Example 2';
is pythagoras_multiplied(1),0,'Example 3';
is pythagoras_multiplied(15),8,'Example 4';
is pythagoras_multiplied(30),22,'Example 5';

done_testing();

Task2

We find the sum of all ascii values in the string and check for primality:

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

sub prime_step{
  my $sum = sum0 map{ord} split '',$_[0];
  my $d = 0;
  while(1){
    return $d if is_prime($sum - $d) || is_prime($sum + $d);
    $d++
  }
}

is prime_step('hello'),9,'Example 1';
is prime_step('football'),2,'Example 2';
is prime_step('a'),0,'Example 3';
is prime_step('challenge'),2,'Example 4';
is prime_step('perl'),2,'Example 5';

done_testing();

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();

TWC388

Challenge Link

Task1

We find the dyck words using a stack:

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

sub dyck_words{
  my ($n) = @_;
  return [''] if $n == 0;
  my @res;
  my @stack = [0,0,''];
  while(@stack){
    my $state = pop @stack;
    my ($o,$c,$curr) = @$state;
    if($o == $n && $c == $n) {
      push @res,$curr;
      next
    }
    push @stack,[$o+1,$c,$curr . 'U'] if $o < $n;
    push @stack,[$o,$c+1,$curr . 'D'] if $c < $n && $o > $c;
  }
  @res = sort @res;
  \@res
}

is_deeply dyck_words(1),['UD'],'Example 1';
is_deeply dyck_words(2),['UDUD','UUDD'],'Example 2';
is_deeply dyck_words(3),['UDUDUD','UDUUDD','UUDDUD','UUDUDD',
			 'UUUDDD'],'Example 3';
is_deeply dyck_words(0),[''],'Example 4';
is_deeply dyck_words(4),['UDUDUDUD','UDUDUUDD','UDUUDDUD',
			 'UDUUDUDD','UDUUUDDD','UUDDUDUD',
			 'UUDDUUDD','UUDUDDUD','UUDUDUDD',
			 'UUDUUDDD','UUUDDDUD','UUUDDUDD',
			 'UUUDUDDD','UUUUDDDD'],'Example 5';

done_testing();

Task2

We find the number of valid gifts:

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

memoize qw(derange);
sub derange{
  my ($n) = @_;
  return 1 if $n == 0;
  $n * derange($n-1) + ($n % 2 == 0 ? 1 : -1)
}

is derange(1),0,'Example 1';
is derange(2),1,'Example 2';
is derange(3),2,'Example 3';
is derange(4),9,'Example 4';
is derange(5),44,'Example 5';

done_testing();