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