Data commit

Task/Graph-colouring/Raku/graph-colouring.raku

@@ -0,0 +1,38 @@
+sub GraphNodeColor(@RAW) {
+   my %OneMany = my %NodeColor;
+   for @RAW { %OneMany{$_[0]}.push: $_[1] ; %OneMany{$_[1]}.push: $_[0] }
+   my @ColorPool = "0", "1" … ^+%OneMany.elems; # as string
+   my %NodePool  = %OneMany.BagHash; # this DWIM is nice
+   if %OneMany<NaN>:exists { %NodePool{$_}:delete for %OneMany<NaN>, NaN } # pending
+   while %NodePool.Bool {
+      my $color = @ColorPool.shift;
+      my %TempPool = %NodePool;
+      while (my \n = %TempPool.keys.sort.first) {
+         %NodeColor{n} = $color;
+         %TempPool{n}:delete;
+         %TempPool{$_}:delete for @(%OneMany{n}) ; # skip neighbors as well
+         %NodePool{n}:delete;
+      }
+   }
+   if %OneMany<NaN>:exists { # islanders use an existing color
+      %NodeColor{$_} = %NodeColor.values.sort.first for @(%OneMany<NaN>)
+   }
+   return %NodeColor
+}
+
+my \DATA = [
+   [<0 1>,<1 2>,<2 0>,<3 NaN>,<4 NaN>,<5 NaN>],
+   [<1 6>,<1 7>,<1 8>,<2 5>,<2 7>,<2 8>,<3 5>,<3 6>,<3 8>,<4 5>,<4 6>,<4 7>],
+   [<1 4>,<1 6>,<1 8>,<3 2>,<3 6>,<3 8>,<5 2>,<5 4>,<5 8>,<7 2>,<7 4>,<7 6>],
+   [<1 6>,<7 1>,<8 1>,<5 2>,<2 7>,<2 8>,<3 5>,<6 3>,<3 8>,<4 5>,<4 6>,<4 7>],
+];
+
+for DATA {
+   say "DATA   : ", $_;
+   say "Result : ";
+   my %out = GraphNodeColor $_;
+   say "$_[0]-$_[1]:\t Color %out{$_[0]} ",$_[1].isNaN??''!!%out{$_[1]} for @$_;
+   say "Nodes  : ", %out.keys.elems;
+   say "Edges  : ", $_.elems;
+   say "Colors : ", %out.values.Set.elems;
+}