Here's Perl code. It's not sophisticated, but it does solve the case you asked about. It does a depth-first search of all possible graph colorings. To use breadth-first search instead, change pop @queue
to shift @queue
. To use depth-first iterative deepening, mumble mumble mumble. The code is intended to be simple and easy to understand, rather than to be space- or time-efficient.
To run the program, use perl ramsey.pl 6
and it will inform you there is no triangle-free 2-coloring of $K_6$. If you instead try perl ramsey.pl 5
it will print out all the triangle-free 2-colorings of $K_5$. To find triangle-free 3-colorings of $K_{16}$, use perl ramsey.pl 16 3
and go get a cup a coffee. A big cup of coffee. From Timbuktu.
#!/usr/bin/perl use strict; my ($N, $c) = @ARGV; $N || usage(); $c ||= 2; my @queue = ({ "0,1" => 1, NEXT => [0,1] }); my $COUNT = 0; while (@queue) { my $config = pop @queue; for my $color (1 .. $c) { my $new_config = extend($config, $color); if (ok($new_config)) { if (is_complete($new_config)) { print_conf($new_config); $COUNT++; } else { advance_next($new_config); push @queue, $new_config; } } } } print "No solution.\n" unless $COUNT; exit; # Take a partly-colored graph and color the next edge with the specified color sub extend { my ($config, $color) = @_; my $new = copy($config); my $next_edge = $new->{NEXT}; $new->{join ",", @$next_edge} = $color; return $new; } # Update the record that says which edge to color next sub advance_next { my ($config) = @_; if ($config->{NEXT}[1] == $N-1) { $config->{NEXT} = [ $config->{NEXT}[0] + 1, $config->{NEXT}[0] + 2 ]; } else { $config->{NEXT}[1]++; } } # Is the graph completely colored? sub is_complete { my ($config) = @_; $config->{NEXT}[0] == $N-1; } # Is the graph triangle-free so far? sub ok { my ($config) = @_; my ($u, $v) = @{$config->{NEXT}}; my $c = $config->{"$u,$v"}; for my $i (0 .. $u-1) { return if $config->{"$i,$u"} == $c && $config->{"$i,$v"} == $c; } return 1; } sub copy { my ($graph) = @_; my %new = %$graph; $new{NEXT} = [ @{$graph->{NEXT}} ]; return \%new; } sub print_conf { my ($graph) = @_; for my $i (0 .. $N-2) { for my $j ($i+1 .. $N-1) { my $k = "$i,$j"; print qq{$i-$j: $graph->{$k}\n}; } } print "---\n\n"; }
Perhaps you are wondering why I used Perl. My contact specifies that I cannot be required to write Haskell code between midnight and 8 AM.