From db7d24269b17705365bc7728d77403536b3147c6 Mon Sep 17 00:00:00 2001
From: pme <hauptadler@gmail.com>
Date: Sat, 25 Jan 2025 13:28:47 +0100
Subject: challenge-305

---
 challenge-305/peter-meszaros/perl/ch-1.pl | 86 +++++++++++++++++++++++++++++++
 challenge-305/peter-meszaros/perl/ch-2.pl | 66 ++++++++++++++++++++++++
 challenge-305/peter-meszaros/tcl/ch-1.tcl | 84 ++++++++++++++++++++++++++++++
 challenge-305/peter-meszaros/tcl/ch-2.tcl | 75 +++++++++++++++++++++++++++
 4 files changed, 311 insertions(+)
 create mode 100755 challenge-305/peter-meszaros/perl/ch-1.pl
 create mode 100755 challenge-305/peter-meszaros/perl/ch-2.pl
 create mode 100755 challenge-305/peter-meszaros/tcl/ch-1.tcl
 create mode 100755 challenge-305/peter-meszaros/tcl/ch-2.tcl

diff --git a/challenge-305/peter-meszaros/perl/ch-1.pl b/challenge-305/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..31a17b5f0c
--- /dev/null
+++ b/challenge-305/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Binary Prefix
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a binary array.
+
+Write a script to return an array of booleans where the partial binary number
+up to that point is prime.
+
+=head2 Example 1
+
+    Input: @binary = (1, 0, 1)
+    Output: (false, true, true)
+
+    Sub-arrays (base-10):
+    (1): 1 - not prime
+    (1, 0): 2 - prime
+    (1, 0, 1): 5 - prime
+
+=head2 Example 2
+
+    Input: @binary = (1, 1, 0)
+    Output: (false, true, false)
+
+    Sub-arrays (base-10):
+    (1): 1 - not prime
+    (1, 1): 3 - prime
+    (1, 1, 0): 6 - not prime
+
+=head2 Example 3
+
+    Input: @binary = (1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1)
+    Output: (false, true, true, false, false, true, false, false, false, false,
+        false, false, false, false, false, false, false, false, false, true)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[1, 0, 1], [0, 1, 1], 'Example 1'],
+    [[1, 1, 0], [0, 1, 0], 'Example 2'],
+    [[1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1], [0, 1, 1, 0,
+            0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1], 'Example 3'],
+];
+
+sub is_prime
+{
+    my $n = shift;
+
+    return 0 if $n <= 1;
+
+    for my $i (2 .. int(sqrt($n))) {
+        return 0 unless $n % $i;
+    }
+
+    return 1;
+}
+
+sub binary_prefix
+{
+    my $l = shift;
+
+    my $ret = [];
+    for my $i (0 .. $#$l) {
+        my $n = 0;
+        for my $j (0 .. $i) {
+            $n = $n * 2 + $l->[$j];
+        }
+        $ret->[$i] = is_prime($n);
+    }
+
+    return $ret;
+}
+
+for (@$cases) {
+    is(binary_prefix($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-305/peter-meszaros/perl/ch-2.pl b/challenge-305/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..53196f63c7
--- /dev/null
+++ b/challenge-305/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Alien Dictionary
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of words and alien dictionary character order.
+
+Write a script to sort lexicographically the given list of words based on the
+alien dictionary characters.
+
+=head2 Example 1
+
+    Input: @words = ("perl", "python", "raku")
+           @alien = qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/
+    Output: ("raku", "python", "perl")
+
+=head2 Example 2
+
+    Input: @words = ("the", "weekly", "challenge")
+           @alien = qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/
+    Output: ("challenge", "the", "weekly")
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[["perl", "python", "raku"],
+      [qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/]],
+     ["raku", "python", "perl"], 'Example 1'],
+    [[["the",  "weekly", "challenge"],
+      [qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/]],
+     ["challenge", "the", "weekly"], 'Example 2'],
+];
+
+sub alien_dictionary
+{
+    my $l = $_[0]->[0];
+    my $d = $_[0]->[1];
+
+    my %d = map { $d->[$_] => $_ } 0 .. $#$d;
+
+    my $ret = [sort {
+        my $i = 0;
+        while ($i < length($a) && $i < length($b)) {
+            my $ai = $d{substr($a, $i, 1)};
+            my $bi = $d{substr($b, $i, 1)};
+            return $ai <=> $bi if $ai != $bi;
+            $i++;
+        }
+        return length($a) <=> length($b);
+    } @$l];
+
+    return $ret;
+}
+
+for (@$cases) {
+    is(alien_dictionary($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-305/peter-meszaros/tcl/ch-1.tcl b/challenge-305/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..003e6a8950
--- /dev/null
+++ b/challenge-305/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,84 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Binary Prefix
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a binary array.
+# 
+# Write a script to return an array of booleans where the partial binary number
+# up to that point is prime.
+# 
+# Example 1
+# 
+#     Input: @binary = (1, 0, 1)
+#     Output: (false, true, true)
+# 
+#     Sub-arrays (base-10):
+#     (1): 1 - not prime
+#     (1, 0): 2 - prime
+#     (1, 0, 1): 5 - prime
+# 
+# Example 2
+# 
+#     Input: @binary = (1, 1, 0)
+#     Output: (false, true, false)
+# 
+#     Sub-arrays (base-10):
+#     (1): 1 - not prime
+#     (1, 1): 3 - prime
+#     (1, 1, 0): 6 - not prime
+# 
+# Example 3
+# 
+#     Input: @binary = (1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1)
+#     Output: (false, true, true, false, false, true, false, false, false, false,
+#         false, false, false, false, false, false, false, false, false, true)
+# 
+
+package require tcltest
+
+set cases {
+    {{1 0 1} {0 1 1} "Example 1"}
+    {{1 1 0} {0 1 0} "Example 2"}
+    {{1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1} {0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1} "Example 3"}
+}
+
+proc is_prime {n} {
+
+    if {$n <= 1} {
+        return 0
+    }
+
+    set v [expr int(sqrt($n))]
+
+    for {set i 2} {$i <= $v} {incr i} {
+        if {[expr $n % $i] == 0} {
+            return 0
+        }
+    }
+
+    return 1
+}
+
+proc binary_prefix {l} {
+    set len [llength $l]
+    set ret {}
+    for {set i 0} {$i < $len} {incr i} {
+        set n 0
+        for {set j 0} {$j <= $i} {incr j} {
+            set n [expr $n * 2 + [lindex $l $j]]
+        }
+        lset ret $i [is_prime $n]
+    }
+    return $ret
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       binary_prefix [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
diff --git a/challenge-305/peter-meszaros/tcl/ch-2.tcl b/challenge-305/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..97667c54b6
--- /dev/null
+++ b/challenge-305/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,75 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Alien Dictionary
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a list of words and alien dictionary character order.
+# 
+# Write a script to sort lexicographically the given list of words based on the
+# alien dictionary characters.
+# 
+# Example 1
+# 
+#     Input: @words = ("perl", "python", "raku")
+#            @alien = qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/
+#     Output: ("raku", "python", "perl")
+# 
+# Example 2
+# 
+#     Input: @words = ("the", "weekly", "challenge")
+#            @alien = qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/
+#     Output: ("challenge", "the", "weekly")
+# 
+
+package require tcltest
+
+set cases {
+    {{{perl python raku}
+      {h l a b y d e f g i r k m n o p q j s t u v w x c z}}
+     {raku python perl} "Example 1"}
+    {{{the  weekly challenge}
+      {c o r l d a b t e f g h i j k m n p q s w u v x y z}}
+     {challenge the weekly} "Example 2"}
+}
+
+proc compare {a b} {
+    global dd
+    set i 0
+    while { $i < [string length $a] && $i < [string length $b] } {
+        set ai [dict get $dd [string index $a $i]]
+        set bi [dict get $dd [string index $b $i]]
+        if { $ai != $bi } {
+            return [expr {$ai - $bi}]
+        }
+        incr i
+    }
+    return [expr {[string length $a] - [string length $b]}]
+}
+
+proc alien_dictionary {p} {
+    set l [lindex $p 0]
+    set d [lindex $p 1]
+
+    set x 0
+    global dd
+    set dd {}
+    foreach i $d {
+        dict set dd $i $x
+        incr x
+    }
+
+    set sl [lsort -command compare $l]
+
+    return $sl
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+       alien_dictionary [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
-- 
cgit