in reply to Graph labeling problem
I understand "adjacent" as "having a common vertex".
#! /usr/bin/perl use warnings; use strict; use feature qw{ say }; use Data::Dumper; use Storable qw{ dclone }; my @LABELS = 'a' .. 'z'; sub add_edge { my ($edges) = @_; for my $v1 (sort keys %$edges) { for my $v2 (sort keys %$edges) { next if $v2 <= $v1 || exists $edges->{$v1}{$v2}; my %labels = map { $_ => undef } @LABELS[0 .. keys(%$edges +) - 2]; delete @labels{ values %{ $edges->{$v1} }, values %{ $edges->{$v2} } }; next unless keys %labels; for my $l (sort keys %labels) { my $e = dclone($edges); $e->{$v1}{$v2} = $e->{$v2}{$v1} = $l; unless (grep keys %{ $e->{$_} } != keys(%$e) - 1, keys + %$e) { print Dumper $e; exit } add_edge($e); } } } } my @vertices = (1 .. shift); my %edges = (1 => {map {2 + $_ => $LABELS[$_]} 0 .. $#vertices - 1}); $edges{2 + $_} = {1 => $LABELS[$_]} for 0 .. $#vertices - 1; add_edge(\%edges);
Update: Fixed a bug in the code. It's now still running searching for the solution for 5 nodes.
Update: The code now shows solutions for sizes 4, 6, and 8; and also shows there's no solution for sizes 3 and 5. Checking all the possibilities for larger sizes seems to be very slow.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^2: Graph labeling problem
by LanX (Saint) on Feb 19, 2022 at 21:59 UTC | |
by choroba (Cardinal) on Feb 19, 2022 at 22:06 UTC | |
by LanX (Saint) on Feb 19, 2022 at 22:13 UTC | |
|
Re^2: Graph labeling problem
by baxy77bax (Deacon) on Feb 19, 2022 at 20:40 UTC | |
|
Re^2: Graph labeling problem
by etj (Priest) on Feb 20, 2022 at 15:47 UTC | |
by LanX (Saint) on Feb 20, 2022 at 15:53 UTC | |
by etj (Priest) on Feb 24, 2022 at 19:16 UTC | |
by LanX (Saint) on Feb 25, 2022 at 10:53 UTC |