Merge pull request #6166 from E7-87-83/newt

Week 166

2 files changed, 268 insertions, 0 deletions

diff --git a/challenge-166/cheok-yin-fung/perl/ch-1.pl b/challenge-166/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..c4b069c6dc
--- /dev/null
+++ b/challenge-166/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+# The Weekly Challenge 166
+# Task 1 Hexadecimal Words
+# Usage: $ ch-1.pl "word wanna transformed" [DD] [DH] [DN]
+
+use v5.26.0;
+use warnings;
+
+my @w;
+my @input_par = @ARGV;
+my %op;
+my $special = shift @input_par;
+$op{$_} = 1 for @input_par;
+
+say  'Usage: $ ch-1.pl "word wanna transformed" [DD] [DH] [DN]'
+    ."\n"
+    .'can go with parameter xi xl xo xs xt'
+    ."\n\n"
+    .'Test Recommendation: $ ch-1.pl "" DD > test_words'
+    if scalar @ARGV == 0;
+
+word_transform() if ($special);
+display_dict() if defined $op{"DD"};
+display_hex() if defined $op{"DH"};
+display_num() if defined $op{"DN"};
+
+
+
+sub word_transform {
+    say "Transformed word/character:";
+    say my $h = transform($special);
+    say "Value in decimal: ", hex $h;
+    say "";
+}
+
+sub display_dict {
+    say "Dictionary text:";
+    my @words = input();
+    @words = filter(@words);
+    say join "\n", sort {$a cmp $b} @words;
+    say "";
+}
+
+sub display_hex {
+    say "Transformed Dictionary Words :";
+    my @words = input();
+    @words = filter(@words);
+    say join "\n", map {transform($_)} sort {$a cmp $b} @words;
+    say "";
+}
+
+sub display_num {
+    say "Numbers (sorted):";
+    my @words = input();
+    @words = filter(@words);
+    say join "\n", map {sprintf "%10d", $_ } 
+                   sort {$a <=>$b} map {hex transform($_)} @words;
+    say "";
+}
+
+
+sub input {
+    open FH, "<". "../../data/dictionary.txt"
+        or die "Dictionary IS NOT FOUND.";
+    while (<FH>) {
+        chomp;
+        push @w, $_ if   lc($_) =~  /^[abcdefolist0-9]+$/ 
+                       && length $_ <= 8;
+    }
+    close FH;
+    return @w;
+}
+
+
+
+sub filter {
+    my @words = @_;
+    my %word_hash;
+    for (@words) {
+        $word_hash{$_} = 1
+    }
+    if (scalar @input_par > 0) {
+        for (@words) {
+            delete $word_hash{$_} if 
+                   (/o/ && defined $op{'xo'})
+                || (/l/ && defined $op{'xl'})
+                || (/i/ && defined $op{'xi'})
+                || (/s/ && defined $op{'xs'})
+                || (/t/ && defined $op{'xt'})
+                || ( (/li/ || /il/)  && defined $op{'x11'})
+        }
+    }
+    return keys %word_hash;
+}
+
+
+
+sub transform {
+    $_ = $_[0];
+    die "Not transformable!" unless     lc($_) =~ /^[abcdefolist0-9]+$/ 
+                                     && length $_ <= 8;
+    tr/olist/01157/;
+    tr/OLIST/01157/;
+    return "0x". "0" x (8 - length $_) . $_;
+}
diff --git a/challenge-166/cheok-yin-fung/perl/ch-2.pl b/challenge-166/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..6e724075b3
--- /dev/null
+++ b/challenge-166/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,163 @@
+#!/usr/bin/perl
+# The Weekly Challenge 166
+# Task 2: K-Directory Diff
+use v5.24.0;
+use warnings;
+use Cwd;
+use List::Util qw/uniqstr any/;
+
+kd(@ARGV) if defined($ARGV[1]);
+
+my $TEMP_CWD = getcwd;
+
+
+
+sub kd {
+
+    my @dirs = @_;
+
+    $_ =~ s/\/$// foreach @dirs;
+
+    my @subdirs_gonna_p;
+    my @files_gonna_p;
+
+
+    # check whether the directories exist
+    
+    my $are_all_available = 1;
+
+    for my $dirname (@dirs) {
+        my $is_it_available = -e -d $dirname;
+        warn "Directory \"$dirname\" does not exist!\n" if !$is_it_available;
+        $are_all_available &&= $is_it_available; 
+    }
+
+    if (!$are_all_available) {
+        say "Some directories do not exist!\n";
+        return 0;
+    }
+
+
+    # scraping
+
+    my %subdirs_of_dir;
+    my %files_in_dir;
+
+    for my $dirname (@dirs) {
+        chdir $TEMP_CWD;
+        chdir $dirname;
+        $files_in_dir{$dirname}->@* = grep { ! -d $_ } glob("*");
+        $subdirs_of_dir{$dirname}->@* = glob("*/");
+    }
+
+
+    # reposition 
+    chdir $TEMP_CWD;
+
+
+    # K-diff subdirectories
+
+    my @subdirs = uniqstr map {$subdirs_of_dir{$_}->@*} @dirs;
+
+
+    for my $dirname (@subdirs) {
+        my $are_all_available = 1;
+        for my $dir (@dirs) {
+            my $is_it_available
+                = any { $dirname eq $_ } $subdirs_of_dir{$dir}->@*;
+            $are_all_available &&= $is_it_available;
+            last if !$are_all_available;
+        }
+        push @subdirs_gonna_p, $dirname if !$are_all_available;
+    }
+
+    # K-diff files
+    my @files = uniqstr map {$files_in_dir{$_}->@*} @dirs;
+
+    for my $filename (@files) {
+        my $are_all_available = 1;
+        for my $dir (@dirs) {
+            my $is_it_available
+                = any { $filename eq $_ }
+                     $files_in_dir{$dir}->@*;
+            $are_all_available &&= $is_it_available;
+            last if !$are_all_available;
+        }
+        push @files_gonna_p, $filename if !$are_all_available;
+    }
+
+    # Printing
+
+    my $N = scalar @dirs;
+
+    # return if the directories are "congruent"
+    return 1 if (scalar @files_gonna_p == 0 && scalar @subdirs_gonna_p == 0);
+
+    for my $dir (@dirs) {
+        my_printf("%16s", $dir);
+    }
+    say "\n" . "-" x (16*$N);
+
+
+    for my $dirname (@subdirs_gonna_p) {
+        for my $dir (@dirs) {
+            if (any {$dirname eq $_} $subdirs_of_dir{$dir}->@*) {
+                my_printf("%16s", $dirname);
+            }
+            else {
+                my_printf("%16s", "");   
+            }
+        }
+        say "";
+    }
+
+
+    for my $filename (@files_gonna_p) {
+        for my $dir (@dirs) {
+            if (any {$filename eq $_} $files_in_dir{$dir}->@*) {
+                my_printf("%16s", $filename);
+            }
+            else {
+                my_printf("%16s", "");   
+            }
+        }
+        say "";
+    }
+
+    # end subroutine
+    return 1;
+}
+
+
+
+sub my_printf {
+    my $w = $_[1];
+    if (length $w > 14) {
+        if (substr($_[1], -1, 1) eq "/") {
+            $w = substr($w, 0, 12)."*/";
+        }
+        else {
+            $w = substr($w, 0, 12)."**";
+        }
+    }
+    if ( $w !~ /\*/ && $w =~ / / ) {
+        $w = '"'.$w.'"'; 
+    }
+    printf($_[0], $w);
+}
+
+
+
+use Test::More tests => 4;
+my $whoami = "cheok-yin-fung";
+ok kd("../../../challenge-166/$whoami/perl", "../../../challenge-165/$whoami/perl");
+ok kd("../../../challenge-166/$whoami/", "../../../challenge-165/$whoami/");
+ok kd("../../../challenge-166/$whoami/", 
+    "../../../challenge-165/$whoami/", 
+    "../../../challenge-156/$whoami/");
+ok kd("../../../challenge-166/$whoami/", "../../../challenge-163/$whoami/", 
+    "../../../challenge-158/$whoami/", 
+    "../../../challenge-147/$whoami/", "../../../challenge-110/$whoami/", 
+    "../../../challenge-078/$whoami/", 
+    "../../../challenge-077/$whoami/", "../../../challenge-075/$whoami/");
+