Perl Weekly Challenge: Week 203
Challenge 1:
Special Quadruplets
You are given an array of integers.
Write a script to find out the total special quadruplets for the given array.
Special Quadruplets are such that satisfies the following 2 rules.
1) nums[a] + nums[b] + nums[c] == nums[d]
2) a < b < c < d
Example 1
Input: @nums = (1,2,3,6)
Output: 1
Since the only special quadruplets found is $nums[0] + $nums[1] + $nums[2] == $nums[3].
Example 2
Input: @nums = (1,1,1,3,5)
Output: 4
$nums[0] + $nums[1] + $nums[2] == $nums[3]
$nums[0] + $nums[1] + $nums[3] == $nums[4]
$nums[0] + $nums[2] + $nums[3] == $nums[4]
$nums[1] + $nums[2] + $nums[3] == $nums[4]
Example 3
Input: @nums = (3,3,6,4,5)
Output: 0
My initial plan for solving this challenge was first to create lists of three elements and then select an element to compare them to for equality. But this is needlessly complicated and inefficient.
Instead we can take combinations of four elements and test those to see if they match our criteria. It's easy to do in Raku.
First I set up an array to hold the quadruplets found. The spec only asks for a count of special quadruplets but I found this helpful while debugging.
my @quadruplets;
Rakus' .combinations() method will give us all combinations of four elements in the
input array. For each combination,
for @args.combinations(4) -> $combo {
... we sort it. This will help fulfill the second criterion in the spec.
my @sorted = @$combo.sort({$^a <=> $^b});
Then we check to see if the first three elements are equal to the fourth which was the first criterion.
if @sorted[0] + @sorted[1] + @sorted[2] == @sorted[3] {
If it was, we have a special quadruplet so we add it to the results.
@quadruplets.push(@sorted);
}
}
Finally, we print how many special quadruplets we found.
@quadruplets.elems.say;
Perl doesn't have a builtin combinations function but as this has come up many times before in previous challenges I already had code at hand I could reuse. With that, the Perl version looks like this.
my @args = @ARGV;
my @quadruplets;
for my $combo (combinations(\@args, 4)) {
my @sorted = sort {$a <=> $b} @{$combo};
if ($sorted[0] + $sorted[1] + $sorted[2] == $sorted[3]) {
push @quadruplets, \@sorted;
}
}
say scalar @quadruplets;
Challenge 2:
Copy Directory
You are given path to two folders, $source and $target.
Write a script that recursively copy the directory from $source to $target except any files.
Example
Input: $source = '/a/b/c' and $target = '/x/y'
Source directory structure:
├── a
│ └── b
│ └── c
│ ├── 1
│ │ └── 1.txt
│ ├── 2
│ │ └── 2.txt
│ ├── 3
│ │ └── 3.txt
│ ├── 4
│ └── 5
│ └── 5.txt
Target directory structure:
├── x
│ └── y
Expected Result:
├── x
│ └── y
| ├── 1
│ ├── 2
│ ├── 3
│ ├── 4
│ └── 5
My Raku solution takes two arguments from the command-line; the path to the source directory and
the path to the target directory. These are used to create two IO objects which will perform all the
file-related operations in this script.
my $sio = $source.IO;
my $tio = $target.IO;
If the target directory doesn't exist, it is created.
unless $tio.d {
mkdir $target;
}
Normally, I don't use external modules in these challenges but rather than write possibly error-prone code to traverse filesystems, I employed the Find::File module. This means we need this line at the top of the script.
use File::Find;
We use this to get all the directories under the source recursively, skipping files.
my @dirs = find(dir => $sio, type => 'dir');
Finally, we create the corresponding directories under the target.
for @dirs -> $dir {
# Get relative path from source
my $relPath = $dir.relative($sio);
# Create the directory in target
my $newDir = $tio.add($relPath);
mkdir $newDir;
}
}
For Perl, we also use some modules. These are bundled with all recent versions of Perl.
use File::Find;
use File::Spec;
The rest of the code follows the same logic as Raku.
unless (-d $target) {
mkdir $target;
}
my @dirs;
find(
{
wanted => sub {
if (-d) {
push @dirs, $File::Find::name;
}
},
no_chdir => 1,
},
$source
);
for my $dir (@dirs) {
if ($dir eq $source) {
next;
}
my $relPath = File::Spec->abs2rel($dir, $source);
my $newDir = File::Spec->catdir($target, $relPath);
mkdir $newDir;
}