Merge pull request #4635 from arnesom/branch-for-challenge-123

Arne Sommer

11 files changed, 497 insertions, 0 deletions

diff --git a/challenge-123/arne-sommer/blog.txt b/challenge-123/arne-sommer/blog.txt
new file mode 100644
index 0000000000..b66c47bf1b
--- /dev/null
+++ b/challenge-123/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/ugly-points.html
diff --git a/challenge-123/arne-sommer/factors b/challenge-123/arne-sommer/factors
new file mode 100755
index 0000000000..f21d97536f
--- /dev/null
+++ b/challenge-123/arne-sommer/factors
@@ -0,0 +1,26 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Int $number where $number > 0, :u(:$upto));
+
+$upto
+  ?? ( say "$_: " ~ factors($_) for 1..$number )
+  !! say factors($number);
+
+sub factors ($number is copy)
+{
+  return (1)       if $number == 1;
+  return ($number) if $number.is-prime;
+
+  my @factors;
+
+  for (2 .. $number div 2).grep( *.is-prime) -> $candidate
+  {
+    while $number %% $candidate
+    {
+      @factors.push: $candidate;
+      $number /= $candidate;
+    }
+  }
+    
+  return @factors;
+}
diff --git a/challenge-123/arne-sommer/perl/ch-1.pl b/challenge-123/arne-sommer/perl/ch-1.pl
new file mode 100755
index 0000000000..ea45f5532b
--- /dev/null
+++ b/challenge-123/arne-sommer/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use feature 'signatures';
+no warnings qw(experimental::signatures);
+
+use Getopt::Long;
+use Math::Prime::Util qw/is_prime/;
+use Perl6::Junction qw/all any/;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $n = $ARGV[0] || die "Please specify a positive integer";
+
+die "Please specify a positive integer" unless $n =~ /^[1-9]\d*$/;
+
+my @ugly_seq = (1);
+
+my $candidate = 2;
+
+while (1)
+{
+  last if @ugly_seq == $n;
+
+  my @prime_factors = factors($candidate);
+  push(@ugly_seq, $candidate) if all(@prime_factors) == any(2,3,5);
+  $candidate++;
+}
+
+say ": Sequence: ", join(", ", @ugly_seq) if $verbose;
+
+say $ugly_seq[$n -1];
+
+sub factors ($number)
+{
+  return (1)       if $number == 1;
+  return ($number) if is_prime($number);
+
+  my @factors;
+
+  for my $candidate (grep { is_prime($_) } 2 .. $number / 2)
+  {
+    while ($number % $candidate == 0)
+    {
+      push(@factors, $candidate);
+      $number /= $candidate;
+    }
+  }
+    
+  return @factors;
+}
diff --git a/challenge-123/arne-sommer/perl/ch-2.pl b/challenge-123/arne-sommer/perl/ch-2.pl
new file mode 100755
index 0000000000..038c080e34
--- /dev/null
+++ b/challenge-123/arne-sommer/perl/ch-2.pl
@@ -0,0 +1,69 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Scalar::Util qw(looks_like_number);
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my @args;
+
+for my $val (@ARGV)
+{
+  if ($val =~ /\,/)
+  {
+    my ($a, $b) = split(/\,/, $val);
+    push(@args, $a, $b);
+  }
+  else
+  {
+    push(@args, $val);
+  }
+}
+
+die "Wrong number of arguments" unless @args  == 8;
+
+map { die "$_: Not a numeric value" unless looks_like_number($_) } @args;
+
+my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @args;
+
+my $l12 = sqrt(abs($x2 - $x1) ** 2 + abs($y2 - $y1) ** 2);
+my $l23 = sqrt(abs($x3 - $x2) ** 2 + abs($y3 - $y2) ** 2);
+my $l34 = sqrt(abs($x4 - $x3) ** 2 + abs($y4 - $y3) ** 2);
+my $l41 = sqrt(abs($x1 - $x4) ** 2 + abs($y1 - $y4) ** 2);
+
+unless ($l12 == $l23 && $l34 == $l41 && $l12 == $l41)
+{
+  say ": The four edges does not have the same length ($l12, $l23, $l34, $l41)" if $verbose;
+  say 0;
+  exit;
+}
+
+if ($l12 == 0)
+{
+  say ": All the points have the same position" if $verbose;
+  say 0;
+  exit;
+}
+
+my $dot_product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
+
+if ($dot_product)
+{
+  say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
+  say 0;
+  exit;
+}
+
+if ($x1 == $x3 && $y1 == $y3)
+{
+  say ": Point 1 and 3 are equal" if $verbose;
+  say 0;
+  exit;
+}
+
+say 1;
diff --git a/challenge-123/arne-sommer/perl/square-points-perl b/challenge-123/arne-sommer/perl/square-points-perl
new file mode 100755
index 0000000000..038c080e34
--- /dev/null
+++ b/challenge-123/arne-sommer/perl/square-points-perl
@@ -0,0 +1,69 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Scalar::Util qw(looks_like_number);
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my @args;
+
+for my $val (@ARGV)
+{
+  if ($val =~ /\,/)
+  {
+    my ($a, $b) = split(/\,/, $val);
+    push(@args, $a, $b);
+  }
+  else
+  {
+    push(@args, $val);
+  }
+}
+
+die "Wrong number of arguments" unless @args  == 8;
+
+map { die "$_: Not a numeric value" unless looks_like_number($_) } @args;
+
+my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @args;
+
+my $l12 = sqrt(abs($x2 - $x1) ** 2 + abs($y2 - $y1) ** 2);
+my $l23 = sqrt(abs($x3 - $x2) ** 2 + abs($y3 - $y2) ** 2);
+my $l34 = sqrt(abs($x4 - $x3) ** 2 + abs($y4 - $y3) ** 2);
+my $l41 = sqrt(abs($x1 - $x4) ** 2 + abs($y1 - $y4) ** 2);
+
+unless ($l12 == $l23 && $l34 == $l41 && $l12 == $l41)
+{
+  say ": The four edges does not have the same length ($l12, $l23, $l34, $l41)" if $verbose;
+  say 0;
+  exit;
+}
+
+if ($l12 == 0)
+{
+  say ": All the points have the same position" if $verbose;
+  say 0;
+  exit;
+}
+
+my $dot_product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
+
+if ($dot_product)
+{
+  say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
+  say 0;
+  exit;
+}
+
+if ($x1 == $x3 && $y1 == $y3)
+{
+  say ": Point 1 and 3 are equal" if $verbose;
+  say 0;
+  exit;
+}
+
+say 1;
diff --git a/challenge-123/arne-sommer/perl/ugly-numbers-perl b/challenge-123/arne-sommer/perl/ugly-numbers-perl
new file mode 100755
index 0000000000..ea45f5532b
--- /dev/null
+++ b/challenge-123/arne-sommer/perl/ugly-numbers-perl
@@ -0,0 +1,55 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use feature 'signatures';
+no warnings qw(experimental::signatures);
+
+use Getopt::Long;
+use Math::Prime::Util qw/is_prime/;
+use Perl6::Junction qw/all any/;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $n = $ARGV[0] || die "Please specify a positive integer";
+
+die "Please specify a positive integer" unless $n =~ /^[1-9]\d*$/;
+
+my @ugly_seq = (1);
+
+my $candidate = 2;
+
+while (1)
+{
+  last if @ugly_seq == $n;
+
+  my @prime_factors = factors($candidate);
+  push(@ugly_seq, $candidate) if all(@prime_factors) == any(2,3,5);
+  $candidate++;
+}
+
+say ": Sequence: ", join(", ", @ugly_seq) if $verbose;
+
+say $ugly_seq[$n -1];
+
+sub factors ($number)
+{
+  return (1)       if $number == 1;
+  return ($number) if is_prime($number);
+
+  my @factors;
+
+  for my $candidate (grep { is_prime($_) } 2 .. $number / 2)
+  {
+    while ($number % $candidate == 0)
+    {
+      push(@factors, $candidate);
+      $number /= $candidate;
+    }
+  }
+    
+  return @factors;
+}
diff --git a/challenge-123/arne-sommer/raku/ch-1.raku b/challenge-123/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..58bf8a4e8e
--- /dev/null
+++ b/challenge-123/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,37 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Int $n where $n > 0, :v(:$verbose));
+
+my $ugly-seq := gather
+{
+  take 1;
+
+  for 2 .. Inf -> $candidate
+  {
+    my @prime-factors = factors($candidate);
+    take $candidate if all(@prime-factors) == any(2,3,5);
+  }
+}
+
+say ": Sequence: { $ugly-seq[^$n].join(", ") }" if $verbose;
+
+say $ugly-seq[$n -1];
+
+sub factors ($number is copy)
+{
+  return (1)       if $number == 1;
+  return ($number) if $number.is-prime;
+
+  my @factors;
+
+  for (2 .. $number div 2).grep( *.is-prime) -> $candidate
+  {
+    while $number %% $candidate
+    {
+      @factors.push: $candidate;
+      $number /= $candidate;
+    }
+  }
+    
+  return @factors;
+}
diff --git a/challenge-123/arne-sommer/raku/ch-2.raku b/challenge-123/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..edd7f245eb
--- /dev/null
+++ b/challenge-123/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,52 @@
+#! /usr/bin/env raku
+
+multi MAIN (Str $xy1, Str $xy2, Str $xy3, Str $xy4, :v(:$verbose))
+{
+  my ($x1, $y1) = $xy1.split(",")>>.Numeric;
+  my ($x2, $y2) = $xy2.split(",")>>.Numeric;
+  my ($x3, $y3) = $xy3.split(",")>>.Numeric;
+  my ($x4, $y4) = $xy4.split(",")>>.Numeric;
+
+  MAIN($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, :$verbose);
+}
+
+multi MAIN (Numeric $x1, Numeric $y1, Numeric $x2, Numeric $y2,
+            Numeric $x3, Numeric $y3, Numeric $x4, Numeric $y4, :v(:$verbose))
+{
+  my $l12 = (($x2 - $x1).abs ** 2 + ($y2 - $y1).abs ** 2).sqrt;
+  my $l23 = (($x3 - $x2).abs ** 2 + ($y3 - $y2).abs ** 2).sqrt;
+  my $l34 = (($x4 - $x3).abs ** 2 + ($y4 - $y3).abs ** 2).sqrt;
+  my $l41 = (($x1 - $x4).abs ** 2 + ($y1 - $y4).abs ** 2).sqrt;
+
+  unless $l12 == $l23 == $l34 == $l41
+  {
+    say ": The four edges does not have the same length ($l12, $l23, $l34, $l41)" if $verbose;
+    say 0;
+    exit;
+  }
+
+  if $l12 == 0
+  {
+    say ": All the points have the same position" if $verbose;
+    say 0;
+    exit;
+  }
+
+  my $dot-product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
+
+  if $dot-product
+  {
+    say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
+    say 0;
+    exit;
+  }
+
+  if $x1 == $x3 && $y1 == $y3
+  {
+    say ": Point 1 and 3 are equal" if $verbose;
+    say 0;
+    exit;
+  }
+
+  say 1;
+}
diff --git a/challenge-123/arne-sommer/raku/square-points b/challenge-123/arne-sommer/raku/square-points
new file mode 100755
index 0000000000..58a2f2044e
--- /dev/null
+++ b/challenge-123/arne-sommer/raku/square-points
@@ -0,0 +1,44 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Numeric $x1, Numeric $y1,
+               Numeric $x2, Numeric $y2,
+               Numeric $x3, Numeric $y3,
+               Numeric $x4, Numeric $y4,
+               :v(:$verbose));
+
+my $l12 = (($x2 - $x1).abs ** 2 + ($y2 - $y1).abs ** 2).sqrt;
+my $l23 = (($x3 - $x2).abs ** 2 + ($y3 - $y2).abs ** 2).sqrt;
+my $l34 = (($x4 - $x3).abs ** 2 + ($y4 - $y3).abs ** 2).sqrt;
+my $l41 = (($x1 - $x4).abs ** 2 + ($y1 - $y4).abs ** 2).sqrt;
+
+unless $l12 == $l23 == $l34 == $l41
+{
+  say ": The four edges does not have the same length ($l12, $l23, $l34, $l41)" if $verbose;
+  say 0;
+  exit;
+}
+
+if $l12 == 0
+{
+  say ": All the points have the same position" if $verbose;
+  say 0;
+  exit;
+}
+
+my $dot-product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
+
+if $dot-product
+{
+  say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
+  say 0;
+  exit;
+}
+
+if $x1 == $x3 && $y1 == $y3
+{
+  say ": Point 1 and 3 are equal" if $verbose;
+  say 0;
+  exit;
+}
+
+say 1;
diff --git a/challenge-123/arne-sommer/raku/square-points-multi b/challenge-123/arne-sommer/raku/square-points-multi
new file mode 100755
index 0000000000..edd7f245eb
--- /dev/null
+++ b/challenge-123/arne-sommer/raku/square-points-multi
@@ -0,0 +1,52 @@
+#! /usr/bin/env raku
+
+multi MAIN (Str $xy1, Str $xy2, Str $xy3, Str $xy4, :v(:$verbose))
+{
+  my ($x1, $y1) = $xy1.split(",")>>.Numeric;
+  my ($x2, $y2) = $xy2.split(",")>>.Numeric;
+  my ($x3, $y3) = $xy3.split(",")>>.Numeric;
+  my ($x4, $y4) = $xy4.split(",")>>.Numeric;
+
+  MAIN($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4, :$verbose);
+}
+
+multi MAIN (Numeric $x1, Numeric $y1, Numeric $x2, Numeric $y2,
+            Numeric $x3, Numeric $y3, Numeric $x4, Numeric $y4, :v(:$verbose))
+{
+  my $l12 = (($x2 - $x1).abs ** 2 + ($y2 - $y1).abs ** 2).sqrt;
+  my $l23 = (($x3 - $x2).abs ** 2 + ($y3 - $y2).abs ** 2).sqrt;
+  my $l34 = (($x4 - $x3).abs ** 2 + ($y4 - $y3).abs ** 2).sqrt;
+  my $l41 = (($x1 - $x4).abs ** 2 + ($y1 - $y4).abs ** 2).sqrt;
+
+  unless $l12 == $l23 == $l34 == $l41
+  {
+    say ": The four edges does not have the same length ($l12, $l23, $l34, $l41)" if $verbose;
+    say 0;
+    exit;
+  }
+
+  if $l12 == 0
+  {
+    say ": All the points have the same position" if $verbose;
+    say 0;
+    exit;
+  }
+
+  my $dot-product = ($x2 - $x1) * ($y2 - $y1) + ($x4 - $x1) * ($y4 - $y1);
+
+  if $dot-product
+  {
+    say ": Not 90 Degrees between lines 1-2 and 1-4" if $verbose;
+    say 0;
+    exit;
+  }
+
+  if $x1 == $x3 && $y1 == $y3
+  {
+    say ": Point 1 and 3 are equal" if $verbose;
+    say 0;
+    exit;
+  }
+
+  say 1;
+}
diff --git a/challenge-123/arne-sommer/raku/ugly-numbers b/challenge-123/arne-sommer/raku/ugly-numbers
new file mode 100755
index 0000000000..58bf8a4e8e
--- /dev/null
+++ b/challenge-123/arne-sommer/raku/ugly-numbers
@@ -0,0 +1,37 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Int $n where $n > 0, :v(:$verbose));
+
+my $ugly-seq := gather
+{
+  take 1;
+
+  for 2 .. Inf -> $candidate
+  {
+    my @prime-factors = factors($candidate);
+    take $candidate if all(@prime-factors) == any(2,3,5);
+  }
+}
+
+say ": Sequence: { $ugly-seq[^$n].join(", ") }" if $verbose;
+
+say $ugly-seq[$n -1];
+
+sub factors ($number is copy)
+{
+  return (1)       if $number == 1;
+  return ($number) if $number.is-prime;
+
+  my @factors;
+
+  for (2 .. $number div 2).grep( *.is-prime) -> $candidate
+  {
+    while $number %% $candidate
+    {
+      @factors.push: $candidate;
+      $number /= $candidate;
+    }
+  }
+    
+  return @factors;
+}