From 03f81614b5363be6c56aabc353eda770dbc91c3c Mon Sep 17 00:00:00 2001 From: Burkhard Nickels Date: Mon, 20 Jan 2020 00:15:26 +0100 Subject: Solution for PWC 43 from Burkhard Nickels. --- challenge-043/burkhard-nickels/README | 1 + challenge-043/burkhard-nickels/blogs.txt | 1 + challenge-043/burkhard-nickels/perl5/Hex.pm | 76 ++++ challenge-043/burkhard-nickels/perl5/ch-1.html | 271 ++++++++++++++ challenge-043/burkhard-nickels/perl5/ch-1.pl | 37 ++ challenge-043/burkhard-nickels/perl5/ch-1.pod | 276 +++++++++++++++ challenge-043/burkhard-nickels/perl5/ch-1.py | 33 ++ challenge-043/burkhard-nickels/perl5/ch-2.html | 464 ++++++++++++++++++++++++ challenge-043/burkhard-nickels/perl5/ch-2.pl | 111 ++++++ challenge-043/burkhard-nickels/perl5/ch-2.pod | 466 +++++++++++++++++++++++++ challenge-043/burkhard-nickels/perl6/ch-1.p6 | 36 ++ challenge-043/burkhard-nickels/perl6/ch-2.p6 | 49 +++ 12 files changed, 1821 insertions(+) create mode 100644 challenge-043/burkhard-nickels/README create mode 100644 challenge-043/burkhard-nickels/blogs.txt create mode 100644 challenge-043/burkhard-nickels/perl5/Hex.pm create mode 100644 challenge-043/burkhard-nickels/perl5/ch-1.html create mode 100755 challenge-043/burkhard-nickels/perl5/ch-1.pl create mode 100755 challenge-043/burkhard-nickels/perl5/ch-1.pod create mode 100755 challenge-043/burkhard-nickels/perl5/ch-1.py create mode 100644 challenge-043/burkhard-nickels/perl5/ch-2.html create mode 100755 challenge-043/burkhard-nickels/perl5/ch-2.pl create mode 100755 challenge-043/burkhard-nickels/perl5/ch-2.pod create mode 100755 challenge-043/burkhard-nickels/perl6/ch-1.p6 create mode 100755 challenge-043/burkhard-nickels/perl6/ch-2.p6 diff --git a/challenge-043/burkhard-nickels/README b/challenge-043/burkhard-nickels/README new file mode 100644 index 0000000000..f5e16bb98b --- /dev/null +++ b/challenge-043/burkhard-nickels/README @@ -0,0 +1 @@ +Solutions by Burkhard Nickels. diff --git a/challenge-043/burkhard-nickels/blogs.txt b/challenge-043/burkhard-nickels/blogs.txt new file mode 100644 index 0000000000..9cb0ea99b5 --- /dev/null +++ b/challenge-043/burkhard-nickels/blogs.txt @@ -0,0 +1 @@ +http://pearls.dyndnss.net diff --git a/challenge-043/burkhard-nickels/perl5/Hex.pm b/challenge-043/burkhard-nickels/perl5/Hex.pm new file mode 100644 index 0000000000..a5ded3cdb3 --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/Hex.pm @@ -0,0 +1,76 @@ +#!/usr/bin/perl + +package Hex; + +use strict; +use warnings; +use Data::Dumper qw(Dumper); +use bigint qw/hex/; +require Exporter; + +use overload + '""' => \&out, + '++' => \&incr, + '!=' => \&ne, + '=' => \&clone, + 'fallback' => 1; + +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(debug); +$Data::Dumper::Indent=0; + +sub new { + my ($class,$n,$hex) = @_; + $n = hex($n) if $hex; + $n = 0 if ! $n; + my $self = \$n; + bless $self, $class; + return $self; +} + +sub clone { + my ($self) = @_; + my $n = $$self; + my $copy = bless \$n, ref $self; + return $copy; +} + +sub set { + my ($self,$value,$hex) = @_; + $value = hex($value) if $hex; + $$self = $value; +} + +sub incr { + my ($self) = @_; + $$self++; + my $hex = sprintf("%x",$$self); + return $hex; +} + +sub ne { + my ($self,$cmp) = @_; + my $hex = sprintf("%x",$$self); + if($$self != $cmp->dec()) { + return 1; + } + return 0; +} + +sub out { + my $self = shift; + my $hex = sprintf("%x",$$self); + return $hex; +} + +sub dec { + my $self = shift; + return $$self; +} + +sub print { + my $self = shift; + printf("%x",$$self); +} + +1; diff --git a/challenge-043/burkhard-nickels/perl5/ch-1.html b/challenge-043/burkhard-nickels/perl5/ch-1.html new file mode 100644 index 0000000000..e14af694cf --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/ch-1.html @@ -0,0 +1,271 @@ + + + + +Perl Weekly Challenge #43 Task #1, Olympic Rings + + + + + + + + +
+ Perl Weekly Challenge #43 Task #1, Olympic Rings +
+ + + + + +

Perl Weekly Challenge #43 Task #1: Olympic Rings

+ +

This task is solved with flattening the olympic ring values into an array, setting each missing value to 'x' and letting a window of 3 elements running over the whole array. In case that on this window is only one value missing, it can be calculated. The window is iterating over the array as long as a x-value exists.

+ + + +

Download and References

+Download File: Perl5 Solution PWC #43 Task #1 ch-1.pl
+Download File: Perl6 Solution PWC #43 Task #1 ch-1.p6
+Download File: Python Solution PWC #43 Task #1 ch-1.py
+
+ +

SYNOPSIS

+ +
 # ./ch-1.pl                    - Program execution
+ # ./ch-1.p6                    - Program execution
+ # ./ch-1.py                    - Program execution
+ # perldoc ch-1.pod             - POD
+
+ # ./ch-1.pl
+ ch-1.pl (Version 1.0) PWC #43 Task #1: Olympic Rings
+ Values: 9-x-5-x-x-x-7-x-8
+ Result: 9-2-5-4-6-1-7-3-8
+ +

Definition Task #1: Olympic Rings

+ +

There are 5 rings in the Olympic Logo as shown below. They are color coded as in Blue, Black, Red, Yellow and Green.

+ +

Olympic Rings

+ +
  RED   GRN    BL   YLW   BLU
+ ( 9 (x) 5 (x) x (x) 7 (x) 8 )
+ +

(Chuck: For a better graphic look at PWC, my ASCII graphic here is not optimal.)

+ +

We have allocated some numbers to these rings as below: Blue: 8 Yellow: 7 Green: 5 Red: 9

+ +

The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.

+ +

Sourcecode for Perl5

+ +

The Olympic Ring values and the intersected values are stored in an array with each missing value set to 'x'.

+ +
 my @a = (9,'x',5,'x','x','x',7,'x',8);
+ +

The number of missing values is determined with the matching operator. As long as there are missing values the do-while loop is iterated.

+ +
 $nrx = () = join("",@a) =~ /x/g;
+ +

Every second value (every olympic ring) is iterated in a for loop.

+ +
 for(my $i=0; $i<=$#a; $i+=2)
+ +

A window of three values (before and after the iteration steps) is extracted. If only one of the three values is missing, this value is calculated.

+ +
 my @win = @a[$i-1 .. $i+1];
+ $win[0] = 0 if $i==0;
+ $win[2] = 0 if $i==$#a;
+ +

Calculation of the missing value.

+ +
 if($nr == 1) {
+    if($win[1] eq 'x') { $a[$i] = 11 - $win[0] - $win[2]; } 
+    elsif($win[0] eq 'x') { $a[$i-1] = 11 - $win[1] - $win[2]; }
+    elsif($win[2] eq 'x') { $a[$i+1] = 11 - $win[1] - $win[0]; }
+ }
+ +
+
 Perl5 

+  1 #!/usr/bin/perl
+  2 
+  3 use strict;
+  4 use warnings;
+  5 
+  6 print "ch-1.pl, PWC #43 Task #1: Olympic Rings\n";
+  7 my $DEBUG=0;
+  8 
+  9 my @a = (9,'x',5,'x','x','x',7,'x',8);
+ 10 
+ 11 print "Values: ", join("-",@a), "\n";
+ 12 my $nrx;                             # Number of x in array
+ 13 do {
+ 14 	numbers();
+ 15 	$nrx = () = join("",@a) =~ /x/g; # Determine Nr of x
+ 16 } while($nrx);                       # if Nr of x
+ 17 
+ 18 print "Result: ", join("-",@a), "\n";
+ 19 
+ 20 # ------------------- function to determine missing numbers
+ 21 sub numbers {
+ 22 	for(my $i=0; $i<=$#a; $i+=2) {  # Only every second value is a Main Ring Value
+ 23 
+ 24 		my @win = @a[$i-1 .. $i+1]; # Create window of 3 numbers that shifts along array
+ 25 		$win[0] = 0 if $i==0;       # At begin, set window first element to zero
+ 26 		$win[2] = 0 if $i==$#a;     # At end,   set window last  element to zero
+ 27 
+ 28 		my $nr = () = join("",@win) =~ /x/g;  # How many x are in window
+ 29 		print "($i) Win(", join("/",@win), ") Nrx $nr\n" if $DEBUG;
+ 30 		if($nr == 1) {                     # Only if 1 value is missing, determine next value
+ 31 			if($win[1] eq 'x') { $a[$i] = 11 - $win[0] - $win[2]; } 
+ 32 			elsif($win[0] eq 'x') { $a[$i-1] = 11 - $win[1] - $win[2]; }
+ 33 			elsif($win[2] eq 'x') { $a[$i+1] = 11 - $win[1] - $win[0]; }
+ 34 		}
+ 35 	} 
+ 36 }
+
+
+ +

Sourcecode for Perl6

+ +

The processing for Perl6 is equivalent to that explained for Perl5. Only the syntax here is different.

+ +
+
 Perl6 

+  1 #!/home/chuck/rakudo/bin/perl6
+  2 
+  3 use strict;
+  4 
+  5 print "ch-1.p6, PWC #43 Task #1: Olympic Rings\n";
+  6 
+  7 my @a = (9,'x',5,'x','x','x',7,'x',8);
+  8 
+  9 print "Values: ", join("-",@a), "\n";
+ 10 my ($c,$nrx);                               # Number of x in array
+ 11 repeat {
+ 12 	numbers();
+ 13 	$c = join("",@a) ~~ m:g/x/;  # Determine Nr of x
+ 14 	$nrx = $c.chars;
+ 15 } while ($nrx);                  # if Nr of x
+ 16 
+ 17 print "Result: ", join("-",@a), "\n";
+ 18 
+ 19 # ------------------- function to determine missing numbers
+ 20 sub numbers {
+ 21 	loop (my $i = 0; $i <= @a.end; $i += 2) {  # Only every second value is a Main Ring Value
+ 22 
+ 23 		my @win = @a[$i-1 .. $i+1]; # Create window of 3 numbers that shifts along array
+ 24 		@win[0] = 0 if $i==0;       # At begin, set window first element to zero
+ 25 		@win[2] = 0 if $i==@a.end;  # At end,   set window last  element to zero
+ 26 
+ 27 		my $c = join("",@win) ~~ m:g/x/;  # How many x are in window
+ 28 		my $nr = $c.chars;
+ 29 		if ($nr == 1) {                   # Only if 1 value is missing, determine next value
+ 30 			if (@win[1] eq 'x') { @a[$i] = 11 - @win[0] - @win[2]; } 
+ 31 			elsif (@win[0] eq 'x') { @a[$i-1] = 11 - @win[1] - @win[2]; }
+ 32 			elsif (@win[2] eq 'x') { @a[$i+1] = 11 - @win[1] - @win[0]; }
+ 33 		}
+ 34 	} 
+ 35 }
+
+
+ +

Sourcecode for Python

+ +

Also the Python processing is similar to the above. Here the code is different in several cases.

+ +

In Python exists a simple list. I first tried to solve this with an array or a numpy array. But for this case it was too complicated. This simple list can do the job very "simple".

+ +
 a = [9,"x",5,'x','x','x',7,'x',8]
+ +

Determining the number of missing values:

+ +
 nrx = a.count("x")
+ +

In Python no do-while loop exists, this is done only with while and a break statement:

+ +
 while True:
+   ...
+   if nrx == 0: break
+ +

Also the for loop with the step of 2 is solved differently:

+ +
 while start <= end:
+   start += 2
+   ...
+ +
+
 Python 

+  1 #!/usr/bin/python
+  2 
+  3 print "ch-1.py, PWC #43 Task #1: Olympic rings."
+  4 
+  5 def numbers():
+  6   start = 0
+  7   end   = 8
+  8   while start <= end:
+  9     i = start
+ 10     start += 2
+ 11 
+ 12     if i == 0  : win = [0,a[i],a[i+1]]
+ 13     elif i == 8: win = [a[i-1],a[i],0]
+ 14     else       : win = [a[i-1],a[i],a[i+1]]
+ 15 
+ 16     nr = win.count("x")
+ 17     if nr == 1:
+ 18       if win[1] == 'x': a[i] = 11 - win[0] - win[2] 
+ 19       elif win[0] == 'x': a[i-1] = 11 - win[1] - win[2]
+ 20       elif win[2] == 'x': a[i+1] = 11 - win[1] - win[0]
+ 21 
+ 22 # ---------------- MAIN -------------------
+ 23 
+ 24 a = [9,"x",5,'x','x','x',7,'x',8]
+ 25 print "Values: ", a
+ 26 
+ 27 while True:
+ 28   numbers()
+ 29   nrx = a.count("x")
+ 30   if nrx == 0: break
+ 31 
+ 32 print "Result: ", a
+
+
+ +

AUTHOR

+ +

Chuck

+ + + +
+ Perl Weekly Challenge #43 Task #1, Olympic Rings +
+ + + + + + diff --git a/challenge-043/burkhard-nickels/perl5/ch-1.pl b/challenge-043/burkhard-nickels/perl5/ch-1.pl new file mode 100755 index 0000000000..2428e2dc0b --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/ch-1.pl @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +print "ch-1.pl, PWC #43 Task #1: Olympic Rings\n"; +my $DEBUG=0; + +my @a = (9,'x',5,'x','x','x',7,'x',8); + +print "Values: ", join("-",@a), "\n"; +my $nrx; # Number of x in array +do { + numbers(); + $nrx = () = join("",@a) =~ /x/g; # Determine Nr of x +} while($nrx); # if Nr of x + +print "Result: ", join("-",@a), "\n"; + +# ------------------- function to determine missing numbers +sub numbers { + for(my $i=0; $i<=$#a; $i+=2) { # Only every second value is a Main Ring Value + + my @win = @a[$i-1 .. $i+1]; # Create window of 3 numbers that shifts along array + $win[0] = 0 if $i==0; # At begin, set window first element to zero + $win[2] = 0 if $i==$#a; # At end, set window last element to zero + + my $nr = () = join("",@win) =~ /x/g; # How many x are in window + print "($i) Win(", join("/",@win), ") Nrx $nr\n" if $DEBUG; + if($nr == 1) { # Only if 1 value is missing, determine next value + if($win[1] eq 'x') { $a[$i] = 11 - $win[0] - $win[2]; } + elsif($win[0] eq 'x') { $a[$i-1] = 11 - $win[1] - $win[2]; } + elsif($win[2] eq 'x') { $a[$i+1] = 11 - $win[1] - $win[0]; } + } + } +} + diff --git a/challenge-043/burkhard-nickels/perl5/ch-1.pod b/challenge-043/burkhard-nickels/perl5/ch-1.pod new file mode 100755 index 0000000000..302c6539a3 --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/ch-1.pod @@ -0,0 +1,276 @@ +#!/usr/bin/perldoc + +=head1 Perl Weekly Challenge #43 Task #1: Olympic Rings + +This task is solved with flattening the olympic ring values into an array, +setting each missing value to 'x' and letting a window of 3 elements running +over the whole array. In case that on this window is only one value missing, +it can be calculated. The window is iterating over the array as long as a +x-value exists. + +=over 3 + +=item * do-while loop while any x in array. + +=item * for loop with a step of 2. + +=item * Array slice of 3 elements (window). + +=item * Match operator to determine the number of missing elements. + +=back + +=begin html + +

Download and References

+Download File: Perl5 Solution PWC #43 Task #1 ch-1.pl
+Download File: Perl6 Solution PWC #43 Task #1 ch-1.p6
+Download File: Python Solution PWC #43 Task #1 ch-1.py
+
+ +=end html + +=head1 SYNOPSIS + + # ./ch-1.pl - Program execution + # ./ch-1.p6 - Program execution + # ./ch-1.py - Program execution + # perldoc ch-1.pod - POD + + # ./ch-1.pl + ch-1.pl (Version 1.0) PWC #43 Task #1: Olympic Rings + Values: 9-x-5-x-x-x-7-x-8 + Result: 9-2-5-4-6-1-7-3-8 + +=cut + +# ====================== TASK 1 ============================== + +=head1 Definition Task #1: Olympic Rings + +There are 5 rings in the Olympic Logo as shown below. +They are color coded as in Blue, Black, Red, Yellow and Green. + +Olympic Rings + + RED GRN BL YLW BLU + ( 9 (x) 5 (x) x (x) 7 (x) 8 ) + +(Chuck: For a better graphic look at PWC, my ASCII graphic here +is not optimal.) + +We have allocated some numbers to these rings as below: + Blue: 8 + Yellow: 7 + Green: 5 + Red: 9 + +The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. +Write a script to place these numbers in the rings so that the sum of numbers +in each ring is exactly 11. + + +=head1 Sourcecode for Perl5 + +The Olympic Ring values and the intersected values are stored in an array with +each missing value set to 'x'. + + my @a = (9,'x',5,'x','x','x',7,'x',8); + +The number of missing values is determined with the matching operator. As long +as there are missing values the do-while loop is iterated. + + $nrx = () = join("",@a) =~ /x/g; + +Every second value (every olympic ring) is iterated in a for loop. + + for(my $i=0; $i<=$#a; $i+=2) + +A window of three values (before and after the iteration steps) is extracted. +If only one of the three values is missing, this value is calculated. + + my @win = @a[$i-1 .. $i+1]; + $win[0] = 0 if $i==0; + $win[2] = 0 if $i==$#a; + +Calculation of the missing value. + + if($nr == 1) { + if($win[1] eq 'x') { $a[$i] = 11 - $win[0] - $win[2]; } + elsif($win[0] eq 'x') { $a[$i-1] = 11 - $win[1] - $win[2]; } + elsif($win[2] eq 'x') { $a[$i+1] = 11 - $win[1] - $win[0]; } + } + +=begin html + +
+
 Perl5 

+  1 #!/usr/bin/perl
+  2 
+  3 use strict;
+  4 use warnings;
+  5 
+  6 print "ch-1.pl, PWC #43 Task #1: Olympic Rings\n";
+  7 my $DEBUG=0;
+  8 
+  9 my @a = (9,'x',5,'x','x','x',7,'x',8);
+ 10 
+ 11 print "Values: ", join("-",@a), "\n";
+ 12 my $nrx;                             # Number of x in array
+ 13 do {
+ 14 	numbers();
+ 15 	$nrx = () = join("",@a) =~ /x/g; # Determine Nr of x
+ 16 } while($nrx);                       # if Nr of x
+ 17 
+ 18 print "Result: ", join("-",@a), "\n";
+ 19 
+ 20 # ------------------- function to determine missing numbers
+ 21 sub numbers {
+ 22 	for(my $i=0; $i<=$#a; $i+=2) {  # Only every second value is a Main Ring Value
+ 23 
+ 24 		my @win = @a[$i-1 .. $i+1]; # Create window of 3 numbers that shifts along array
+ 25 		$win[0] = 0 if $i==0;       # At begin, set window first element to zero
+ 26 		$win[2] = 0 if $i==$#a;     # At end,   set window last  element to zero
+ 27 
+ 28 		my $nr = () = join("",@win) =~ /x/g;  # How many x are in window
+ 29 		print "($i) Win(", join("/",@win), ") Nrx $nr\n" if $DEBUG;
+ 30 		if($nr == 1) {                     # Only if 1 value is missing, determine next value
+ 31 			if($win[1] eq 'x') { $a[$i] = 11 - $win[0] - $win[2]; } 
+ 32 			elsif($win[0] eq 'x') { $a[$i-1] = 11 - $win[1] - $win[2]; }
+ 33 			elsif($win[2] eq 'x') { $a[$i+1] = 11 - $win[1] - $win[0]; }
+ 34 		}
+ 35 	} 
+ 36 }
+
+
+ +=end html + +=head1 Sourcecode for Perl6 + +The processing for Perl6 is equivalent to that explained for Perl5. Only the syntax +here is different. + +=begin html + +
+
 Perl6 

+  1 #!/home/chuck/rakudo/bin/perl6
+  2 
+  3 use strict;
+  4 
+  5 print "ch-1.p6, PWC #43 Task #1: Olympic Rings\n";
+  6 
+  7 my @a = (9,'x',5,'x','x','x',7,'x',8);
+  8 
+  9 print "Values: ", join("-",@a), "\n";
+ 10 my ($c,$nrx);                               # Number of x in array
+ 11 repeat {
+ 12 	numbers();
+ 13 	$c = join("",@a) ~~ m:g/x/;  # Determine Nr of x
+ 14 	$nrx = $c.chars;
+ 15 } while ($nrx);                  # if Nr of x
+ 16 
+ 17 print "Result: ", join("-",@a), "\n";
+ 18 
+ 19 # ------------------- function to determine missing numbers
+ 20 sub numbers {
+ 21 	loop (my $i = 0; $i <= @a.end; $i += 2) {  # Only every second value is a Main Ring Value
+ 22 
+ 23 		my @win = @a[$i-1 .. $i+1]; # Create window of 3 numbers that shifts along array
+ 24 		@win[0] = 0 if $i==0;       # At begin, set window first element to zero
+ 25 		@win[2] = 0 if $i==@a.end;  # At end,   set window last  element to zero
+ 26 
+ 27 		my $c = join("",@win) ~~ m:g/x/;  # How many x are in window
+ 28 		my $nr = $c.chars;
+ 29 		if ($nr == 1) {                   # Only if 1 value is missing, determine next value
+ 30 			if (@win[1] eq 'x') { @a[$i] = 11 - @win[0] - @win[2]; } 
+ 31 			elsif (@win[0] eq 'x') { @a[$i-1] = 11 - @win[1] - @win[2]; }
+ 32 			elsif (@win[2] eq 'x') { @a[$i+1] = 11 - @win[1] - @win[0]; }
+ 33 		}
+ 34 	} 
+ 35 }
+
+
+ +=end html + +=head1 Sourcecode for Python + +Also the Python processing is similar to the above. Here the code is different in +several cases. + +In Python exists a simple C. I first tried to solve this with an array or +a numpy array. But for this case it was too complicated. This simple C can +do the job very "simple". + + a = [9,"x",5,'x','x','x',7,'x',8] + +Determining the number of missing values: + + nrx = a.count("x") + +In Python no do-while loop exists, this is done only with while and a break statement: + + while True: + ... + if nrx == 0: break + +Also the for loop with the step of 2 is solved differently: + + while start <= end: + start += 2 + ... + +=begin html + +
+
 Python 

+  1 #!/usr/bin/python
+  2 
+  3 print "ch-1.py, PWC #43 Task #1: Olympic rings."
+  4 
+  5 def numbers():
+  6   start = 0
+  7   end   = 8
+  8   while start <= end:
+  9     i = start
+ 10     start += 2
+ 11 
+ 12     if i == 0  : win = [0,a[i],a[i+1]]
+ 13     elif i == 8: win = [a[i-1],a[i],0]
+ 14     else       : win = [a[i-1],a[i],a[i+1]]
+ 15 
+ 16     nr = win.count("x")
+ 17     if nr == 1:
+ 18       if win[1] == 'x': a[i] = 11 - win[0] - win[2] 
+ 19       elif win[0] == 'x': a[i-1] = 11 - win[1] - win[2]
+ 20       elif win[2] == 'x': a[i+1] = 11 - win[1] - win[0]
+ 21 
+ 22 # ---------------- MAIN -------------------
+ 23 
+ 24 a = [9,"x",5,'x','x','x',7,'x',8]
+ 25 print "Values: ", a
+ 26 
+ 27 while True:
+ 28   numbers()
+ 29   nrx = a.count("x")
+ 30   if nrx == 0: break
+ 31 
+ 32 print "Result: ", a
+
+
+ +=end html + + +=cut + +=head1 AUTHOR + +Chuck + +=cut + +# ############################## END ############################################# + diff --git a/challenge-043/burkhard-nickels/perl5/ch-1.py b/challenge-043/burkhard-nickels/perl5/ch-1.py new file mode 100755 index 0000000000..fb4535beb1 --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/ch-1.py @@ -0,0 +1,33 @@ +#!/usr/bin/python + +print "ch-1.py, PWC #43 Task #1: Olympic rings." + +def numbers(): + start = 0 + end = 8 + while start <= end: + i = start + start += 2 + + if i == 0 : win = [0,a[i],a[i+1]] + elif i == 8: win = [a[i-1],a[i],0] + else : win = [a[i-1],a[i],a[i+1]] + + nr = win.count("x") + if nr == 1: + if win[1] == 'x': a[i] = 11 - win[0] - win[2] + elif win[0] == 'x': a[i-1] = 11 - win[1] - win[2] + elif win[2] == 'x': a[i+1] = 11 - win[1] - win[0] + +# ---------------- MAIN ------------------- + +a = [9,"x",5,'x','x','x',7,'x',8] +print "Values: ", a + +while True: + numbers() + nrx = a.count("x") + if nrx == 0: break + +print "Result: ", a + diff --git a/challenge-043/burkhard-nickels/perl5/ch-2.html b/challenge-043/burkhard-nickels/perl5/ch-2.html new file mode 100644 index 0000000000..a5cdb8e7be --- /dev/null +++ b/challenge-043/burkhard-nickels/perl5/ch-2.html @@ -0,0 +1,464 @@ + + + + +Perl Weekly Challenge #43 Task #2, Self-descriptive Numbers + + + + + + + + +
+ Perl Weekly Challenge #43 Task #2, Self-descriptive Numbers +
+ + + + + +

Perl Weekly Challenge #43 Task #2: Self-descriptive Numbers

+ +

The Task "Self-descriptive Numbers" I did in an iterative way. I created the code together with understanding the problem. So I am not sure if the solution is not only one solution, but rather a discussion of the several approaches to the solution.

+ +

First I simply tried to code a solution with applying the formula given on the wiki page below. And verifying if it is a "Self-descriptive Number" in comparing some integer values. But because of a different Base on each number I did a second approach with hexadecimal numbers. For this I created even a class "Hex", because I became confused where I have an integer or a hex value. But since the Base is above 15 the number room is still not enough and in a third approach I was going to all letters of the alphabet. And I compared strings to verify the "Self-descriptive Numbers".

+ +

So what are the highlights:

+ +
    + +

  • Perl5, Perl6 solution.

    + +
    • +

  • Using integer digits for Base up to 9, hex digits for Base up to 15 and letters for higher basis.

    + +
    • +

  • Using module bigint, because it gets to very high integer numbers.

    + +
    • +

  • Comparing integer "!=", hex with operator overloading, and chars with "ne".

    + +
    • +

  • Creating a class "Hex" with operator overloading.

    + +
    • +
+ +

Download and References

+Download File: Perl5 Solution PWC #43 Task #2 ch-2.pl
+Download File: Perl6 Solution PWC #43 Task #2 ch-2.p6
+
+ Perl6 OO Programming: +docs.perl6.org: Objects
+ Perl6 OO Tutorial: +docs.perl6.org: Class Tutorial
+ Raku Design Overloading: +design.raku.org: Overloading
+ +

SYNOPSIS

+ +
 # ./ch-2.pl            - Execution of program
+ # ./ch-2.p6            - Execution of program
+ # perldoc ch-2.pod             - POD
+
+ # ./ch-2.p6
+ ch-2.p6, PWC #43 Task #2: Self-descriptive Numbers
+ Base:  4, Nmbr:                            100,                      1210 = self-descriptive
+ Base:  5, Nmbr:                           1025,                     13100 = NOT self-descriptive
+ Base:  6, Nmbr:                          18576,                    222000 = NOT self-descriptive
+ Base:  7, Nmbr:                         389305,                   3211000 = self-descriptive
+ Base:  8, Nmbr:                        8946176,                  42101000 = self-descriptive
+ Base:  9, Nmbr:                      225331713,                 521001000 = self-descriptive
+ Base: 10, Nmbr:                     6210001000,                6210001000 = self-descriptive
+ Base: 11, Nmbr:                   186492227801,               72100001000 = self-descriptive
+ Base: 12, Nmbr:                  6073061476032,              821000001000 = self-descriptive
+ Base: 13, Nmbr:                213404945384449,             9210000001000 = self-descriptive
+ Base: 14, Nmbr:               8054585122464440,            a2100000001000 = self-descriptive
+ Base: 15, Nmbr:             325144322753909625,           b21000000001000 = self-descriptive
+ Base: 16, Nmbr:           13983676842985394176,          c210000000001000 = self-descriptive
+ Base: 17, Nmbr:          638488718313248327681,         d2100000000001000 = self-descriptive
+ Base: 18, Nmbr:        30852387539151417415368,        e21000000000001000 = self-descriptive
+ Base: 19, Nmbr:      1573159469597805848539033,       f210000000000001000 = self-descriptive
+ Base: 20, Nmbr:     84423475200000000000008000,      g2100000000000001000 = self-descriptive
+ Base: 21, Nmbr:   4756841174671235094613299201,     h21000000000000001000 = self-descriptive
+ Base: 22, Nmbr: 280793005454401827960409041304,    i210000000000000001000 = self-descriptive
+ Base: 23, Nmbr: 17329741584816652890845493751865,   j2100000000000000001000 = self-descriptive
+ Base: 24, Nmbr: 1116173987440750653627851819988480,  k21000000000000000001000 = self-descriptive
+ +

Definition Task #2: Self-descriptive Numbers

+ +

Write a script to generate Self-descriptive Numbers in a given base.

+ +

In mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b - 1) counts how many instances of digit n are in m.

+ +
 b = 10
+ m = 6210001000
+
+   n = pos 0 ... pos b-1
+   0 1 2 3 4 5 6 7 8 9  = pos n
+   6 2 1 0 0 0 1 0 0 0  = 10 = b long
+
+   6 x '0'
+   2 x '1'
+   1 x '2'
+   0 x '0'
+   ...
+
+   Like said on wikipedia (see links above):
+   - there are no self-descriptive numbers for base 1,2,3 and 6
+   - for 4 and 5 ?
+   - for b >= 7 following formula is doing the calculation
+
+   (b-4) * b^(b-1) + 2*b^(b-2) + b^(b-3) + b^3
+ +

For example, if the given base is 10, then script should print 6210001000. For more information, please checkout wiki page.

+ +

Solution for Perl5

+ +

Now a little bit explanation of the code. First I iterate with a for loop through the different base:

+ +
 12 for( my $b=4; $b<=24; $b++ ) {
+ +

The given formula calculates the decimal value of the "self-descriptive number" of each base.

+ +
 14   my $m = ($b - 4) * $b**($b-1) + 
+ 15     2 * $b**($b-2) + 
+ 16     $b**($b-3) + 
+ 17     $b**3;
+ +

Afterwards the convert() function creates a number of each base from the decimal value. With the modulo operator each digit is calculated. The integer part of the division is given to the recusive call of the convert function.

+ +
 41   my $d = int($n / $b);
+ 42   my $r = $n % $b;
+ +

Afterwards the verify() function compares each digit with the number of occurences of each value. This is done to determine if it is realy a "self-descriptive number". This is in Perl5 done in 3 ways, like described already in the introduction.

+ +

For Perl6 I implemented only the last solution.

+ +

Collection of some problems

+ +

During programming I had problems with the size of an integer value. The size of an integer can be determined on command line with the followin command:

+ +
 perl -V:[in]vsize
+ ivsize='8';           - means 64 bit integer
+ nvsize='8';           - means 64 bit float
+ +

So what is the highest number of a 64 bit integer?

+ +
 2^64 = 1,84467440737e+19
+ 2^63 = 9,22337203685e+18
+ +

I also got the following warning message.

+ +
 Base: 14, Nmbr:     8054585122464440,       a2100000001000 = NOT self-descriptive
+ Hexadecimal number > 0xffffffff non-portable at ./ch-2.pl line 60.
+ +
+
 Perl5 

+  1 #!/usr/bin/perl
+  2 
+  3