Merge pull request #7539 from jeanluc2020/jeanluc-203

Add solution 203

4 files changed, 164 insertions, 0 deletions

diff --git a/challenge-203/jeanluc2020/blog-1.txt b/challenge-203/jeanluc2020/blog-1.txt
new file mode 100644
index 0000000000..8a869fdcca
--- /dev/null
+++ b/challenge-203/jeanluc2020/blog-1.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-203-1.html
diff --git a/challenge-203/jeanluc2020/blog-2.txt b/challenge-203/jeanluc2020/blog-2.txt
new file mode 100644
index 0000000000..65ee4cd21d
--- /dev/null
+++ b/challenge-203/jeanluc2020/blog-2.txt
@@ -0,0 +1 @@
+http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-203-2.html
diff --git a/challenge-203/jeanluc2020/perl/ch-1.pl b/challenge-203/jeanluc2020/perl/ch-1.pl
new file mode 100755
index 0000000000..6a9c63fb60
--- /dev/null
+++ b/challenge-203/jeanluc2020/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-203/#TASK1
+#
+# Task 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
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# this is pretty straight forward, just walk the array with 4 variables
+# and in each step check the condition
+
+use strict;
+use warnings;
+use feature 'say';
+
+my @examples = (
+   [1,2,3,6],
+   [1,1,1,3,5],
+   [3,3,6,4,5]
+);
+
+foreach my $nums (@examples) {
+   say "Found " . get_quadruples(@$nums) . " for (" . join(", ", @$nums) . ")";
+}
+
+sub get_quadruples {
+   my @nums = @_;
+   my $count = 0;
+   foreach my $A (0..$#nums) {
+      foreach my $B ($A+1..$#nums) {
+         foreach my $C ($B+1..$#nums) {
+            foreach my $D ($C+1..$#nums) {
+               $count++ if $nums[$A]+$nums[$B]+$nums[$C] == $nums[$D];
+            }
+         }
+      }
+   }
+   return $count;
+}
diff --git a/challenge-203/jeanluc2020/perl/ch-2.pl b/challenge-203/jeanluc2020/perl/ch-2.pl
new file mode 100755
index 0000000000..9809b80bb3
--- /dev/null
+++ b/challenge-203/jeanluc2020/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-203/#TASK2
+# Task 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
+#
+############################################################
+##
+## discussion
+##
+############################################################
+#
+# This basically has to duplicate a directory tree, but without
+# any files - which I would interpret as "not even special files
+# like named pipes, device files, symlinks etc" (the whole code
+# would be much more complicated to handle those, albeit not
+# impossible to do)
+# While the example above uses absolute source and target directories,
+# there is no reason why this couldn't also work with relative
+# source and target as well.
+# We can either do this whole thing manually or use File::Find.
+# Since the latter is much more convenient, we try it here ;-)
+
+use strict;
+use warnings;
+use File::Find;
+
+my ($source, $target) = @ARGV;
+die "Usage: $0 <source> <target>" unless $source and $target;
+
+find( { "wanted" => \&wanted, "no_chdir" => 1 } , $source);
+
+sub wanted {
+   my $new = $File::Find::name;
+   if(-d $new) {
+      $new =~ s/^\Q$source\E/$target/;
+      ensure_dir($new);
+   }
+}
+
+# create a directory and all its parents if missing
+sub ensure_dir {
+   my $dir = shift;
+   $dir =~ s/\/*$//; # remove trailing "/"
+   return if -d $dir;
+   if($dir =~ m/\//) {
+      # we seem to have multiple parts in this path
+      my $prefix = $dir;
+      $prefix =~ s#/[^/]*$##;
+      ensure_dir($prefix); # make sure all parents exist
+   }
+   mkdir $dir or die "Can't mkdir $dir: $!";
+}