Perl Weekly Challenge 203.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 203.
Task 1: Special Quadruplets
Submitted by: Mohammad S Anwar
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 use combinations from Algorithm::Combinatorics to generate
quadruplets, I grep the special ones and count them with a oneliner:
perl -MAlgorithm::Combinatorics=combinations -E '
say join " ", @ARGV, "->", 0+grep {$_->[3]==$_->[0]+$_->[1]+$_->[2]} combinations(\@ARGV,4)
' 1 2 3 6
perl -MAlgorithm::Combinatorics=combinations -E '
say join " ", @ARGV, "->", 0+grep {$_->[3]==$_->[0]+$_->[1]+$_->[2]} combinations(\@ARGV,4)
' 1 1 1 3 5
perl -MAlgorithm::Combinatorics=combinations -E '
say join " ", @ARGV, "->", 0+grep {$_->[3]==$_->[0]+$_->[1]+$_->[2]} combinations(\@ARGV,4)
' 3 3 6 4 5
Results:
1 2 3 6 -> 1
1 1 1 3 5 -> 4
3 3 6 4 5 -> 0
The full code is almost identical:
1 # Perl weekly challenge 203
2 # Task 1: Special Quadruplets
3 #
4 # See https://wlmb.github.io/2023/02/06/PWC203/#task-1-special-quadruplets
5 use v5.36;
6 use Algorithm::Combinatorics qw(combinations);
7 say join " ", @ARGV, "->", 0+grep {$_->[3]==$_->[0]+$_->[1]+$_->[2]} combinations(\@ARGV,4);
Examples:
./ch-1.pl 1 2 3 6
./ch-1.pl 1 1 1 3 5
./ch-1.pl 3 3 6 4 5
Results:
1 2 3 6 -> 1
1 1 1 3 5 -> 4
3 3 6 4 5 -> 0
Task 2: Copy Directory
Submitted by: Julien Fiegehenn
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
I solve this task recursively using the core subroutines opendir to open source
directories, readdir to read their contents, -d to test if a file
is a directory and mkdir to make new directories. The program fits a
twoliner.
rm -r rem # use a temporal directory for the test
for i in 1 2 3 4 5; do mkdir -p rem/a/b/c/$i; done # prepare the given structure
for i in 1 2 3 5; do touch rem/a/b/c/$i/$i.txt; done
mkdir -p rem/x/y
echo "Before"
tree rem # print the starting directory structure
perl -Mautodie -E '
c(@ARGV); sub c($f, $t){opendir my $h, $f;for(grep {!/^\./ && -d "$f/$_"} readdir($h)){
mkdir "$t/$_"; c("$f/$_", "$t/$_");}}
' rem/a/b/c rem/x/y
echo
echo "After"
tree rem # print resulting structure
Results:
Before
rem
├── a
│ └── b
│ └── c
│ ├── 1
│ │ └── 1.txt
│ ├── 2
│ │ └── 2.txt
│ ├── 3
│ │ └── 3.txt
│ ├── 4
│ └── 5
│ └── 5.txt
└── x
└── y
11 directories, 4 files
After
rem
├── a
│ └── b
│ └── c
│ ├── 1
│ │ └── 1.txt
│ ├── 2
│ │ └── 2.txt
│ ├── 3
│ │ └── 3.txt
│ ├── 4
│ └── 5
│ └── 5.txt
└── x
└── y
├── 1
├── 2
├── 3
├── 4
└── 5
16 directories, 4 files
The full code is similar.
1 # Perl weekly challenge 203
2 # Task 2: Copy Directory
3 #
4 # See https://wlmb.github.io/2023/02/06/PWC203/#task-2-copy-directory
5 use v5.36;
6 die <<~"FIN" if @ARGV!=2;
7 Usage: $0 dir1 dir2
8 to copy the directory structure under dir1 to dir2
9 FIN
10 copydir(@ARGV);
11 sub copydir($from, $to){
12 opendir my $handle, $from || die "Couldn't open $from: $!";
13 for(grep {!/^\./ && -d "$from/$_"} readdir($handle)){
14 mkdir "$to/$_" || die "Couldn't create $to/$_";
15 copydir("$from/$_", "$to/$_");
16 }
17 }
18
Example:
rm -r rem # use a temporal directory for the test
for i in 1 2 3 4 5; do mkdir -p rem/a/b/c/$i; done # prepare the given structure
for i in 1 2 3 5; do touch rem/a/b/c/$i/$i.txt; done
mkdir -p rem/x/y
echo "Before"
tree rem # print the starting directory structure
./ch-2.pl rem/a/b/c rem/x/y
echo
echo "After"
tree rem # print resulting structure
Results:
Before
rem
├── a
│ └── b
│ └── c
│ ├── 1
│ │ └── 1.txt
│ ├── 2
│ │ └── 2.txt
│ ├── 3
│ │ └── 3.txt
│ ├── 4
│ └── 5
│ └── 5.txt
└── x
└── y
11 directories, 4 files
After
rem
├── a
│ └── b
│ └── c
│ ├── 1
│ │ └── 1.txt
│ ├── 2
│ │ └── 2.txt
│ ├── 3
│ │ └── 3.txt
│ ├── 4
│ └── 5
│ └── 5.txt
└── x
└── y
├── 1
├── 2
├── 3
├── 4
└── 5
16 directories, 4 files
Written on February 6, 2023