TWC326

Challenge Link

Task1

We find day number using Time::Piece module:

#!/usr/bin/env perl
use strict;
use warnings;
use Time::Piece;

sub day_of_the_year{
  Time::Piece->strptime($_[0],'%Y-%m-%d')->yday + 1
}

printf "%d\n",day_of_the_year('2025-02-02');
printf "%d\n",day_of_the_year('2025-04-10');
printf "%d\n",day_of_the_year('2025-09-07');

Task2

For each pair of numbers, we append the j value i times to the result:

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

sub decompressed_list{
  my ($arr) = @_;
  my ($i,@res) = (0);
  while($i < $#{$arr}){
    push @res, ($arr->[$i+1]) x $arr->[$i];
    $i += 2
  }
  @res
}

print show decompressed_list([1,3,2,4]);
print show decompressed_list([1,1,2,2]);
print show decompressed_list([3,1,3,2]);

TWC325

Challenge Link

Task1

We find the count of maximum runs of ones:

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

sub consecutive_one{
  max 0,map length,split /[^1]+/,join '',@{$_[0]}
}

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

Task2

We subtract each price from its immediate smaller price to find the discounts:

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

sub final_price {
  my ($p) = @_;
  my @stack;
  my @res = @$p;
  foreach my $i(0..$#$p){
    while(@stack && ($p->[$stack[-1]] >= $p->[$i])) {
      my $j = pop @stack;
      $res[$j] = $p->[$j] - $p->[$i]
    }
    push @stack,$i
  }
  @res
}

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

TWC324

Challenge Link

Task1

We take $c columns from the array each $r time through the map:

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

sub twod_array{
  my ($arr,$r,$c) = @_;
  map{[splice @$arr,0,$c]} 1..$r
}

print show twod_array([1,2,3,4],2,2);
print show twod_array([1,2,3],1,3);
print show twod_array([1,2,3,4],4,1);

Task2

We find the sum of xoring each subset of the array:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(subsets);
use List::Util qw(reduce);

sub total_xor{
  my $it = subsets($_[0]);
  my $sum = 0;
  while(my $s = $it->next){
    $sum += reduce {$a ^ $b} 0, @$s
  }
  $sum
}

printf "%d\n",total_xor([1,3]);
printf "%d\n",total_xor([5,1,6]);
printf "%d\n",total_xor([3,4,5,6,7,8]);

TWC323

Challenge Link

Task1

We increment and decrement x according to ++ or -- signs:

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

sub increment_decrement{
  my $x = 0;
  map{/\+\+/ ? $x++ : $x--} @{$_[0]};
  $x
}

printf "%d\n",increment_decrement(["--x","x++","x++"]);
printf "%d\n",increment_decrement(["x++","++x","x++"]);
printf "%d\n",increment_decrement(["x++","++x","--x","x--"]);

Task2

We calculate the tax amount according to the given formula:

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

sub tax_amount{
  my ($res,$prev) = (0,0);
  foreach(@{$_[1]}){
    $res += max(0,min($_[0],$_->[0]) - $prev) * $_->[1];
    $prev = $_->[0]
  }
  $res / 100.0
}

printf "%.2f\n",tax_amount(10,[[3,50],[7,10],[12,25]]);
printf "%.2f\n",tax_amount(2,[[1,0],[4,25],[5,50]]);
printf "%.2f\n",tax_amount(0,[[2,50]]);

TWC322

Challenge Link

Task1

We keep on grouping items from the right, then prepend the remainder and join the array with "-":

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

sub string_format{
  my $str = $_[0] =~ s/-//gr;
  my ($rem,@ret) = (length($str) % $_[1]);
  $rem and push @ret,substr($str,0,$rem,'');
  push @ret,substr($str,0,$_[1],'') while(length($str) > 0);
  join '-',@ret
}

printf "%s\n", string_format('ABC-D-E-F',3);
printf "%s\n", string_format('A-BC-D-E',2);
printf "%s\n", string_format('-A-B-CD-E',4);

Task2

We give each element its rank and put the ranks in their corresponding indices:

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

sub rank_array{
  my @uniq = sort{$a <=> $b} uniq @{$_[0]};
  my %h;
  @h{@uniq} = 1..@uniq;
  @h{@{$_[0]}}
}

print show rank_array([55,22,44,33]);
print show rank_array([10,10,10]);
print show rank_array([5,1,1,4,3]);

TWC321

Challenge Link

Task1

We sort the array and pair min and max elements, then take their averages and count the distinct ones:

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

sub distinct_average{
  my @arr = sort{$a <=> $b} @{$_[0]};
  my %h;
  undef $h{($arr[$_] + $arr[$#arr-$_]) / 2} foreach 0..@arr/2;
  scalar keys %h
}

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

Task2

We transform the strings by removing the characters when we see a # character, and then compare the strings:

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

sub backspace_compare{
  my ($s1,$s2) = @_;
  for($s1,$s2){
    1 while s/[^#]#//
  }
  $s1 eq $s2
}

printf "%d\n",backspace_compare('ab#c','ad#c');
printf "%d\n",backspace_compare('ab##','a#b#');
printf "%d\n",backspace_compare('a#b','c');

TWC320

Challenge Link

Task1

We find the max of count of negative and positive numbers:

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

sub maximum_count{
  my ($n,$p) = (0,0);
  map{if($_ != 0) {$_ < 0 ? $n++ : $p++}} @{$_[0]};
  max($n,$p)
}

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

Task2

We find the absolute value of sum of array and sum of each element's digits in the array:

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

sub sum_diffrence{
  abs(sum0(@{$_[0]}) - sum0(split '',join '',@{$_[0]}))
}

printf "%d\n",sum_diffrence([1,23,4,5]);
printf "%d\n",sum_diffrence([1,2,3,4,5]);
printf "%d\n",sum_diffrence([1,2,34]);