aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-121/arne-sommer/blog.txt1
-rwxr-xr-xchallenge-121/arne-sommer/perl/ch-1.pl30
-rwxr-xr-xchallenge-121/arne-sommer/perl/ch-2.pl102
-rwxr-xr-xchallenge-121/arne-sommer/perl/invert-bit-perl30
-rwxr-xr-xchallenge-121/arne-sommer/perl/travelling-salesman-nosave-perl102
-rwxr-xr-xchallenge-121/arne-sommer/perl/travelling-salesman-unduplicated-perl112
-rwxr-xr-xchallenge-121/arne-sommer/raku/ch-1.raku15
-rwxr-xr-xchallenge-121/arne-sommer/raku/ch-2.raku78
-rwxr-xr-xchallenge-121/arne-sommer/raku/invert-bit15
-rwxr-xr-xchallenge-121/arne-sommer/raku/travelling-salesman72
-rwxr-xr-xchallenge-121/arne-sommer/raku/travelling-salesman-nosave78
-rwxr-xr-xchallenge-121/arne-sommer/raku/travelling-salesman-unduplicated86
12 files changed, 721 insertions, 0 deletions
diff --git a/challenge-121/arne-sommer/blog.txt b/challenge-121/arne-sommer/blog.txt
new file mode 100644
index 0000000000..2c1a932a38
--- /dev/null
+++ b/challenge-121/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/inverted-salesman.html
diff --git a/challenge-121/arne-sommer/perl/ch-1.pl b/challenge-121/arne-sommer/perl/ch-1.pl
new file mode 100755
index 0000000000..34cb89adfb
--- /dev/null
+++ b/challenge-121/arne-sommer/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $m = $ARGV[0] // "";
+
+die "Please specify an integer in the range 0..255 (first arg)" if $m !~ /^\d+$/ || $m > 255;
+
+my $n = $ARGV[1] // "";
+
+die "Please specify an integer in the range 1..8 (second arg)" if $n !~ /^[1-8]$/;
+
+my $mask = 2 ** ($n -1);
+my $result = $m ^ $mask;
+
+if ($verbose)
+{
+ say ": Binary: ", sprintf('%08b', $n);
+ say ": Mask: ", sprintf('%08b', $mask);
+ say ": XOR: ", sprintf('%08b', $result);
+}
+
+say $result;
diff --git a/challenge-121/arne-sommer/perl/ch-2.pl b/challenge-121/arne-sommer/perl/ch-2.pl
new file mode 100755
index 0000000000..d23be7cae7
--- /dev/null
+++ b/challenge-121/arne-sommer/perl/ch-2.pl
@@ -0,0 +1,102 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Algorithm::Permute;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $matrix = $ARGV[0] // die "Please specify a matrix";
+
+if ($matrix =~ /^\d+$/)
+{
+ my @rows;
+
+ for (1 .. $matrix)
+ {
+ my @values = (0 .. $matrix -1);
+ my $p_iterator = Algorithm::Permute->new ( \@values );
+ push(@rows, join(" ", $p_iterator->next));
+ }
+
+ $matrix = join(" | ", @rows);
+
+ say ": Matrix: $matrix";
+}
+
+my @NN;
+
+for my $row (split(/\s*\|\s*/, $matrix))
+{
+ my @cols = split(/\s+/, $row);
+ push(@NN, \@cols);
+}
+
+my $size = @NN;
+
+if ($verbose)
+{
+ for my $from (0 .. $size -1)
+ {
+ for my $to (0 .. $size -1)
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: " . $NN[$from][$to];
+ }
+ }
+}
+
+say "" if $verbose;
+
+my @solution;
+my $solution_length = $size ** $size ** $size;
+my %seen;
+
+my @p2 = 0 .. $size -1;
+
+my $p_iterator = Algorithm::Permute->new ( \@p2 );
+
+PERM:
+while (my @path = $p_iterator->next)
+{
+ my $candidate = join(" ", @path);
+
+ my @p = @path;
+
+ for (1 .. $size)
+ {
+ push(@p, shift @p);
+
+ next PERM if $seen{ join(" ", @p) };
+ }
+
+ $seen{$candidate} = 1;
+
+ push(@path, $path[0]);
+ my @path2 = @path;
+
+ my $from = shift @path;
+ my $length = 0;
+
+ while (@path)
+ {
+ my $to = shift @path;
+ $length += $NN[$from][$to];
+ say ": " . join(" ", @path2) . " | $from -> $to = " . $NN[$from][$to] . " (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ if ($solution_length > $length)
+ {
+ $solution_length = $length;
+ @solution = @path2;
+ }
+}
+
+say "length = $solution_length";
+say "tour = (" . join(" ", @solution) . ")";
diff --git a/challenge-121/arne-sommer/perl/invert-bit-perl b/challenge-121/arne-sommer/perl/invert-bit-perl
new file mode 100755
index 0000000000..34cb89adfb
--- /dev/null
+++ b/challenge-121/arne-sommer/perl/invert-bit-perl
@@ -0,0 +1,30 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $m = $ARGV[0] // "";
+
+die "Please specify an integer in the range 0..255 (first arg)" if $m !~ /^\d+$/ || $m > 255;
+
+my $n = $ARGV[1] // "";
+
+die "Please specify an integer in the range 1..8 (second arg)" if $n !~ /^[1-8]$/;
+
+my $mask = 2 ** ($n -1);
+my $result = $m ^ $mask;
+
+if ($verbose)
+{
+ say ": Binary: ", sprintf('%08b', $n);
+ say ": Mask: ", sprintf('%08b', $mask);
+ say ": XOR: ", sprintf('%08b', $result);
+}
+
+say $result;
diff --git a/challenge-121/arne-sommer/perl/travelling-salesman-nosave-perl b/challenge-121/arne-sommer/perl/travelling-salesman-nosave-perl
new file mode 100755
index 0000000000..d23be7cae7
--- /dev/null
+++ b/challenge-121/arne-sommer/perl/travelling-salesman-nosave-perl
@@ -0,0 +1,102 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Algorithm::Permute;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $matrix = $ARGV[0] // die "Please specify a matrix";
+
+if ($matrix =~ /^\d+$/)
+{
+ my @rows;
+
+ for (1 .. $matrix)
+ {
+ my @values = (0 .. $matrix -1);
+ my $p_iterator = Algorithm::Permute->new ( \@values );
+ push(@rows, join(" ", $p_iterator->next));
+ }
+
+ $matrix = join(" | ", @rows);
+
+ say ": Matrix: $matrix";
+}
+
+my @NN;
+
+for my $row (split(/\s*\|\s*/, $matrix))
+{
+ my @cols = split(/\s+/, $row);
+ push(@NN, \@cols);
+}
+
+my $size = @NN;
+
+if ($verbose)
+{
+ for my $from (0 .. $size -1)
+ {
+ for my $to (0 .. $size -1)
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: " . $NN[$from][$to];
+ }
+ }
+}
+
+say "" if $verbose;
+
+my @solution;
+my $solution_length = $size ** $size ** $size;
+my %seen;
+
+my @p2 = 0 .. $size -1;
+
+my $p_iterator = Algorithm::Permute->new ( \@p2 );
+
+PERM:
+while (my @path = $p_iterator->next)
+{
+ my $candidate = join(" ", @path);
+
+ my @p = @path;
+
+ for (1 .. $size)
+ {
+ push(@p, shift @p);
+
+ next PERM if $seen{ join(" ", @p) };
+ }
+
+ $seen{$candidate} = 1;
+
+ push(@path, $path[0]);
+ my @path2 = @path;
+
+ my $from = shift @path;
+ my $length = 0;
+
+ while (@path)
+ {
+ my $to = shift @path;
+ $length += $NN[$from][$to];
+ say ": " . join(" ", @path2) . " | $from -> $to = " . $NN[$from][$to] . " (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ if ($solution_length > $length)
+ {
+ $solution_length = $length;
+ @solution = @path2;
+ }
+}
+
+say "length = $solution_length";
+say "tour = (" . join(" ", @solution) . ")";
diff --git a/challenge-121/arne-sommer/perl/travelling-salesman-unduplicated-perl b/challenge-121/arne-sommer/perl/travelling-salesman-unduplicated-perl
new file mode 100755
index 0000000000..9136bbf895
--- /dev/null
+++ b/challenge-121/arne-sommer/perl/travelling-salesman-unduplicated-perl
@@ -0,0 +1,112 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Algorithm::Permute;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $matrix = $ARGV[0] // die "Please specify a matrix";
+
+if ($matrix =~ /^\d+$/)
+{
+ my @rows;
+
+ for (1 .. $matrix)
+ {
+ my @values = (0 .. $matrix -1);
+ my $p_iterator = Algorithm::Permute->new ( \@values );
+ push(@rows, join(" ", $p_iterator->next));
+ }
+
+ $matrix = join(" | ", @rows);
+
+ say ": Matrix: $matrix";
+}
+
+my @NN;
+
+for my $row (split(/\s*\|\s*/, $matrix))
+{
+ my @cols = split(/\s+/, $row);
+ push(@NN, \@cols);
+}
+
+my $size = @NN;
+
+if ($verbose)
+{
+ for my $from (0 .. $size -1)
+ {
+ for my $to (0 .. $size -1)
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: " . $NN[$from][$to];
+ }
+ }
+}
+
+say "" if $verbose;
+
+my %solutions;
+my %seen;
+
+my @p2 = 0 .. $size -1;
+
+my $p_iterator = Algorithm::Permute->new ( \@p2 );
+
+PERM:
+while (my @path = $p_iterator->next)
+{
+ my $candidate = join(" ", @path);
+
+ my @p = @path;
+
+ for (1 .. $size)
+ {
+ push(@p, shift @p);
+
+ next PERM if $seen{ join(" ", @p) };
+ }
+
+ $seen{$candidate} = 1;
+
+ push(@path, $path[0]);
+ my @path2 = @path;
+
+ my $from = shift @path;
+ my $length = 0;
+
+ while (@path)
+ {
+ my $to = shift @path;
+ $length += $NN[$from][$to];
+ say ": " . join(" ", @path2) . " | $from -> $to = " . $NN[$from][$to] . " (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ $solutions{$length} = \@path2 unless $solutions{$length};
+}
+
+if ($verbose)
+{
+ for my $length (sort { $a cmp $b } keys %solutions)
+ {
+ for my $path ($solutions{$length})
+ {
+ say ": $length - [ " . join(" ", @{$path}) . " ]";
+ }
+ }
+}
+
+my @lengths = sort { $a cmp $b } keys %solutions;
+
+my $length = $lengths[0];
+
+say "length = $length";
+say "tour = (" . join(" ", @{$solutions{$length}}) . ")";
diff --git a/challenge-121/arne-sommer/raku/ch-1.raku b/challenge-121/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..1cc612c71f
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,15 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Int $m where 0 <= $m <= 255, Int $n where 1 <= $n <= 8, :v(:$verbose));
+
+my $mask = 2 ** ($n -1);
+my $result = $m +^ $mask;
+
+if $verbose
+{
+ say ": Binary: { $m.fmt('%08b') }";
+ say ": Mask: { $mask.fmt('%08b') }";
+ say ": XOR: { $result.fmt('%08b') }";
+}
+
+say $result;
diff --git a/challenge-121/arne-sommer/raku/ch-2.raku b/challenge-121/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..b03fc73f6e
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,78 @@
+#! /usr/bin/env raku
+
+multi MAIN (Int $N, :v(:$verbose))
+{
+ my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | ");
+
+ say ": Matrix: $matrix";
+
+ MAIN($matrix, :$verbose);
+}
+
+multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0", :v(:$verbose))
+{
+ my @NN = $matrix.split("|")>>.words>>.list;
+
+ my $size = @NN.elems;
+
+ die "All the rows and coluns must have the same length" unless all(@NN>>.elems) == $size;
+
+ if $verbose
+ {
+ for ^$size -> $from
+ {
+ for ^$size -> $to
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: @NN[$from][$to]";
+ }
+ }
+ }
+
+ say "" if $verbose;
+
+ my @solution;
+ my $solution-length = Inf;
+ my %seen;
+
+PERM:
+ for (^$size).permutations -> @path is copy
+ {
+ my $candidate = @path.join(" ");
+
+ my @p = @path.clone;
+
+ for ^$size
+ {
+ @p.push: @p.shift;
+
+ next PERM if %seen{ @p.join(" ") };
+ }
+
+ %seen{$candidate} = True;
+
+ @path.push: @path[0];
+ my @path2 = @path.clone;
+
+ my $from = @path.shift;
+ my $length = 0;
+
+ while @path
+ {
+ my $to = @path.shift;
+ $length += @NN[$from][$to];
+ say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ if ($solution-length > $length)
+ {
+ $solution-length = $length;
+ @solution = @path2;
+ }
+ }
+
+ say "length = $solution-length";
+ say "tour = ({ @solution.join(" ") })";
+}
diff --git a/challenge-121/arne-sommer/raku/invert-bit b/challenge-121/arne-sommer/raku/invert-bit
new file mode 100755
index 0000000000..1cc612c71f
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/invert-bit
@@ -0,0 +1,15 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Int $m where 0 <= $m <= 255, Int $n where 1 <= $n <= 8, :v(:$verbose));
+
+my $mask = 2 ** ($n -1);
+my $result = $m +^ $mask;
+
+if $verbose
+{
+ say ": Binary: { $m.fmt('%08b') }";
+ say ": Mask: { $mask.fmt('%08b') }";
+ say ": XOR: { $result.fmt('%08b') }";
+}
+
+say $result;
diff --git a/challenge-121/arne-sommer/raku/travelling-salesman b/challenge-121/arne-sommer/raku/travelling-salesman
new file mode 100755
index 0000000000..8dbb47dce7
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/travelling-salesman
@@ -0,0 +1,72 @@
+#! /usr/bin/env raku
+
+multi MAIN (Int $N, :v(:$verbose))
+{
+ my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | ");
+
+ say ": Matrix: $matrix";
+
+ MAIN($matrix, :$verbose);
+}
+
+multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0", :v(:$verbose))
+{
+ my @NN = $matrix.split("|")>>.words>>.list;
+
+ my $size = @NN.elems;
+
+ die "All the rows and coluns must have the same length" unless all(@NN>>.elems) == $size;
+
+ if $verbose
+ {
+ for ^$size -> $from
+ {
+ for ^$size -> $to
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: @NN[$from][$to]";
+ }
+ }
+ }
+
+ say "" if $verbose;
+
+ my %solutions;
+
+ for (^$size).permutations -> @path is copy
+ {
+ @path.push: @path[0];
+ my @path2 = @path.clone;
+
+ my $from = @path.shift;
+ my $length = 0;
+
+ while @path
+ {
+ my $to = @path.shift;
+ $length += @NN[$from][$to];
+ say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ %solutions{$length}.push: @path2;
+ }
+
+ if $verbose
+ {
+ for %solutions.keys.sort -> $length
+ {
+ for @(%solutions{$length}) -> @path
+ {
+ say ": $length - [ { @path.join(" ") } ]";
+ }
+ }
+ }
+
+ my $length = %solutions.keys.sort.first;
+
+ say "length = $length";
+ say "tour = ({ %solutions{$length}[0].join(" ") })";
+}
+
diff --git a/challenge-121/arne-sommer/raku/travelling-salesman-nosave b/challenge-121/arne-sommer/raku/travelling-salesman-nosave
new file mode 100755
index 0000000000..b03fc73f6e
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/travelling-salesman-nosave
@@ -0,0 +1,78 @@
+#! /usr/bin/env raku
+
+multi MAIN (Int $N, :v(:$verbose))
+{
+ my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | ");
+
+ say ": Matrix: $matrix";
+
+ MAIN($matrix, :$verbose);
+}
+
+multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0", :v(:$verbose))
+{
+ my @NN = $matrix.split("|")>>.words>>.list;
+
+ my $size = @NN.elems;
+
+ die "All the rows and coluns must have the same length" unless all(@NN>>.elems) == $size;
+
+ if $verbose
+ {
+ for ^$size -> $from
+ {
+ for ^$size -> $to
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: @NN[$from][$to]";
+ }
+ }
+ }
+
+ say "" if $verbose;
+
+ my @solution;
+ my $solution-length = Inf;
+ my %seen;
+
+PERM:
+ for (^$size).permutations -> @path is copy
+ {
+ my $candidate = @path.join(" ");
+
+ my @p = @path.clone;
+
+ for ^$size
+ {
+ @p.push: @p.shift;
+
+ next PERM if %seen{ @p.join(" ") };
+ }
+
+ %seen{$candidate} = True;
+
+ @path.push: @path[0];
+ my @path2 = @path.clone;
+
+ my $from = @path.shift;
+ my $length = 0;
+
+ while @path
+ {
+ my $to = @path.shift;
+ $length += @NN[$from][$to];
+ say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ if ($solution-length > $length)
+ {
+ $solution-length = $length;
+ @solution = @path2;
+ }
+ }
+
+ say "length = $solution-length";
+ say "tour = ({ @solution.join(" ") })";
+}
diff --git a/challenge-121/arne-sommer/raku/travelling-salesman-unduplicated b/challenge-121/arne-sommer/raku/travelling-salesman-unduplicated
new file mode 100755
index 0000000000..b3637e7b56
--- /dev/null
+++ b/challenge-121/arne-sommer/raku/travelling-salesman-unduplicated
@@ -0,0 +1,86 @@
+#! /usr/bin/env raku
+
+multi MAIN (Int $N, :v(:$verbose))
+{
+ my $matrix = (^$N).map({ (^$N).pick(*).join(" ") }).join(" | ");
+
+ say ": Matrix: $matrix";
+
+ MAIN($matrix, :$verbose);
+}
+
+multi MAIN (Str $matrix = "0 5 2 7 | 5 0 5 3 | 3 1 0 6 | 4 5 4 0", :v(:$verbose))
+{
+ my @NN = $matrix.split("|")>>.words>>.list;
+
+ my $size = @NN.elems;
+
+ die "All the rows and coluns must have the same length" unless all(@NN>>.elems) == $size;
+
+ if $verbose
+ {
+ for ^$size -> $from
+ {
+ for ^$size -> $to
+ {
+ next if $from == $to;
+ say ": Distance from city #$from to #$to: @NN[$from][$to]";
+ }
+ }
+ }
+
+ say "" if $verbose;
+
+ my %solutions;
+ my %seen;
+
+PERM:
+ for (^$size).permutations -> @path is copy
+ {
+ my $candidate = @path.join(" ");
+
+ my @p = @path.clone;
+
+ for ^$size
+ {
+ @p.push: @p.shift;
+
+ next PERM if %seen{ @p.join(" ") };
+ }
+
+ %seen{$candidate} = True;
+
+ @path.push: @path[0];
+ my @path2 = @path.clone;
+
+ my $from = @path.shift;
+ my $length = 0;
+
+ while @path
+ {
+ my $to = @path.shift;
+ $length += @NN[$from][$to];
+ say ": { @path2.join(" ") } | $from -> $to = @NN[$from][$to] (sum $length)" if $verbose;
+ $from = $to;
+ }
+ say "" if $verbose;
+
+ %solutions{$length}.push: @path2;
+ }
+
+ if $verbose
+ {
+ for %solutions.keys.sort -> $length
+ {
+ for @(%solutions{$length}) -> @path
+ {
+ say ": $length - [ { @path.join(" ") } ]";
+ }
+ }
+ }
+
+ my $length = %solutions.keys.sort.first;
+
+ say "length = $length";
+ say "tour = ({ %solutions{$length}[0].join(" ") })";
+}
generated by cgit (git 2.34.1) at 2026-04-14 07:47:05 +0000