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

TWC284

Challenge Link

Task1

We look for the number which has a frequency equal to its value:

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

sub lucky_integer{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  max map{$h{$_} == $_ ? $_ : -1} keys %h
}

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

Task2

We sort the elements according to their order in the second list:

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Show;

sub relative_sort{
  my (%ranks,%ranked);
  $ranks{$_[1]->[$_]} = $_ foreach 0..$#{$_[1]};
  $ranked{$_} = defined $ranks{$_} ? 1 : 0 foreach @{$_[0]};
  sort{
    ($ranked{$b} <=> $ranked{$a}) ||
      ($ranks{$a} || 0) <=> ($ranks{$b} || 0) ||
      $a <=> $b
  } @{$_[0]}
}

print show relative_sort([2,3,9,3,1,4,6,7,2,8,5],[2,1,4,3,5,6]);
print show relative_sort([3,3,4,6,2,4,2,1,3],[1,3,2]);
print show relative_sort([3,0,5,0,2,1,4,1,1],[1,0,3,2]);

TWC283

Challenge Link

Task1

We deduplicate the list and see if only one item remains and return it, otherwise we return undef:

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

sub unique_number{
  my @arr = singleton @{$_[0]};
  @arr == 1 ? $arr[0] : undef
}

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

Task2

We take the frequency of the array elements, and see if all of them are equivalent to the corresponding elements of the array:

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

sub digit_count_value{
  my ($i,%h) = (0,frequency(@{$_[0]}));
  all{($h{$i++} // 0) == $_} @{$_[0]}
}

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

TWC282

Challenge Link

Task1

We check if there are 3 consecutive identical digits:

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

sub good_integer {
  $_[0] =~ /(\d)\1{2}(\1)?/ ? ($2 ? -1 : $1 x 3) : ()
}

print good_integer(12344456),"\n";
print good_integer(1233334),"\n";
print good_integer(10020003),"\n";

Task2

We count the number of letter changes:

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

sub changing_keys{
  my ($c,@arr) = (0,split '',lc $_[0]);
  foreach my $i(0..$#arr-1){
    $c++ if $arr[$i] ne $arr[$i+1]
  }
  $c
}

printf "%d\n",changing_keys('pPeERrLl');
printf "%d\n",changing_keys('rRr');
printf "%d\n",changing_keys('GoO');