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