TWC244

Challenge Link

Task1

for each element we count the elements which are smaller that it:

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

sub count_smaller{
  my ($arr) = @_;
  map{my $e = $_;scalar grep{$_ < $e}@$arr}@$arr;
}

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

Task2

We iterate all the subsets of of the list and accumulate the sum according to the given rules:

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

sub group_hero{
  my $sum = 0;
  my $it = subsets($_[0]);
  while(my $c = $it->next){
    $sum += (max(@$c) ** 2) * min(@$c) if @$c;
  }
  $sum
}

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

TWC243

Challenge Link

Task1

We take each two-combination of the list and check if it satisfies the condition:

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

sub reverse_pairs{
  my $it = combinations($_[0],2);
  my $count = 0;
  while(my $c = $it->next){
    $count++ if $c->[0] > ($c->[1] * 2)
  }
  $count
}

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

Task2

We take each two-pairs of the resultant cross product of the list and accumulate their floor sums:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(variations_with_repetition);

sub floor_sum{
  my $it = variations_with_repetition($_[0],2);
  my $sum = 0;
  while(my $c = $it->next){
    $sum += int($c->[0] / $c->[1]);
  }
  $sum
}

printf "%d\n",floor_sum([2,5,9]);
printf "%d\n",floor_sum([7,7,7,7,7,7,7]);

TWC242

Challenge Link

Task1

We convert each array to a set, then take their difference:

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

sub missing_members{
  my $s1 = Set::Scalar->new(@{$_[0]});
  my $s2 = Set::Scalar->new(@{$_[1]});
  [($s1-$s2)->members],[($s2-$s1)->members]
}

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

Task2

We reverse each sub-array of the matrix and xor each bit with 1 to flip it:

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

sub flip_matrix{
  map{[map {$_^1} reverse @$_]}@{$_[0]};
}

print show flip_matrix([[1,1,0],[1,0,1],[0,0,0]]);
print show flip_matrix([[1,1,0,0],[1,0,0,1],[0,1,1,1],[1,0,1,0]]);

TWC127

Challenge Link

Task1

Two sets are disjoint if they have no common elements, which means the count of the items in both sets are all 1.

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

sub disjoint_sets{
  my ($s1,$s2) = @_;
  my %h;
  map{$h{$s1->[$_]}++; $h{$s2->[$_]}++} 0..$#$s1;
  all{$_ == 1} values %h;
}

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

Task2

Two intervals conflict if x1 >= x2 and x1 <= y2 where (x1,y1),(x2,y2) are our intervals:

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

sub conflict_intervals{
  my ($arr) = @_;
  my @ret;
  foreach my $i(1..$#$arr){
    my $b = 0;
    foreach my $j(0..$i-1){
      $b = 1 if $arr->[$i][0] >= $arr->[$j][0] &&
	$arr->[$i][0] <= $arr->[$j][1];
    }
    push @ret, $arr->[$i] if $b;
  }
  @ret
}

print show conflict_intervals([[1,4],[3,5],[6,8],[12,13],[3,20]]);
print show conflict_intervals([[3,4],[5,7],[6,9],[10,12],[13,15]]);