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

TWC387

Challenge Link

Task1

We replace "01" with "10" until none exists:

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

sub rearrange_binary_string{
  my ($s) = @_;
  my $c = 0;
  $c++ while $s =~ s/01/10/g;
  $c
}

is rearrange_binary_string('111000'),0,'Example 1';
is rearrange_binary_string('00011'),4,'Example 2';
is rearrange_binary_string('01011'),3,'Example 3';
is rearrange_binary_string('010101'),3,'Example 4';
is rearrange_binary_string('00001'),4,'Example 5';

done_testing();

Task2

We follow the given instructions:

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

sub rational_numbers{
  my ($s) = @_;
  my %h;
  $s =~ s/([A-Z][a-z]?)(\d+)/$1 x $2/gex;
  1 while $s =~ s/\(([^()]+)\) (\d+)/$1 x $2/gex;
  $h{$_}++ foreach $s =~ /[A-Z][a-z]?/gx;
  join '',map {$_ . ($h{$_} > 1 ? $h{$_} : '')} sort keys %h
}

is rational_numbers('((N2O)3(H2O)2)2'),'H8N12O10','Example 1';
is rational_numbers('Mg3(PO4)2'),'Mg3O8P2','Example 2';
is rational_numbers('(((H)2)3)4'),'H24','Example 3';
is rational_numbers('NaCl3(O2(S10)2)2Mg'),'Cl3MgNaO4S40','Example 4';
is rational_numbers('Z2Y3(X2W)2'),'W2X4Y3Z2','Example 5';

done_testing();

TWC386

Challenge Link

Task1

We do the conversion according to the given base:

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

my $i = 0;
my %val = map {$_ => $i++} 0..9,'A'..'Z','a'..'z','+','/';

sub reverse_base{
  my ($num,$base) = @_;
  my $res = 0;
  for(my $n = 1; length $num; $n *= $base) {
    $res += $n * $val{substr $num,-1,1,''}
  }
  $res
}

is reverse_base('101010',2),42,'Example 1';
is reverse_base('EEADEE',16),15642094,'Example 2';
is reverse_base('755',8),493,'Example 3';
is reverse_base('1BRJB',36),2228519,'Example 4';
is reverse_base('7MyqL',64),123456789,'Example 5';

done_testing();

Task2

We find if the two rationals are equal:

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

sub rational_numbers{
  my ($rat1,$rat2) = @_;
  my @rats;
  foreach my $r($rat1,$rat2) {
    $r .= '.' if -1 == index $r,'.';
    $r =~ /([-+]?\d+)\.(\d*)(?:\((\d+)\))?$/;
    my ($int,$prefix,$repeated) = @{^CAPTURE};
    $repeated //= '';
    $repeated = $1 if $repeated =~ /^(.+?)\1+$/;
    while(length $repeated &&
	  substr($repeated,-1,1) eq substr $prefix,-1,1) {
      substr $repeated,0,0,substr $prefix,-1,1,'';
      substr $repeated,-1,1,'';
      if('9' eq $repeated) {
	$repeated = '';
	if(length $prefix) {
	  if($prefix =~ /9$/) {
	    $prefix =~ s/9+$//;
	    if(length $prefix) {
	      ++$prefix
	    } else {
	      ++$int
	    }
	  } else {
	    ++$prefix
	  }
	} else {
	  ++$int
	}
	last
      }
    }
    $repeated = '' if '0' eq $repeated;
    $prefix = '' if '' eq $repeated && '0' eq $prefix;
    push @rats,"$int|$prefix|$repeated"
  }
  return $rats[0] eq $rats[1]
}

is rational_numbers('0.(12)','0.(121)'),'','Example 1';
is rational_numbers('0.1(23)','0.12(32)'),1, 'Example 2';
is rational_numbers('0.1(234)','0.12(342)'),1,'Example 3';
is rational_numbers('12.99(99)','13.'),1,'Example 4';
is rational_numbers('0.(123)','0.1(231)'),1,'Example 5';

done_testing();

TWC385

Challenge Link

Task1

We look for words uncommon to both strings:

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

sub uncommon_words{
  my %h;
  $h{$_}++ foreach split /\s+/,"$_[0] $_[1]";
  grep {$h{$_} == 1} keys %h
}

show uncommon_words('apple banana apple','banana orange');
show uncommon_words('cat dog','bird fish');
show uncommon_words('the quick brown fox','the quick');
show uncommon_words('hello','hello');
show uncommon_words('blue blue red','red green green yellow');

Task2

We remove outermost parentheses:

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

sub outermost_parentheses{
  my %h = ('(' => 1, ')' => 0);
  my $depth = 0;
  join '',
    map $h{$_} == ($depth += $_ eq '(' ? 1 : -1) ? '' : $_,
    split '',$_[0]
}

is outermost_parentheses('()()()'),'','Example 1';
is outermost_parentheses('(((())))'),'((()))','Example 2';
is outermost_parentheses('(()())(())'),'()()()','Example 3';
is outermost_parentheses('()((()))()'),'(())','Example 4';
is outermost_parentheses('(()(()))(()())'),'()(())()()','Example 5';

done_testing();