TWC397

Challenge Link

Task1

We find the smallest number greater than average of the array:

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

sub absent_smallest_positive{
  my ($arr) = @_;
  my ($sum,%h);
  foreach(@$arr){
    $h{$_} = 1;
    $sum += $_;
  }
  my $ret = max(1,int($sum / @$arr) + 1);
  $ret++ while(exists $h{$ret});
  $ret
}

is absent_smallest_positive([1,2,4,5,6]),7,'Example 1';
is absent_smallest_positive([-5,-2,-1,3]),1,'Example 2';
is absent_smallest_positive([1..3]),4,'Example 3';
is absent_smallest_positive([2,3,7,8]),6,'Example 4';
is absent_smallest_positive([1,1,1,10]),4,'Example 5';

Task2

We first sort by binary representation, then by numbers themselves:

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

sub binary_reflection{
  my $rb = sub{oct('0b' . reverse sprintf("%b",shift))};
  [sort{$rb->($a) <=> $rb->($b) || $a <=> $b} @{$_[0]}]
}

is_deeply binary_reflection([3,6,12]),[3,6,12],'Example 1';
is_deeply binary_reflection([1,2,4,8]),[1,2,4,8],'Example 2';
is_deeply binary_reflection([7,8,9,10]),[8,10,7,9],'Example 3';
is_deeply binary_reflection([5,9,15,17]),[5,9,15,17],'Example 4';
is_deeply binary_reflection([11,13,14,19]),[14,13,11,19],'Example 5';

TWC396

Challenge Link

Task1

We sort the elements according to order array:

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

sub finishing_order{
  my %h;
  $h{$_} = 1 foreach @{$_[1]};
  [grep {$h{$_}} @{$_[0]}];
}

is_deeply finishing_order([3,1,4,2,5],[1,2,4]),[1,4,2],'Example 1';
is_deeply finishing_order([5,4,3,2,1],[1,3,5]),[5,3,1],'Example 2';
is_deeply finishing_order([2,4,1,3],[1,2,3,4]),[2,4,1,3],'Example 3';
is_deeply finishing_order([4,1,3,2],[3]),[3],'Example 4';
is_deeply finishing_order([1,3,2,6,5,4],[1,2,3]),[1,3,2],'Example 5';

Task2

We check if array is trionic:

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

sub trionic_array{
  my ($arr) = @_;
  my ($p,$n) = (0,scalar @$arr);
  $p++ while($p < $n - 2 && $arr->[$p] < $arr->[$p+1]);
  return '' if $p == 0;
  my $q = $p;
  $q++ while($q < $n-1 && $arr->[$q] > $arr->[$q+1]);
  return '' if $q == $p || $q == $n-1;
  $q++ while($q < $n-1 && $arr->[$q] < $arr->[$q+1]);
  $q == $n-1
}

is trionic_array([1,3,5,4,2,6,8]),1,'Example 1';
is trionic_array([1,4,4,2,1,3,5]),'','Example 2';
is trionic_array([2,10,3,1,9]),1,'Example 3';
is trionic_array([1,2,3,4,3,2,1]),'','Example 4';
is trionic_array([1,3,6,4,2,7,8,4]),'','Example 5';

TWC395

Challenge Link

Task1

We parse complex numbers and apply the given formula:

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

sub parse_complex{
  my ($s) = @_;
  if ($s =~ /^\s*(-?\d+)\s*\+\s*\(?\s*(-?\d+)\s*\)?\s*i\s*$/){
    return ($1, $2);
  }
  die "Invalid complex number: '$s'\n"
}

sub format_complex{
  my ($re,$im) = @_;
  my $str = $im < 0 ? "($im)" : "$im";
  "$re+${str}i"
}

sub complex_number{
  my ($n1,$n2) = @_;
  my ($a,$b) = parse_complex($n1);
  my ($c,$d) = parse_complex($n2);
  my $real = $a * $c - $b * $d;
  my $imag = $a * $d + $b * $c;
  format_complex($real,$imag)
}

is complex_number('1+1i','1+1i'),'0+2i','Example 1';
is complex_number('1+(-1)i','1+(-1)i'),'0+(-2)i','Example 2';
is complex_number('0+3i','0+4i'),'-12+0i','Example 3';
is complex_number('3+4i','3+(-4)i'),'25+0i','Example 4';
is complex_number('50+(-20)i','-10+30i'),'100+1700i','Example 5';

done_testing();

Task2

We use backtracking to find all the solutions:

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

sub word_squares{
  my ($words) = @_;
  return [] unless @$words;

  my ($n,@res,%used) = length $words->[0];
  
  my $solve;
  $solve = sub{
    my $k = @res;
    return 1 if $k == $n;
    my $prefix = join '',map{substr($res[$_],$k,1)} 0..$k-1;
    
    foreach my $i(0..$#$words){
      next if $used{$i};
      next unless substr($words->[$i],0,$k) eq $prefix;
      $used{$i} = 1;
      push @res,$words->[$i];
      return 1 if $solve->();
      pop @res;
      delete $used{$i}
    }
    0
  };

  my $found = $solve->();
  undef $solve;
  $found ? \@res : [];
}

is_deeply word_squares(['MA','AM','MY','ME']),['MA','AM'],'Example 1';

is_deeply word_squares(['SUN','USE','NET','SEE','TEN']),
  ['SUN','USE','NET'],'Example 2';

is_deeply word_squares(['BOAT','TEAL','AREA','TSAR','OGRE']),
  ['BOAT','OGRE','AREA','TEAL'],'Example 3';

is_deeply word_squares(['CARD','AREA','REAR','DART']),
  ['CARD','AREA','REAR','DART'],'Example 4';

is_deeply word_squares(['HEART','TREND','EMBER','RESIN','ABUSE']),
  ['HEART','EMBER','ABUSE','RESIN','TREND'],'Example 5';

done_testing();

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