TWC379

Challenge Link

Task1

We reverse the string:

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

sub reverse_string{
  my ($s) = @_;
  my $res = '';
  $res .= chop $s while length $s;
  $res
}

printf "%s\n",reverse_string('');
printf "%s\n",reverse_string('reverse the given string');
printf "%s\n",reverse_string('Perl is Awesome');
printf "%s\n",reverse_string('v1.0.0-Beta!');
printf "%s\n",reverse_string('racecar');

Task2

We find all armstrong numbers under the given limit:

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

sub is_armstrong{
  my ($base,$limit) = @_;
  grep{
    my ($v,$sum,@digits) = (0,0,split '',$_);
    $v = $v * $base + $_,$sum += $_ ** @digits for @digits;
    $v == $sum
  } 0..$limit
}

show is_armstrong(10,1000);
show is_armstrong(7,1000);
show is_armstrong(16,1000);

TWC373

Challenge Link

Task1

We concatenate two string lists to strings and check for equality:

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

sub equal_list{
  (join '',@{$_[0]}) eq (join '',@{$_[1]})
}

printf "%d\n",equal_list(['a','bc'],['ab','c']);
printf "%d\n",equal_list(['a','b','c'],['a','bc']);
printf "%d\n",equal_list(['a','bc'],['a','c','b']);
printf "%d\n",equal_list(['ab','c',''],['','a','bc']);
printf "%d\n",equal_list(['p','e','r','l'],['perl']);

Task2

We try to divide the list two equal parts as long as possible:

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

sub list_division{
  my ($arr,$n) = @_;
  my $sz = int(@$arr / $n);
  return -1 if $n > @$arr;

  my $rest = @$arr % $n;
  my @res;
  foreach my $i(1..$n){
    push @res,[splice @$arr,0,$sz + ($i <= $rest)]
  }
  @res
}

show list_division([1..5],2);
show list_division([1..6],3);
show list_division([1..3],2);
show list_division([1..10],5);
show list_division([1..3],4);
show list_division([72,57,89,55,36,84,10,95,99,35],7);

TWC378

Challenge Link

Task1

We find the second largest number after filtering alphabetic characters:

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

sub second_largest_digit{
  (sort {$b <=> $a} uniq $_[0] =~ /\d/g)[1] // -1
}

show second_largest_digit('aaaaa77777');
show second_largest_digit('abcde');
show second_largest_digit('9zero8eight7seven9');
show second_largest_digit('xyz9876543210');
show second_largest_digit('4abc4def2ghi8jkl2');

Task2

We calculate the sum of each character and see if the sum of first two is equal the third string:

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

sub f{
  reduce {$a * 10 - (ord($b) - ord('a'))} 0, split '',$_[0];
}

sub sum_of_words{
  f($_[0]) + f($_[1]) == f($_[2])
}

show sum_of_words('acb','cba','cdb');
show sum_of_words('aab','aac','ad');
show sum_of_words('bc','je','jg');
show sum_of_words('a','aaaa','aa');
show sum_of_words('c','d','h');
show sum_of_words('gfi','hbf','bdhd');

TWC362

Challenge Link

Task1

We repeat each letter i times:

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

sub echo_chamber{
  my ($s) = @_;
  my @res;
  foreach my $i(0..length($s)-1) {
    push @res,substr($s,$i,1) x ($i+1)
  }
  join '',@res
}

printf "%s\n",echo_chamber('abca');
printf "%s\n",echo_chamber('xyz');
printf "%s\n",echo_chamber('code');
printf "%s\n",echo_chamber('hello');
printf "%s\n",echo_chamber('a');

Task2

We spell out the numbers according to this algorithm:

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

sub to_en{
  my ($n) = @_;
  return 'minus ' . to_en(-$n) if $n < 0;
  my @units = qw(zero one two three four five six seven eight nine);
  my %teens = (10 => 'ten',11 => 'eleven',12 => 'twelve',
	       13 => 'thirteen',14 => 'fourteen', 15 => 'fifteen',
	       16 => 'sixteen',17 => 'seventeen', 18 => 'eighteen',
	       19 => 'nineteen');
  my %tens = (20 => 'twenty',30 => 'thirty', 40 => 'forty',
	      50 => 'fifty',60 => 'sixty',70 => 'seventy',
	      80 => 'eighty',90 => 'ninety');

  return $units[$n] if $n < 10;
  return $teens{$n} if $n < 20;

  if($n < 100) {
    my $t = int($n / 10) * 10;
    my $u = $n % 10;
    return $u == 0 ? $tens{$t} : "$tens{$t}-$units[$u]"
  }

  if($n < 1000) {
    my $h = int($n/100);
    my $r = $n % 100;
    my $base = "$units[$h] hundred";
    return $r == 0 ? $base : "$base and " . to_en($r)
  }
  
  if($n < 1_000_000) {
    my $th = int($n/1000);
    my $r = $n % 1000;
    my $base = to_en($th) . ' thousand';
    return $r == 0 ? $base : "$base " . to_en($r)
  }

  die "Number is out of supported range\n"
}

sub spellbound_sorting{
  my ($arr) = @_;
  my %words;
  foreach my $n(@$arr){$words{$n} = to_en($n)}
  sort {$words{$a} cmp $words{$b}} @$arr
}

show spellbound_sorting([6,7,8,9,10]);
show spellbound_sorting([-3,0,1000,99]);
show spellbound_sorting([1,2,3,4,5]);
show spellbound_sorting([0,-1,-2,-3,-4]);
show spellbound_sorting([100,101,102]);

TWC361

Challenge Link

Task1

We calculate the zeckendorf representation of the given number:

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

sub zeckendorf_representation{
  my ($n) = @_;
  my @fibs = (1,2);
  push @fibs,$fibs[-1] + $fibs[-2] while($fibs[-1] + $fibs[-2] <= $n);
  
  my ($i,$rem,@parts) = ($#fibs,$n);
  while($rem) {
    if($fibs[$i] <= $rem) {
      push @parts,$fibs[$i];
      $rem -= $fibs[$i];
      $i -= 2;
    } else {
      --$i
    }
  }
  @parts
}

show zeckendorf_representation(4);
show zeckendorf_representation(12);
show zeckendorf_representation(20);
show zeckendorf_representation(96);
show zeckendorf_representation(100);

Task2

We find person who doesn't know anybody else:

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

sub find_celebrity{
  my ($party) = @_;
  my $n = @$party;
  return -1 if $n == 0;

  my $cand = 0;
  foreach my $i(1..$n-1) {
    $cand = $i if($party->[$cand][$i]);
  }
  
  foreach my $i(0..$n-1) {
    next if $i == $cand;
    return -1 if($party->[$cand][$i] || !$party->[$i][$cand]);
  }
  $cand
}

printf "%d\n",find_celebrity([[0,0,0,0,1,0],
			      [0,0,0,0,1,0],
			      [0,0,0,0,1,0],
			      [0,0,0,0,1,0],
			      [0,0,0,0,0,0],
			      [0,0,0,0,1,0]]);
printf "%d\n",find_celebrity([[0,1,0,0],
			      [0,0,1,0],
			      [0,0,0,1],
			      [1,0,0,0]]);
printf "%d\n",find_celebrity([[0,0,0,0,0],
			      [1,0,0,0,0],
			      [1,0,0,0,0],
			      [1,0,0,0,0],
			      [1,0,0,0,0]]);
printf "%d\n",find_celebrity([[0,1,0,1,0,1],
			      [1,0,1,1,0,0],
			      [0,0,0,1,1,0],
			      [0,0,0,0,0,0],
			      [0,1,0,1,0,0],
			      [1,0,1,1,0,0]]);
printf "%d\n",find_celebrity([[0,1,1,0],
			      [1,0,1,0],
			      [0,0,0,0],
			      [0,0,0,0]]);
printf "%d\n",find_celebrity([[0,0,1,1],
			      [1,0,0,0],
			      [1,1,0,1],
			      [1,1,0,0]]);

TWC360

Challenge Link

Task1

We justify the text according to the given width:

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

sub text_justifier{
  my $diff = $_[1] - length($_[0]);
  die "Length too short!" if($diff < 0);
  my $l = int($diff / 2);
  my $r = $diff - $l;
  '*' x $l . $_[0] . '*' x $r
}

printf "%s\n",text_justifier('Hi',5);
printf "%s\n",text_justifier('Code',10);
printf "%s\n",text_justifier('Hello',9);
printf "%s\n",text_justifier('Perl',4);
printf "%s\n",text_justifier('A',7);
printf "%s\n",text_justifier('',5);

Task2

We sort the case-folded words and join them back into a string:

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(fc);

sub word_sorter{
  join ' ',sort {fc($a) cmp fc($b)} split /\s+/,$_[0];
}

printf "%s\n",word_sorter('The quick brown fox');
printf "%s\n",word_sorter('Hello    World!   How   are you?');
printf "%s\n",word_sorter('Hello');
printf "%s\n",word_sorter('Hello, World! How are you?');
printf "%s\n",word_sorter('I have 2 apples and 3 bananas!');

TWC359

Challenge Link

Task1

We keep on summing the digits of the number until we reach a number with a single digit:

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

sub digital_root {
  my ($n) = @_;
  my $c = 0;
  $c++, $n = sum0 split '',$n while $n > 9;
  printf "Persistence  = %d\nDigital Root = %d\n",$c,$n
}

digital_root(38);
digital_root(7);
digital_root(999);
digital_root(1999999999);
digital_root(101010);

Task2

We keep on removing duplicate characters until there's none:

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

sub string_reduction{
  my ($s) = @_;
  1 while $s =~ s/(\w)\1//g;
  $s
}

printf "%s\n",string_reduction('aabbccdd');
printf "%s\n",string_reduction('abccba');
printf "%s\n",string_reduction('abcdef');
printf "%s\n",string_reduction('aabbaeaccdd');
printf "%s\n",string_reduction('mississippi');