TWC303

Challenge Link

Task1

We find all 3 variations of digits, and check if it is even, then remove the duplicates:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(variations);
use List::Util qw(uniq);
use Data::Show;

sub three_digits_even{
  @{$_[0]} = sort{$a <=> $b} @{$_[0]};
  uniq map{join '',@$_} grep{$_->[0] && !($_->[2] % 2)}
    variations($_[0],3)
}

print show three_digits_even([2,1,3,0]);
print show three_digits_even([2,2,8,8,2]);

Task2

We keep deleting and keeping points to get the final result:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);

sub delete_and_earn{
  my $max = max @{$_[0]};
  my @total = (0) x ($max+1);
  map{$total[$_] += $_} @{$_[0]};
  my $first = $total[0];
  my $second = max($total[0],$total[1]);
  foreach my $i(2..$max){
    my $curr = max(($first+$total[$i]),$second);
    $first = $second;
    $second = $curr
  }
  $second
}

printf "%d\n",delete_and_earn([3,4,2]);
printf "%d\n",delete_and_earn([2,2,3,3,3,4]);

TWC302

Challenge Link

Task1

For each combination of the array of size 1 to N, we check to see if the count of zeros and ones are subset of the given x and y:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(combinations);

sub ones_and_zeros{
  foreach my $s(reverse 1..@{$_[0]}){
    my $it = combinations($_[0],$s);
    while(my $comb = $it->next){
      my $joined = join '',@$comb;
      my $zeroes = $joined =~ tr/0//;
      my $ones = $joined =~ tr/1//;
      return $s if $zeroes <= $_[1] && $ones <= $_[2]
    }
  }
  0
}

printf "%d\n",ones_and_zeros(["10","0001","111001","1","0"],5,3);
printf "%d\n",ones_and_zeros(["10","1","0"],1,1);

Task2

We find the minimum value needed so that step-wide sum won't become less than 1:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(min max);

sub step_by_step{
  my $s = 0;
  my $t = $_[0]->[0];
  map{$s += $_; $t = min $t,$s} @{$_[0]};
  max 1,1-$t
}

printf "%d\n",step_by_step([-3,2,-3,4,2]);
printf "%d\n",step_by_step([1,2]);
printf "%d\n",step_by_step([1,-2,-3]);

TWC301

Challenge Link

Task1

We can find the largest number that can be formed from an array of numbers by sorting the string representation of those numbers:

#!/usr/bin/env perl
use strict;
use warnings;

sub largest_number{
  join '',sort {$b.$a <=> $a.$b} @{$_[0]}
}

printf "%s\n",largest_number([20,3]);
printf "%s\n",largest_number([3,30,34,5,9]);

Task2

We find the hamming distance of all the combinations of numbers and sum them:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(combinations);
use List::Util qw(sum0);

sub hamming_distance{
  sum0 map {sum0 split '',sprintf "%b",$_->[0] ^ $_->[1]}
    combinations($_[0],2)
}

printf "%d\n",hamming_distance([4,14,2]);
printf "%d\n",hamming_distance([4,14,4]);

TWC300

Challenge Link

Task1

We check the given condition for permutations of the sequence:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(permutations);

sub beautiful_arrangement{
  my $it = permutations([1..$_[0]]);
  my $c = 0;
 perm:
  while(my $p = $it->next){
    foreach my $i(1..$_[0]){
      next perm if $p->[$i-1] % $i && $i % $p->[$i-1]
    }
    $c++
  }
  $c
}

printf "%d\n",beautiful_arrangement(2);
printf "%d\n",beautiful_arrangement(1);
printf "%d\n",beautiful_arrangement(10);

Task2

We check for the given condition and find out the maximum:

#!/usr/bin/env perl
use strict;
use warnings;

sub nested_array{
  my ($arr) = @_;
  my $max = 0;
  foreach my $i(0..$#$arr){
    my $len = 0;
    my $set = $arr->[$i];
    my %used;
    while(!exists $used{$set}){
      undef $used{$set};
      $set = $arr->[$set];
      ++$len
    }
    $max = $len if $len > $max
  }
  $max
}

printf "%d\n",nested_array([5,4,0,3,1,6,2]);
printf "%d\n",nested_array([0,1,2]);

TWC299

Challenge Link

Task1

We keep on searching for the prefix of words in the given sentence:

#!/usr/bin/env perl
use strict;
use warnings;

sub replace_words{
  my @words = split ' ',$_[1];
  my %roots;
  $roots{$_} = 1 foreach @{$_[0]};
  foreach my $i(0..$#words){
    foreach my $j(1..length $words[$i]){
      my $sub = substr $words[$i],0,$j;
      if(defined $roots{$sub}){
	$words[$i] = $sub;
	last
      }
    }
  }
  join ' ',@words
}

printf "%s\n",replace_words(['cat', 'bat', 'rat'],
			    'the cattle was rattle by the battery');
printf "%s\n",replace_words(['a','b','c'],
			    'aab aac and cac bab');
printf "%s\n",replace_words(['man','bike'],
			    'the manager was hit by a biker');

Task2

We keep on searching for the characters of the word in all four possible directions:

#!/usr/bin/env perl
use strict;
use warnings;

my @dir = ([-1,0],[0,1],[1,0],[0,-1]);

sub word_search{
  my ($chars,$str) = @_;
  my $visited;
  foreach my $i(0..$#$chars){
    foreach my $j(0..$#{$chars->[0]}){
      return 1 if helper($chars,$visited,$str,0,$i,$j)
    }
  }
  0
}

sub is_inside{
  my ($chars,$x,$y) = @_;
  $x >= 0 && $x < @$chars && $y >= 0 && $y < @{$chars->[0]}
}

sub helper{
  my ($chars,$visited,$word,$index,$x,$y) = @_;
  if($index eq length($word)-1) {
    return $chars->[$x][$y] eq substr($word,$index,1)
  }
  if($chars->[$x][$y] eq substr($word,$index,1)) {
    $visited->[$x][$y] = 1;
    foreach my $i(0..$#dir) {
      my ($nx,$ny) = ($x + $dir[$i][0],$y + $dir[$i][1]);
      return 1 if is_inside($chars,$nx,$ny) &&
	!$visited->[$nx][$ny] &&
	helper($chars,$visited,$word,$index+1,$nx,$ny)
    }
  }
  0
}

printf "%d\n",word_search([['A', 'B', 'D', 'E'],
			   ['C', 'B', 'C', 'A'],
			   ['B', 'A', 'A', 'D'],
			   ['D', 'B', 'B', 'C']],'BDCA');
printf "%d\n",word_search([['A', 'A', 'B', 'B'],
			   ['C', 'C', 'B', 'A'],
			   ['C', 'A', 'A', 'A'],
			   ['B', 'B', 'B', 'B']],'ABAC');
printf "%d\n",word_search([['B', 'A', 'B', 'A'],
			   ['C', 'C', 'C', 'C'],
			   ['A', 'B', 'A', 'B'],
			   ['B', 'B', 'A', 'A']],'CCCAA');

TWC296

Challenge Link

Task1

We count the characters in a hash and add the counts and the corresponding characters to the resultant string:

#!/usr/bin/env perl
use strict;
use warnings;
use List::MoreUtils qw(uniq);

sub string_compression{
  my @chars = split '',$_[0];
  my ($ret,%h) = ('');
  $h{$_}++ foreach @chars;
  map{$ret .= $h{$_} == 1 ? $_ : $h{$_} . $_} uniq @chars;
  $ret
}

printf "%s\n",string_compression("abbc");
printf "%s\n",string_compression("aaabccc");
printf "%s\n",string_compression("abcc");

Task2

An explanation of this problem can be found here:

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(current_sub);
use List::Util qw(sum0);

sub matchstick_square{
  my ($arr) = @_;
  return 0 if sum0(@$arr) % 4 != 0;
  my $len = sum0(@$arr) / 4;
  @$arr = sort{$b <=> $a} @$arr;
  my @sides = (0) x 4;
  my $dfs = sub {
    my ($i) = @_;
    return $len == $sides[0] == $sides[1] ==
      $sides[2] == $sides[3] if $i == @$arr;
    foreach my $j(0..3){
      if($sides[$j] + $arr->[$i] <= $len){
	$sides[$j] += $arr->[$i];
	return 1 if(__SUB__->($i+1));
	$sides[$j] -= $arr->[$i]
      }
    }
    0
  };
  $dfs->(0)
}

printf "%d\n",matchstick_square([1,2,2,2,1]);
printf "%d\n",matchstick_square([2,2,2,4]);
printf "%d\n",matchstick_square([2,2,2,2,4]);
printf "%d\n",matchstick_square([3,4,1,4,3,1]);

TWC294

Challenge Link

Task1

We count the number of consecutive elements according to this algorithm. (We can also use a simple Perl hash instead of the Set::Scalar module):

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);
use Set::Scalar;

sub consecutive_sequence{
  my ($arr) = @_;
  my $s = Set::Scalar->new(@$arr);
  my $res = 0;
  foreach my $i(0..$#$arr){
    unless($s->has($arr->[$i]-1)){
      my $j = $arr->[$i];
      $j++ while($s->has($j));
      $res = max($res,$j - $arr->[$i])
    }
  }
  $res == 1 ? -1 : $res
}

printf "%d\n",consecutive_sequence([10,4,20,1,3,2]);
printf "%d\n",consecutive_sequence([0,6,1,8,5,2,4,3,0,7]);
printf "%d\n",consecutive_sequence([10,30,20]);

Task2

We find the next permutation of the array according to this algorithm.

#!/usr/bin/env perl
use strict;
use warnings;

sub next_permutation{
  my ($arr) = @_;
  my $p = -1;
  for(my $i = $#$arr-1; $i >= 0; --$i){
    do{$p = $i; last}if($arr->[$i] < $arr->[$i+1])
  }
  return reverse @$arr if $p == -1;
  for(my $i = $#$arr; $i >= $p+1; --$i){
    if($arr->[$i] > $arr->[$p]){
      ($arr->[$i],$arr->[$p]) = ($arr->[$p],$arr->[$i]);
      last
    }
  }
  @$arr
}

printf "(%s)\n",join ', ',next_permutation([1,2,3]);
printf "(%s)\n",join ', ',next_permutation([2,1,3]);
printf "(%s)\n",join ', ',next_permutation([3,1,2]);