Merge pull request #1112 from wanderdoc/master

Challenge 042: Solutions in Perl 5.

2 files changed, 98 insertions, 0 deletions

diff --git a/challenge-042/wanderdoc/perl5/ch-1.pl b/challenge-042/wanderdoc/perl5/ch-1.pl
new file mode 100644
index 0000000000..b10a7934cb
--- /dev/null
+++ b/challenge-042/wanderdoc/perl5/ch-1.pl
@@ -0,0 +1,23 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to print decimal number 0 to 50 in Octal Number System.
+
+For example:
+Decimal 0 = Octal 0
+...
+Decimal 7 = Octal 7
+Decimal 8 = Octal 10
+
+and so on.
+=cut
+
+
+
+for my $number ( 0 .. 50 )
+{
+     print join(' = ', join(' ', 'Decimal', $number),
+                       join(' ', 'Octal', sprintf("%o", $number))), $/;  
+}
\ No newline at end of file
diff --git a/challenge-042/wanderdoc/perl5/ch-2.pl b/challenge-042/wanderdoc/perl5/ch-2.pl
new file mode 100644
index 0000000000..41a09ec261
--- /dev/null
+++ b/challenge-042/wanderdoc/perl5/ch-2.pl
@@ -0,0 +1,75 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to generate a string with random number of ( and ) brackets. Then make the script validate the string if it has balanced brackets.
+For example:
+() - OK
+(()) - OK
+)( - NOT OK
+())() - NOT OK
+=cut
+
+
+
+
+use constant { OB => '(', CB => ')' , WEIGHT => 0.25};
+my $FAIR = shift() ? 1 : 0; 
+my $TOTAL = 50;
+my $DEBUG_NUM_OK = 0;
+for my $i ( 1 .. $TOTAL )
+{
+     my $ml = int((rand(9) + 1)) * 2 + 2; # Should be even, otherwise would be immediately "NOT OK", assumed the string consists of brackets only.
+
+
+
+     # Making a string. The "simple" version produces too little "OK" strings.
+     # Therefore: two versions - "simple" and "fair".
+     my $string = $FAIR ? fair_brackets($ml) : simple_brackets($ml);
+
+     my $counter = 0;
+
+     for my $i (0 .. length($string) - 1)
+     {
+          --$counter if ( substr($string, $i, 1) eq CB );
+          last if ( $counter < 0 );
+          ++$counter if ( substr($string, $i, 1) eq OB );
+     }
+
+
+     print join(' ', $string, '-', 0 == $counter ? 'OK' : 'NOT OK' ), $/; 
+     ++$DEBUG_NUM_OK if 0 == $counter;
+}
+
+print join(' ', 
+     join('=', 'FAIR BUILD', $FAIR), 
+     join('=', 'DEBUG_NUM_OK', $DEBUG_NUM_OK),
+     join('=', 'TOTAL', $TOTAL)), $/;
+
+sub fair_brackets
+{
+     my $str .= OB;
+     my $length = $_[0];
+     while ( length($str) < $length )
+     {
+          $str .= CB and last if (length($str) + 1 == $length);
+
+
+          my $last = substr($str, -1, 1);
+          my $compl = $last eq OB ? CB : OB;
+          $str .= rand > WEIGHT ? $compl : $last;
+     }
+     return $str;
+}
+
+
+
+sub simple_brackets
+{
+     my @brackets = (OB, CB);
+     my $length = $_[0];
+
+     my $str =  join('', @brackets[ map rand (@brackets) , 1 .. $length ]);
+     return $str;
+}
\ No newline at end of file