Merge pull request #4100 from stuart-little/stuart-little_113_perl

1st commit on 113_perl

2 files changed, 91 insertions, 0 deletions

diff --git a/challenge-113/stuart-little/perl/ch-1.pl b/challenge-113/stuart-little/perl/ch-1.pl
new file mode 100755
index 0000000000..da3e751345
--- /dev/null
+++ b/challenge-113/stuart-little/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+# run <script> <number> <digit>
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+sub lastDigSumm($nr,$dig,$nrSummands) {
+    return (($nr - $nrSummands * $dig) % 10 == 0) && ($nrSummands * $dig <= $nr) && ($nrSummands * (($dig -1) * 10 + $dig) >= $nr);
+}
+
+sub lastDig($nr,$dig) {
+    return !!(grep {lastDigSumm($nr,$dig,$_)} (1..9));
+}
+
+sub sol($nr,$dig) {
+    $dig == 0 && return ($nr >= 101 || ($nr % 10 == 0));
+    return (($nr >= $dig * 11) || lastDig($nr,$dig));
+}
+
+say 0+sol(@ARGV);
diff --git a/challenge-113/stuart-little/perl/ch-2.pl b/challenge-113/stuart-little/perl/ch-2.pl
new file mode 100755
index 0000000000..9793a9a623
--- /dev/null
+++ b/challenge-113/stuart-little/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+use warnings;
+use v5.12;
+
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
+
+use List::AllUtils qw(first sum);
+use Tree::DAG_Node;
+
+sub diffIfNum($nr,$str) {
+    return ($str =~ /^\d+$/) ? ($nr - int($str)) : ($str);
+}
+
+sub moreDots($a) {
+    return 2*(scalar grep {$_ eq "."} @{$a}) > (scalar @{$a});
+}
+
+sub ixSplit($a) {
+    return first { my @ar = $a->@[0..$_]; moreDots(\@ar) } (keys @{$a});
+}
+
+sub treeList2Hash($t) {
+    (! scalar @{$t} || $t->[0] eq '.') && return {};
+    my @rest = @{$t}[1..scalar @{$t}-1];
+    my $ix = ixSplit(\@rest);
+    my @left = @rest[0..$ix];
+    my @right = @rest[$ix+1..$#rest];
+    return {
+	name => $t->[0],
+	left => treeList2Hash(\@left),
+	right => treeList2Hash(\@right),
+    };
+}
+
+sub mkDAG($h) {
+    (! scalar keys %{$h}) && return Tree::DAG_Node->new({ name => "" });
+    my $root = Tree::DAG_Node->new({ name => $h->{name} });
+    my %left = %{$h->{left}};
+    $root->add_daughter(mkDAG(\%left));
+    my %right = %{$h->{right}};
+    $root->add_daughter(mkDAG(\%right));
+    return $root;
+}
+
+my @INPUT = (scalar @ARGV) ? (@ARGV) : (qw(1 2 4 . 7 . . . 3 5 . . 6 . .));
+my $sum = sum grep {$_ =~ /^\d+$/} @INPUT;
+my @outTreeList = map {diffIfNum($sum,$_)} @INPUT;
+my $tree = mkDAG(treeList2Hash(\@outTreeList));
+
+print map("$_\n", @{$tree->tree2string({no_attributes => 1})});
+
+__END__
+run <script> <tree in preorder form with '.' for empty nodes, entered as space-separated values>
+
+ref: https://stackoverflow.com/a/2676849/11064961
+
+e.g. 1 2 4 . 7 . . . 3 5 . . 6 . . represents the tree
+
+        1
+       / \
+      2   3
+     /   / \
+    4   5   6
+     \
+      7
+
+given as an example in the problem formulation at https://perlweeklychallenge.org/blog/perl-weekly-challenge-113/#TASK2