challenge-333

4 files changed, 310 insertions, 0 deletions

diff --git a/challenge-333/peter-meszaros/perl/ch-1.pl b/challenge-333/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..a83d7dfb6f
--- /dev/null
+++ b/challenge-333/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Straight Line
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a list of co-ordinates.
+
+Write a script to find out if the given points make a straight line.
+
+=head2 Example 1
+
+    Input: @list = ([2, 1], [2, 3], [2, 5])
+    Output: true
+
+=head2 Example 2
+
+    Input: @list = ([1, 4], [3, 4], [10, 4])
+    Output: true
+
+=head2 Example 3
+
+    Input: @list = ([0, 0], [1, 1], [2, 3])
+    Output: false
+
+=head2 Example 4
+
+    Input: @list = ([1, 1], [1, 1], [1, 1])
+    Output: true
+
+=head2 Example 5
+
+    Input: @list = ([1000000, 1000000], [2000000, 2000000], [3000000, 3000000])
+    Output: true
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[[2, 1], [2, 3], [2, 5]],  1, "Example 1"],
+    [[[1, 4], [3, 4], [10, 4]], 1, "Example 2"],
+    [[[0, 0], [1, 1], [2, 3]],  0, "Example 3"],
+    [[[1, 1], [1, 1], [1, 1]],  1, "Example 4"],
+    [[[1000000, 1000000], [2000000, 2000000], [3000000, 3000000]],
+                                1, "Example 5"],
+];
+
+sub straight_line
+{
+    my $points = shift;
+
+    return undef if @$points < 2;
+
+    my ($x0, $y0) = @{$points->[0]};
+    my ($x1, $y1) = @{$points->[1]};
+    my $dx = $x1 - $x0;
+    my $dy = $y1 - $y0;
+
+    for my $point (@$points[2 .. $#$points]) {
+        my ($x, $y) = @$point;
+        return 0 if ($x - $x0) * $dy != ($y - $y0) * $dx;
+    }
+    return 1;
+}
+
+for (@$cases) {
+    is(straight_line($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-333/peter-meszaros/perl/ch-2.pl b/challenge-333/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..734220e960
--- /dev/null
+++ b/challenge-333/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Duplicate Zeros
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to duplicate each occurrence of zero, shifting the remaining
+elements to the right. The elements beyond the length of the original array are
+not written.
+
+=head2 Example 1
+
+    Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+    Output: (1, 0, 0, 2, 3, 0, 0, 4)
+
+    Each zero is duplicated.
+    Elements beyond the original length (like 5 and last 0) are discarded.
+
+=head2 Example 2
+
+    Input: @ints = (1, 2, 3)
+    Output: (1, 2, 3)
+
+    No zeros exist, so the array remains unchanged.
+
+=head2 Example 3
+
+    Input: @ints = (1, 2, 3, 0)
+    Output: (1, 2, 3, 0)
+
+=head2 Example 4
+
+    Input: @ints = (0, 0, 1, 2)
+    Output: (0, 0, 0, 0)
+
+=head2 Example 5
+
+    Input: @ints = (1, 2, 0, 3, 4)
+    Output: (1, 2, 0, 0, 3)
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [[1, 0, 2, 3, 0, 4, 5, 0], [1, 0, 0, 2, 3, 0, 0, 4], "Example 1"],
+    [[1, 2, 3],                [1, 2, 3],                "Example 2"],
+    [[1, 2, 3, 0],             [1, 2, 3, 0],             "Example 3"],
+    [[0, 0, 1, 2],             [0, 0, 0, 0],             "Example 4"],
+    [[1, 2, 0, 3, 4],          [1, 2, 0, 0, 3],          "Example 5"],
+];
+
+sub duplicate_zeros
+{
+    my $ints = shift;
+
+    my @result;
+    for my $i (0 .. $#$ints) {
+        push @result, ($ints->[$i] == 0) ? (0, 0) : $ints->[$i];
+        last if @result >= @$ints;
+    }
+    return [@result[0 .. $#$ints]];
+}
+
+for (@$cases) {
+    is(duplicate_zeros($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-333/peter-meszaros/tcl/ch-1.tcl b/challenge-333/peter-meszaros/tcl/ch-1.tcl
new file mode 100755
index 0000000000..ed4b659f7d
--- /dev/null
+++ b/challenge-333/peter-meszaros/tcl/ch-1.tcl
@@ -0,0 +1,80 @@
+#!/usr/bin/env tclsh
+#
+# Task 1: Straight Line
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a list of co-ordinates.
+# 
+# Write a script to find out if the given points make a straight line.
+# 
+# Example 1
+# 
+#     Input: @list = ([2, 1], [2, 3], [2, 5])
+#     Output: true
+# 
+# Example 2
+# 
+#     Input: @list = ([1, 4], [3, 4], [10, 4])
+#     Output: true
+# 
+# Example 3
+# 
+#     Input: @list = ([0, 0], [1, 1], [2, 3])
+#     Output: false
+# 
+# Example 4
+# 
+#     Input: @list = ([1, 1], [1, 1], [1, 1])
+#     Output: true
+# 
+# Example 5
+# 
+#     Input: @list = ([1000000, 1000000], [2000000, 2000000], [3000000, 3000000])
+#     Output: true
+# 
+
+package require tcltest
+
+set cases {
+    {{{2 1} {2 3} {2 5}}  1 "Example 1"}
+    {{{1 4} {3 4} {10 4}} 1 "Example 2"}
+    {{{0 0} {1 1} {2 3}}  0 "Example 3"}
+    {{{1 1} {1 1} {1 1}}  1 "Example 4"}
+    {{{1000000 1000000} {2000000 2000000} {3000000 3000000}}
+                          1 "Example 5"}
+}
+
+proc straight_line {points} {
+    if {[llength $points] < 2} {
+        return 0
+    }
+
+    set x0 [lindex [lindex $points 0] 0]
+    set y0 [lindex [lindex $points 0] 1]
+    set x1 [lindex [lindex $points 1] 0]
+    set y1 [lindex [lindex $points 1] 1]
+    set dx [expr $x1 - $x0]
+    set dy [expr $y1 - $y0]
+
+    for {set i 2} {$i < [llength $points]} {incr i} {
+        set point [lindex $points $i]
+        set x [lindex $point 0]
+        set y [lindex $point 1]
+        if {[expr ($x - $x0) * $dy != ($y - $y0) * $dx]} {
+            return 0
+        }
+    }
+
+    return 1;
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        straight_line [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+
diff --git a/challenge-333/peter-meszaros/tcl/ch-2.tcl b/challenge-333/peter-meszaros/tcl/ch-2.tcl
new file mode 100755
index 0000000000..ef29d65238
--- /dev/null
+++ b/challenge-333/peter-meszaros/tcl/ch-2.tcl
@@ -0,0 +1,80 @@
+#!/usr/bin/env tclsh
+#
+# Task 2: Duplicate Zeros
+# 
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers.
+# 
+# Write a script to duplicate each occurrence of zero, shifting the remaining
+# elements to the right. The elements beyond the length of the original array are
+# not written.
+# 
+# Example 1
+# 
+#     Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
+#     Output: (1, 0, 0, 2, 3, 0, 0, 4)
+# 
+#     Each zero is duplicated.
+#     Elements beyond the original length (like 5 and last 0) are discarded.
+# 
+# Example 2
+# 
+#     Input: @ints = (1, 2, 3)
+#     Output: (1, 2, 3)
+# 
+#     No zeros exist, so the array remains unchanged.
+# 
+# Example 3
+# 
+#     Input: @ints = (1, 2, 3, 0)
+#     Output: (1, 2, 3, 0)
+# 
+# Example 4
+# 
+#     Input: @ints = (0, 0, 1, 2)
+#     Output: (0, 0, 0, 0)
+# 
+# Example 5
+# 
+#     Input: @ints = (1, 2, 0, 3, 4)
+#     Output: (1, 2, 0, 0, 3)
+# 
+
+package require tcltest
+
+set cases {
+    {{1 0 2 3 0 4 5 0} {1 0 0 2 3 0 0 4} "Example 1"}
+    {{1 2 3}           {1 2 3}           "Example 2"}
+    {{1 2 3 0}         {1 2 3 0}         "Example 3"}
+    {{0 0 1 2}         {0 0 0 0}         "Example 4"}
+    {{1 2 0 3 4}       {1 2 0 0 3}       "Example 5"}
+}
+
+proc duplicate_zeros {ints} {
+    set length [llength $ints]
+    set result {}
+    
+    for {set i 0} {$i < $length} {incr i} {
+        if {[lindex $ints $i] == 0} {
+            lappend result 0 0
+        } else {
+            lappend result [lindex $ints $i]
+        }
+        if {[llength $result] >= $length} {
+            break
+        }
+    }
+    
+    return [lrange $result 0 [expr $length - 1]]
+}
+
+tcltest::configure -verbose {pass}
+foreach case $cases {
+    tcltest::test [lindex $case 2] {} {
+        duplicate_zeros [lindex $case 0]
+    } [lindex $case 1]
+}
+
+exit 0
+