## Perl Weekly Challenge 203: Special Quadruplets and Copy Directory (Functional Programming Approach)

These are some answers to the Week 203 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on February 12, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

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
``````

I do not see any simple way to avoid heavily nested loops (we could certainly use the `combinations` built-in routine to generate all the index or value combinations, but that wouldn’t make things simpler or faster), . That’s okay with small input list, but might lead to performance issues with longer input lists because of the combinational nightmare with such large lists.

``````sub find-quadruplets (@in) {
my \$count = 0;
my \$last = @in.end;
for 0..\$last-3 -> \$i {
for \$i^..\$last-2 -> \$j {
for \$j^..\$last-1 -> \$k {
my \$target = [+] @in[\$i, \$j, \$k];
for \$k^..\$last -> \$m {
\$count++ if @in[\$m] == \$target;
}
}
}
}
return \$count;
}
for <1 2 3 6>, <1 1 1 3 5>, <1 1 1 3 5 5>, <3 3 6 4 5>,
<3 3 6 12 21> -> @test {
say "@test[]".fmt("%-15s -> "), find-quadruplets @test;
}
``````

This program displays the following output:

``````\$ raku quadruplets.raku
1 2 3 6         -> 1
1 1 1 3 5       -> 4
1 1 1 3 5 5     -> 7
3 3 6 4 5       -> 0
3 3 6 12 21     -> 3
``````

This is a port to Perl of the Raku program. One small change, though: I replaced the last (most inside) loop by a `grep` in scalar context counting the number of remaining items matching the computed sum of the first three items.

``````use strict;
use warnings;
use feature "say";

my \$count = 0;
my \$last = \$#_;
for my \$i (0..\$last-3) {
for my \$j (\$i+1..\$last-2) {
for my \$k (\$j+1..\$last-1) {
my \$target = \$_[\$i] + \$_[\$j] + \$_[\$k];
\$count += grep { \$_ == \$target }
@_[\$k+1..\$last];

}
}
}
return \$count;
}

for my \$test ([<1 2 3 6>], [<1 1 1 3 5>], [<1 1 1 3 5 5>],
[<3 3 6 4 5>], [<3 3 6 12 21>], [<1 1 1 3 5 9>]) {
printf "%-15s -> %d\n", "@\$test", find_quadruplets @\$test;
}
``````

This program displays the following output:

``````\$ perl ./quadruplets.pl
1 2 3 6         -> 1
1 1 1 3 5       -> 4
1 1 1 3 5 5     -> 7
3 3 6 4 5       -> 0
3 3 6 12 21     -> 3
1 1 1 3 5 9     -> 7
``````

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
``````

For this, I’ve decided to try to create generic subroutines to parse the input directory tree, using functional programming techniques such as higher-order functions, call-back functions, closures, code references, function factories and even, in a certain way, currying.

Since my example is more complete in Perl, I’ll start with that language.

### Copy Directory in Perl (Functional Programming Approach)

There exist some modules to copy files, directories or even entire directory tree.

`File::Copy` implements copying of files, but not directories. `File::Path` also doesn’t quite fit the need. `File::Copy::Recursive` implements copying directory trees, but it copies directory and files. There are many others, but I haven’t seen any that would copy a directory tree without copying also the files.

So I decided to write a recursive generic subroutine to navigate through the input directory tree.

``````sub traverse_dir {
my (\$code_f, \$code_d, \$path) = @_;
my @dir_entries = glob("\$path/*");
for my \$entry (@dir_entries) {
\$code_f->(\$entry) if -f \$entry;
\$code_d->(\$entry) and
traverse_dir(\$code_f, \$code_d, \$entry)
if -d \$entry;
}
}
``````

The `traverse_dir` subroutine receives three arguments: two code references and the path. The code-references are call-back functions, `\$code_f` to handle files, and `\$code_d` to handle directories. This makes it possible to use `traverse_dir` for a number of different tasks involving directory-tree traversal. The call back functions will be defined by the user of this subroutine.

Before we get to the copy directory task, let’s side-step a bit and see how we can use this subroutine to measure the size of the files in a directory tree.

#### Using the Generic Subroutine for Computing the Size of a Directory Tree

``````use strict;
use warnings;
use feature "say";

sub traverse_dir {
my (\$code_f, \$code_d, \$path) = @_;
my @dir_entries = glob("\$path/*");
for my \$entry (@dir_entries) {
\$code_f->(\$entry) if -f \$entry;
\$code_d->(\$entry) and
traverse_dir(\$code_f, \$code_d, \$entry)
if -d \$entry;
}
}

sub create_size_code_ref {
my \$total_size = 0;
return (sub {
my \$file = shift;
my \$size = -s \$file;
\$total_size += \$size;
printf "%-15s -> %d\n", \$file, \$size,;
}, sub {return \$total_size;});
}
my \$dir = shift;
my (\$code_ref, \$glob_size) = create_size_code_ref();
traverse_dir (\$code_ref, sub {1}, \$dir);
say "Total size = ", \$glob_size->();
``````

The `create_size_code_ref` subroutine generates and returns two other subroutines (actually code references), which also happen to be closures (they close on the `total_size` variable): one to compute and print the size of each file in the directory tree and the other to return the total computed size. This program might display the following output:

``````\$ perl ./file-size.pl
./arithmetic-slices.pl -> 683
./arithmetic-slices.raku -> 533
# Lines omitted for brevity
./seven_segments.raku -> 2670
./three-odds.pl -> 456
./three-odds.raku -> 402
./widest-valley.raku -> 1125
Total size = 60153
``````

When computing the size of a directory tree, we don’t need to do anything special about directory entries (except recursively traversing them), so the `\$code_d` subroutine reference does nothing useful and simply returns a true value (1).

We will now use the generic `traverse_dir` subroutine to solve the task at hand.

#### Using the Generic Subroutine to Copy a Directory Tree

We can now use the same `traverse_dir` subroutine to solve the copy directory task.

There are some limitations, though. First, our code will work well in `*nix-like` environments, probably not in others. Second, the `traverse_dir` subroutine handles properly directories and normal files, but may not work properly with symbolic links, device files, pipes, sockets, and FIFOs. I don’t know what to do with these, so I simply ignore them, except for symbolic links, which may lead to endless loops and should therefore be excluded from the recursive calls. That’s my only change to the `traverse-dir` subroutine. Here, we don’t do anything with files, so the `\$code_f` callback function does nothing, except returning a true value (1). The `create_dir_code_ref` routine creates a directory in the target path, unless it already exists (to avoid an error in such a case).

``````use strict;
use warnings;
use feature "say";

sub traverse_dir {
my (\$code_f, \$code_d, \$path) = @_;
my @dir_entries = glob("\$path/*");
for my \$entry (@dir_entries) {
next if -l \$entry;      # Exclude symlinks
\$code_f->(\$entry) and next if -f \$entry;
\$code_d->(\$entry) and
traverse_dir(\$code_f, \$code_d, \$entry)
if -d \$entry;
}
}

sub create_dir_code_ref {
my \$target_path = shift;
return sub {
my \$permissions = 0777;
my \$dir = shift;
my \$dir_name = (split '/', \$dir)[-1];
my \$new_dir = "\$target_path/\$dir_name";
if (-e \$new_dir) {
warn "Path \$new_dir already exists. Omitted.";
return 1;
}
mkdir \$new_dir, \$permissions or die "Unable to create \$new_dir \$!";
say "Created \$new_dir from \$dir.";
}
}
my \$source = './a/b/c';
die "No such directory." unless -d \$source;
mkdir './x' unless -d './x';
mkdir './x/y' unless -d './x/y';
my \$code_ref_d = create_dir_code_ref('./x/y');
traverse_dir ( sub {1}, \$code_ref_d, \$source);
``````

This program displays the following output:

``````\$ perl ./copy-dir.pl
Created ./x/y/1 from ./a/b/c/1.
Created ./x/y/2 from ./a/b/c/2.
Created ./x/y/3 from ./a/b/c/3.
Created ./x/y/4 from ./a/b/c/4.
Created ./x/y/5 from ./a/b/c/5.
``````

The `./x/y/` subdirectories have been duly created:

``````\$ ls  ./x/y/
1  2  3  4  5
``````

The `file-size.pl` program confirms that only directories, and not files, have been copied.

In the event some of the directories already existed in the target directory, the program gracefully handles this situation:

``````\$ perl ./copy-dir.pl
Path ./x/y/1 already exists. Omitted. at copy-dir.pl line 24.
Created ./x/y/2 from ./a/b/c/2.
Path ./x/y/3 already exists. Omitted. at copy-dir.pl line 24.
Path ./x/y/4 already exists. Omitted. at copy-dir.pl line 24.
Created ./x/y/5 from ./a/b/c/5.
``````

### Copy Directory in Raku (Functional Programming Approach)

Please refer to the detailed explanations in the Perl section above if you need clarification on the Raku program below:

``````sub traverse_dir (&code_f, &code_d, \$path) {
# my @dir_entries = dir("\$path");
for dir "\$path" -> \$entry {
next if \$entry.l;       # exclude symlinks
&code_f(\$entry) and next if \$entry.f;
&code_d(\$entry) and
traverse_dir(&code_f, &code_d, \$entry)
if \$entry.d;
}
}
sub create_dir_code_ref (\$target_path) {
return sub (\$dir) {
my \$dir_name = \$dir.IO.basename;
my \$new_dir = "\$target_path/\$dir_name";
if \$new_dir.IO.e {
note "Path \$new_dir already exists. Omitted";
return True;
}
mkdir \$new_dir or die "Unable to create \$new_dir \$!";
say "Created \$new_dir from \$dir.";
}
}
my (\$source, \$target) = './a/b/c', './x/y';
die "No such directory." unless \$source.IO.d;
mkdir (\$target, 0o777) unless \$target.IO.d;
my &code_ref_d = create_dir_code_ref \$target;
my &code_ref_f = {True};
traverse_dir &code_ref_f, &code_ref_d, \$source;
``````

This program displays the following output:

``````\$ raku  ./copy-dir.raku
Created ./x/y/1 from ./a/b/c/1.
Created ./x/y/2 from ./a/b/c/2.
Created ./x/y/3 from ./a/b/c/3.
Created ./x/y/4 from ./a/b/c/4.
Created ./x/y/5 from ./a/b/c/5.
``````

And it created the desired directories:

``````\$ ls ./x/y
1  2  3  4  5
``````

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on February 19, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.