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

TWC293

Challenge Link

Task1

We count the similar dominos in a hash and return its sum:

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

sub similar_dominos{
  my %h;
  $h{join '',sort{$a <=> $b} @$_}++ foreach @{$_[0]};
  sum0 grep{$_>1} values %h
}

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

Task2

We check if 3 points form a boomerang as explained in here:

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

sub boomerang{
  my ($a) = @_;
  ($a->[1][1] - $a->[0][1]) * ($a->[2][0] - $a->[1][0]) !=
    ($a->[2][1] - $a->[1][1]) * ($a->[1][0] - $a->[0][0])
}

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

TWC290

Challenge Link

Task1

We check if the double of a key also exists in the hash:

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

sub double_exist{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  map{return 1 if exists $h{$_ * 2}} keys %h;
  0
}

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

Task2

After removing the spaces and using the last digit as the payload, then if the digit is less than 9, we add it to the sum, otherwise we clamp its double to be less than or equal to 9 and add it to the sum. Finally, we check if the sum of the accumulated result and the payload is divisible by 10:

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

sub luhns_algorithm{
  my ($str) = @_;
  $str =~ tr/0-9//dc;
  my $p = chop $str;
  my ($sum,$even) = (0) x 2;
  foreach my $d(reverse split '',$str){
    $sum += $even ? $d : 2 * $d > 9 ? 2 * $d - 9 : 2 * $d;
    $even = !$even
  }
  ($sum + $p) % 10 == 0
}

printf "%d\n",luhns_algorithm('17893729974');
printf "%d\n",luhns_algorithm('4137 8947 1175 5904');
printf "%d\n",luhns_algorithm('4137 8974 1175 5904');

TWC289

Challenge Link

Task1

We deduplicate and sort the array in descending order, then we take the third maximum number if there's one, otherwise we take the max number:

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

sub third_maximum{
  my @arr = sort{$b <=> $a} uniq @{$_[0]};
  $arr[2] // $arr[0]
}

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

Task2

For each line in the input file, we shuffle the middle letters of its words, and print that line:

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

die "No file provided!\n" unless @ARGV == 1;

while(<>){
  s/(\w)(\w*)(\w)/$1.join '',shuffle split '',$2.$3/ge;
  print
}

TWC286

Challenge Link

Task1

We pick a random word from the file:

#!/usr/bin/env perl
use strict;
use warnings;
use File::Slurp;

sub self_spammer{
  my @words = grep /\S/,split /\s/, read_file(__FILE__);
  $words[rand @words]
}

print self_spammer();

Task2

We reduce the array with min and max functions as stated in the problem description:

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

sub order_game{
  my ($arr) = @_;
  while(@$arr > 2){
    my @t;
    foreach my($a,$b,$c,$d)(@$arr){
      push @t,min($a,$b),max($c,$d)
    }
    @$arr = @t;
  }
  min @$arr
}

printf "%d\n",order_game([2,1,4,5,6,3,0,2]);
printf "%d\n",order_game([0,5,3,2]);
printf "%d\n",order_game([9,2,1,4,5,6,0,7,3,1,3,5,7,9,0,8]);

TWC285

Challenge Link

Task1

We are basically looking for a node in the graph with zero out degree:

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

sub no_connection{
  my ($arr) = @_;
  my (%destinations,%sources);
  foreach my $r(@{$arr}){
    $sources{$r->[0]} = $destinations{$r->[1]} = 1;
  }
  foreach my $d(keys %destinations){
    return $d unless exists $sources{$d}
  }
  ""
}

printf "%s\n",no_connection([["B","C"],["D","B"],["C","A"]]);
printf "%s\n",no_connection([["A","Z"]]);

Task2

We can use a tree to check for all the possible solutions, but dynamic programming is more efficient:

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

sub making_change{
  my ($amount) = @_;
  my @coins = (1,5,10,25,50);
  my @dp = (0) x ($amount+1);
  $dp[0] = 1;
  foreach my $c(@coins){
    foreach my $i($c..$amount) {
      $dp[$i] += $dp[$i-$c]
    }
  }
  $dp[$amount]
}

printf "%d\n",making_change(9);
printf "%d\n",making_change(15);
printf "%d\n",making_change(100);