Tuesday, September 19, 2023

Task1

We are asked to see if by removing only one integer we can make the array to be in increasing order. We remove an element each time and check if without it the array is in ascending order or not:

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

sub is_ascending{
  my ($arr) = @_;
  my $cursor = 0;
  map{$cursor++ if $arr->[$_] < $arr->[$_+1]} 0..$#$arr-1;
  $cursor == $#$arr
}

sub remove_one{
  my @arr = @{$_[0]};
  my $res = 0;
  foreach my $i(0..$#arr){
    my @ret = @arr[0..$i-1,$i+1..$#arr];
    if($i == 0){@ret = @arr[1..$#arr]}
    elsif($i == $#arr){@ret = @arr[0..$#arr-1]}
    $res = 1 if is_ascending(\@ret);
  }
  $res
}

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

Task2

We are asked to duplicate any zero seen and stop when the array's length is equal to that of the original:

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

sub duplicate_zeros{
  my ($arr) = @_;
  my @ret;
  foreach(@$arr){
    last if @ret == @$arr;
    $_ == 0 ? splice @ret,@ret,0,0,0 : push @ret,$_;
  }
  @ret
}

printf "(%s)\n", join ',',duplicate_zeros([1,0,2,3,0,4,5,0]);
printf "(%s)\n", join ',',duplicate_zeros([1,2,3]);
printf "(%s)\n", join ',',duplicate_zeros([0,3,0,4,5]);

Wednesday, September 13, 2023

Task1

We are asked to find the common characters in all words including duplicates. First we count the characters of each string in a hash, then we take the first string's letters and their counts and see if they are duplicated in other ones and find the minimum of that which gives us the number of times that character needs to be repeated:

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

sub common_characters{
  my @letters;
  map{my %h; $h{$_}++ for split ''; push @letters,\%h} @{$_[0]};
  map{my $letter = $_;
      my $rep = min map{$letters[$_]{$letter} // 0} 0..$#letters;
      ($letter) x $rep
    } keys %{$letters[0]};
}

printf "(%s)\n", join ',',
  common_characters([qw/java javascript julia/]);
printf "(%s)\n", join ',',
  common_characters([qw/bella label roller/]);
printf "(%s)\n", join ',', common_characters([qw/cool lock cook/]);

Task2

We are asked to find the triplets (i,j,k) such that num[i] != num[j], num[j] != num[k], and num[k] != num[i]. First we find the unique items of the list, if the result is less than 3 items, then the answer would be zero since we don't have 3 items, else we find the sum of the product of every 3 item combinations of those items for the answer:

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

sub unequal_triplets{
  my %h;
  $h{$_}++ foreach @{$_[0]};
  my @keys = keys %h;
  @keys < 3 ? 0 : sum0 map{product @h{@$_}} combinations(\@keys,3);
}

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

Friday, September 8, 2023

TWC233

Challenge Link

Task1

We are asked to find and count the number of similar words. Two words are similar if they consist of the same characters. This can be done with sorting the unique characters of a string and keep their count in a hash:

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

sub similar_words{
  my ($count,%h) = (0);
  map{$h{join '',uniq sort split ''}++} @{$_[0]};
  $count += ($_ * ($_-1)) / 2 foreach values %h;
  $count
}

printf "%d\n", similar_words(["aba","aabb","abcd","bac","aabc"]);
printf "%d\n", similar_words(["aabb","ab","ba"]);
printf "%d\n", similar_words(["nba","cba","dba"]);

Task2

We are asked to sort an array based on the frequency of the items, and if the frequency of two items are the same, we have to sort them in decreasing order:

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

sub frequency_sort{
  my ($arr) = @_;
  my %h;
  $h{$_}++ foreach @$arr;
  sort{$h{$a} <=> $h{$b} || $b <=> $a} @$arr;
}

printf "(%s)\n", join ',', frequency_sort([1,1,2,2,2,3]);
printf "(%s)\n", join ',', frequency_sort([2,3,1,3,2]);
printf "(%s)\n", join ',', frequency_sort([-1,1,-6,4,5,-6,1,4,1]);

Monday, August 21, 2023

TWC231

Challenge Link

Task1

We are asked to find the min and max elements of the array and then return those elements which are not equal to them. If the array length is less than 3 items we simply return -1 since there cannot be any other elements than that of min and max:

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

sub min_max
{
  my ($arr) = @_;
  return "-1\n" if @$arr < 3;
  my ($min,$max) = (min(@$arr),max(@$arr));
  sprintf "(%s)\n", join ',', grep{$_ != $min && $_ != $max} @$arr;
}

print min_max([3,2,1,4]);
print min_max([3,1]);
print min_max([2,1,3]);

Task2

The age is in the 4th position from the end of the string so we use substr to extract that and count how many of them are greater than or equal to 60:

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

sub senior_citizens
{
  scalar grep{substr($_,-4,2) >= 60} @{$_[0]};
}

printf "%d\n",senior_citizens(["7868190130M7522",
			       "5303914400F9211",
			       "9273338290F4010"]);
printf "%d\n",senior_citizens(["1313579440F2036",
			       "2921522980M5644"]);

Monday, August 14, 2023

TWC230

Challenge Link

Task1

We are asked to break the numbers which are greater than 9 to their constituent digits and splice them into the array which can be simply done with a split on an empty string in Perl:

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

sub separate_digits
{
  map{split ''} @{$_[0]};
}

printf "(%s)\n", join ",", separate_digits([1,34,5,6]);
printf "(%s)\n", join ",", separate_digits([1,24,51,60]);

Task2

We are asked to count the words starting with a prefix, which can be done with the '^' symbol and the regexp's powerful mechanism. I've also used the quotemeta to escape magic characters so that the variable is correctly interpolated inside the regex pattern:

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

sub count_words
{
  scalar grep{/^\Q$_[1]/} @{$_[0]};
}

printf "%d\n",count_words([qw/pay attention practice attend/],'at');
printf "%d\n",count_words([qw/janet julia java javascript/],'ja');

Sunday, August 6, 2023

TWC229

Challenge Link

Task1

We are asked to delete the elements which are not lexicographically sorted forwards and backwards, and return the count of the deletions. We are actually not deleting anything from the array in the code, just counting them.

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

sub lexicographic_order
{
  my $count = 0;
  map{
    my $s = join '',sort split '';
    $count++ if(($s ne $_) && (reverse($s) ne $_))} @{$_[0]};
  $count;
}

printf "%d\n",lexicographic_order(["abc", "bce", "cae"]);
printf "%d\n",lexicographic_order(["yxz", "cba", "mon"]);

Task2

We are asked to return the elements present at least in 2 of the arrays, so this is a simple intersection which can be accomplished by counting the elements' occurrences with a hash.

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

sub two_out_of_three
{
  my %hash;
  map{$hash{$_}++ foreach uniq @$_} @{$_[0]};
  sort{$a <=> $b} grep{$hash{$_} >= 2} keys %hash
}

printf "(%s)\n", join ',' => two_out_of_three([[1,1,2,4],[2,4],[4]]);
printf "(%s)\n", join ',' => two_out_of_three([[4,1],[2,4],[1,2]]);

Monday, July 31, 2023

TWC228

Challenge Link

Task1

In this task we must remove the duplicate elements from the array, also removing the element which was a duplicate, then take the sum. This can be easily accomplished with a hash to count the frequency of elements:

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

sub unique_sum{
  my %hash;
  $hash{$_}++ foreach(@{$_[0]});
  sum0 grep{$hash{$_} == 1} keys %hash;
}

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

Task2

In this task we must remove the first element if it's the minimum element of the array otherwise we must append it to the array and keep doing this until the array becomes depleted, whilst keeping and returning the count of this operation:

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

sub empty_array{
  my ($count,$arr) = (0,@_);
  while(@$arr){
    $arr->[0] == min(@$arr) ? shift @$arr : push @$arr,shift @$arr;
    $count++
  }
  $count
}

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

Deadmarshal

Tuesday, September 19, 2023

TWC235

Task1

Task2

Wednesday, September 13, 2023

TWC234

Task1

Task2

Friday, September 8, 2023

TWC233

Task1

Task2

Monday, August 21, 2023

TWC231

Task1

Task2

Monday, August 14, 2023

TWC230

Task1

Task2

Sunday, August 6, 2023

TWC229

Task1

Task2

Monday, July 31, 2023

TWC228

Task1

Task2