Wednesday, September 27, 2023

TWC236

 Challenge Link

Task1

We are asked to see if we can return exact change while selling juice for $5 each. The inputs are only of 5,10, and 20 dollars. We check for each one and make our decision:


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/env perl
use strict;
use warnings;

sub exact_change{
  my ($arr) = @_;
  my %hash;
  foreach(@$arr){
    if($_ == 10){
      return 0 unless $hash{5}--;
    }
    elsif($_ == 20){
      $hash{5} && $hash{10} ? do{--$hash{$_} foreach(5,10)} :
      $hash{5} > 2 ? $hash{5} -= 3 : return 0;
    }
    $hash{$_}++;
  }
  1
}

printf "%d\n",exact_change([5,5,5,10,20]);
printf "%d\n",exact_change([5,5,10,10,20]);
printf "%d\n",exact_change([5,5,5,20]);

Task2

We are asked to count the loops in the array. To find a loop we start at an index and go to that index's element until we reach that first index again:


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/env perl
use strict;
use warnings;

sub array_loops{
  my ($count,@indices) = (0);
  foreach my $i(0..$#{$_[0]}){
    next if $indices[$i];
    $count++;
    while(!$indices[$i]){
      $indices[$i] = 1;
      $i = $_[0]->[$i];
    }
  }
  $count
}

printf "%d\n",
  array_loops([4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10]);
printf "%d\n",
  array_loops([0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19]);
printf "%d\n",
  array_loops([9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17]);

Tuesday, September 19, 2023

TWC235

Challenge Link

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:


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#!/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:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
#!/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

TWC234

Challenge Link

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:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
#!/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:


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
#!/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:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
#!/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:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
#!/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]);