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

TWC281

Challenge Link

Task1

By observing the chessboard we can see that the if the sum of the coordinates of a square is odd, then the square is white, and black otherwise:

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

sub check_color{
  (ord(substr $_[0],0,1) + substr $_[0],1,1) % 2
}

printf "%d\n",check_color('d3');
printf "%d\n",check_color('g5');
printf "%d\n",check_color('e6');

Task2

This task can be solved using the BFS graph algorithm:

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

sub is_inside{
  $_[0] >= 0 && $_[0] <= $_[2]
    && $_[1] >= 0 && $_[1] <= $_[2]
}

sub min_steps{
  my ($k1,$k2,$t1,$t2,$n) = @_;
  my @dirs = ([-2,1],[-1,2],
	      [1,2],[2,1],
	      [2,-1],[1,-2],
	      [-1,-2],[-2,-1]);
  my (@queue,@visited);
  push @queue,[$k1,$k2,0];
  while(@queue){
    my $t = shift @queue;
    return $t->[2] if $t->[0] == $t1 && $t->[1] == $t2;
    foreach my $i(0..$#dirs){
      my $x = $t->[0] + $dirs[$i][0];
      my $y = $t->[1] + $dirs[$i][1];
      if(is_inside($x,$y,$n)){
	$visited[$x][$y] = 1;
	push @queue,[$x,$y,$t->[2]+1]
      }
    }
  }
  -1
}

sub knights_move{
  my ($s,$e) = @_;
  my ($k1,$k2,$t1,$t2) = (ord(substr($s,0,1)) - ord('a'),
			  substr($s,1,1) - '0',
			  ord(substr($e,0,1)) - ord('a'),
			  substr($e,1,1) - '0');
  min_steps($k1,$k2,$t1,$t2,8)
}

printf "%d\n",knights_move('g2','a8');
printf "%d\n",knights_move('g2','h2');

TWC280

Challenge Link

Task1

We basically count the number of occurrences of characters and return the duplicated one. We can do this more compactly with regexp:

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

sub twice_appearance{
  reverse($_[0]) =~ /.*(.).*?\1/
}

printf "%s\n",twice_appearance('acbddbca');
printf "%s\n",twice_appearance('abccd');
printf "%s\n",twice_appearance('abcdabbb');

Task2

We count the number of asterisks of the wanted portions of the string:

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

sub count_asterisks{
  my $str = $_[0] =~ s/\|[^\|]*\|//gmixr;
  $_ = () = $str =~ /(\*)/gmix;
}

printf "%d\n",count_asterisks('p|*e*rl|w**e|*ekly|');
printf "%d\n",count_asterisks('perl');
printf "%d\n",count_asterisks('th|ewe|e**|k|l***ych|alleng|e');