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);
[download]

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.

> I understand "adjacent" as "having a common vertex".

Probably I'm having a fundamental misunderstanding of the problem ...

... but I think with just one more color it's trivial!

Consider an incidence matrix (Node x Node) with the colors given in the cells (here RGBYCM...)

Now a solution for N colors (instead of N-1) is straightforward, we just rotate the N colors left for each row.

NB:

• The colors must be symmetric to the diagonal, because it's not a directed graph - i.e. (a,b)=(b,a) etc. That's guarantied by the rotation.
• The diagonal must be "emptied" at the end, because circular edges aren't allowed- i.e. (a,a)=undef Hence one color is missing in each row and column.

    
N=3

   a  b  c
a     R  G
b  R     B
c  G  B
[download]

    
N=4

   a  b  c  d
a     R  G  B
b  R     B  Y
c  G  B     R  
d  B  Y  R
[download]

    
N=5

   a  b  c  d  e  
a     R  G  B  Y  
b  R     B  Y  C  
c  G  B     C  R        
d  B  Y  C     G    
e  Y  C  R  G
[download]

    
N=6

   a  b  c  d  e  f
a     R  G  B  Y  C
b  R     B  Y  C  M
c  G  B     C  M  R      
d  B  Y  C     R  G    
e  Y  C  M  R     B     
f  C  M  R  G  B
[download]

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

> Probably I'm having a fundamental misunderstanding of the problem ...

Why? Do you understand "adjacent" in a different way?

> but I think with one more color it's trivial

Why "but"? I think so, too.

map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

when i was checking it manually i checked for 4 and 6 and just naively concluded there must be for others but u R right , 3 and 5 so far do not have the solution |N|-1!

             e
+-----------------------+
|        b              |
+-----------------+     |
|      d          |     |
+-----------+     |     |
|  a     b  |  e  |  a  |
1-----2-----3-----4-----5
      |     |     c     |
      |     +-----------+
      |        d        |
      +-----------------+
      
      |     c     |
      +-----------+
[download]

PS this is definitely a solution but as u said for larger graphs it takes forever.
Thnx!

You'd probably be better off using the Graph module rather than rolling your own?

Could you please elaborate how?

There is no mention of colo(u)r in the whole POD of Graph

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

This sounds like the map colouring problem to me. I don't know if there are modules already written to handle this challenge.

PS In planar geometry this can be solved with four colours, but if you're dealing with a torus, you need to go up to seven colours. Math is cool. :)

> This sounds like the map colouring problem to me.

Good idea, but the OP seems to talk about complete graphs where every pair of vertices is connected.

For bigger N this is way beyond the planar graphs needed for the map coloring problem.

But following the links given leads to Edge coloring, which seems to be fit the problem's description.

and the Example section states:

• A complete graph Kn with n vertices is edge-colorable with n − 1 colors when n is an even number; ...
• However, when n is odd, n colors are needed: ...

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

Thnx! I did not know about that

Here's solutions for 2,4,6,8,10 and proves? none for 3,5,7

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11141490
use warnings;
use ntheory qw( forperm );
use List::AllUtils qw( none );

for my $n ( 2 .. 8, 10 )
  {
  my @cols;
  forperm { my $c = join '', map +('-', 'a'..'z', 'A' .. 'Z')[$_], @_;
    push @{ $cols[ index $c, '-' ] }, $c } $n;
  my $start = $cols[0][0];
  eval { find( "$start\n", @cols[1 .. $#cols ] ) };
  }

sub transpose
  {
  (local $_, my $new) = (shift, '');
  $new .= "\n" while s/^./ $new .= $&; ''/gem;
  return $new;
  }

sub find
  {
  my ($have, @next) = @_;
  my $flip = transpose($have);
  @next or $have eq $flip and warn( "$have\n"), die;
  my $pat = (split /\n/, $flip)[index $flip, "\n"];
  my @haves = split /\n/, $have;
  my $trys = shift @next;
  for my $try ( grep /^$pat/, @$trys )
    {
    none { ("$try" ^ "$_") =~ tr/\0// } @haves, and
      find( "$have$try\n", @next );
    }
  }
[download]

Outputs:

-a
a-

-abc
a-cb
bc-a
cba-

-abcde
a-cdeb
bc-ead
cde-ba
deab-c
ebdac-

-abcdefg
a-cbedgf
bc-afgde
cba-gfed
defg-abc
edgfa-cb
fgdebc-a
gfedcba-

-abcdefghi
a-cbedgfih
bc-afghide
cba-ghidef
defg-iahbc
edghi-bcfa
fghiab-ecd
gfidhce-ab
hidebfca-g
ihefcadbg-


real    0m8.080s
user    0m7.986s
sys     0m0.090s
[download]

I think you are dealing with factorials, so good luck with 50 factorial!!

On the other hand, I could be wrong...

> proves? none for 3,5,7

That prove is easy for n odd.

All k edges of same color of a hypothetical solution connect at most 2k different nodes.

But n is odd, hence one node must skip that color.

Or

A complete graph Kn has n*(n-1)/2 edges and (n-1)/2 is the max number of edges of same color for n odd.

So n is the min of needed colors.

And I've already shown an easy construction with n colors for all Kn (odd and even).

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

> I think you are dealing with factorials, so good luck with 50 factorial!!

the wikipedia article shows an easy construction for an even n with n-1 colors.

A picture showing the solution for K8 is given too.

Basically, if you have a regular n-1 polygon plus it's center and connect all the nodes you'll have a Kn graph. Because of the regularity this graph has n-1 groups of (n-2)/2 parallel edges plus one perpendicular from the center m to the missing node. Parallel edges can never be adjacent.

I tried to sketch it for K6 with a pentagram a b c d e and a center m

            d
            |
       e---------c
            m

         a-----b
[download]

Of course it's hard to draw a regular pentagram in ASCI graphic, the display will also depend on your browser settings.

But I hope it's obvious that symmetry leads to a solution with 5 colors here, which can be generalized to n even.

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}

If solution is thought of as symmetric matrix with all-unique elements (i.e. "edge labels") per row (and therefore, per column) and crossed-out dummy diagonal, then quite formal algorithm to build it could be as follows. Code is not pretty, at least I hope I streamlined it enough after couple of, even uglier, attempts.

use strict;
use warnings;
use feature 'say';

use constant LETTERS => join '', 'A'..'Z', 'a'..'z';    # template
use constant N => 51;                                   # number of "e
+dges"

die if not N % 2        # (1) prohibit odd nodes number
    or N > 51;          # (2) "template" limitation

say '_' . substr LETTERS, 0, N;
my $last = substr LETTERS, N - 1, 1;    # "collect" last line here

for ( 1 .. N - 1 ) {
    my $s   = substr LETTERS, 0, N;
    my $sfx = substr $s, 0, $_ - 1, '';
    $s  .= $sfx;                        # rotate left       
    $sfx = substr $s, $_, 1, '_';    
    $s  .= $sfx;                        # ...& append replaced diagona
+l item

    say $s;
    $last .= substr $s, -1;
}

say $last . '_';

__END__
[download]

Extended 2:53 2/20/22: now here's formal generation code for both odd/even number of "edges", at expense of introducing additional "edge label" (a star) in latter case:

use strict;
use warnings;
use feature 'say';

use constant LETTERS => join '', 'A'..'Z', 'a'..'z';
use constant N => 12;

say '_' . substr LETTERS, 0, N;
my $last = substr LETTERS, N - 1, 1;

for ( 1 .. N - 1 ) {
    my $s   = substr LETTERS, 0, N;
    my $sfx = substr $s, 0, $_ - 1, '';
    $s  .= '*' unless N % 2;
    $s  .= $sfx;
    $sfx = substr $s, $_, 1, '_';
    $s  .= $sfx if N % 2;

    say $s;
    $last .= substr $s, -1;
}

say $last . '_';

__END__

_ABCDEFGHIJKL
A_CDEFGHIJKL*
BC_EFGHIJKL*A
CDE_GHIJKL*AB
DEFG_IJKL*ABC
EFGHI_KL*ABCD
FGHIJK_*ABCDE
GHIJKL*_BCDEF
HIJKL*AB_DEFG
IJKL*ABCD_FGH
JKL*ABCDEF_HI
KL*ABCDEFGH_J
L*ABCDEFGHIJ_
[download]

For odd N its only possible with N colors (explained here )

A generalized solution for any N in N colors is explained here.

use strict;
use warnings;
use Data::Dump qw/pp dd/;


# https://perlmonks.org/?node_id=11141490

my $n=8;

die "n must not be odd" if $n%2;


my @nodes = 0 .. $n-1;

my $center = shift @nodes;


sub rotate(\@) {
    my $r = shift @{$_[0]};
    push @{$_[0]},$r
}

sub get_edges {
    my @verts = @_;
    my $left  = $#verts/2;
    my @res = map [ $verts[$_-1], $verts[-$_] ], 1..$left;
    return [@res,[$center,$verts[$left]]];
}

sub get_matrix{
    my (@colored) = @_;
    my @inc_matrix;
    while ( my ($color,$color_set) = each @colored ) {
        for my $edge (@$color_set) {
            my ($v0,$v1) = @$edge;
            $inc_matrix[ $v0 ][ $v1 ] = $color;
            $inc_matrix[ $v1 ][ $v0 ] = $color;
        }
    }
    return \@inc_matrix;
}

my @colored;
for(@nodes){
    #pp \@nodes;
    push @colored, get_edges(@nodes);
    rotate(@nodes);
}

pp \@colored;


pp get_matrix(@colored);
[download]

[
  [[1, 7], [2, 6], [3, 5], [0, 4]],
  [[2, 1], [3, 7], [4, 6], [0, 5]],
  [[3, 2], [4, 1], [5, 7], [0, 6]],
  [[4, 3], [5, 2], [6, 1], [0, 7]],
  [[5, 4], [6, 3], [7, 2], [0, 1]],
  [[6, 5], [7, 4], [1, 3], [0, 2]],
  [[7, 6], [1, 5], [2, 4], [0, 3]],
]
[
  [undef, 4, 5, 6, 0 .. 3],
  [4, undef, 1, 5, 2, 6, 3, 0],
  [5, 1, undef, 2, 6, 3, 0, 4],
  [6, 5, 2, undef, 3, 0, 4, 1],
  [0, 2, 6, 3, undef, 4, 1, 5],
  [1, 6, 3, 0, 4, undef, 5, 2],
  [2, 3, 0, 4, 1, 5, undef, 6],
  [3, 0, 4, 1, 5, 2, 6],
]
[download]

And here a generalized minimal and polynomial solution for all N.

( update IOW this can't possibly be improved anymore. It calculated a solution for 1000 nodes in less than a second )

I just realized that a solution for even N can be constructed from previous odd N-1 (you just connect the uncolored "gap" node with the new node, see output).

This means get_edges could be further simplified...

use v5.12;
use warnings;
use Data::Dump qw/pp dd/;


# https://perlmonks.org/?node_id=11141490

calc($_) for 5..10;

exit;


sub rotate(\@) {
    my $r = shift @{$_[0]};
    push @{$_[0]},$r
}

sub get_edges {
    my @verts  = @{+shift};
    my $center = shift;

    my $left  = $#verts/2;
    my @res = map [ $verts[$_-1], $verts[-$_] ], 1..$left;
    push @res,[$center,$verts[$left]]
      if defined $center;
    return \@res;
}

sub get_matrix{
    my (@colored) = @_;
    my @inc_matrix;
    while ( my ($color,$color_set) = each @colored ) {
        for my $edge (@$color_set) {
            my ($v0,$v1) = @$edge;
            $inc_matrix[ $v0 ][ $v1 ] = $color;
            $inc_matrix[ $v1 ][ $v0 ] = $color;
        }
    }
    return \@inc_matrix;
}

sub calc {
    my ( $n ) = @_ ;
    my @nodes = 0 .. $n-1;

    my $center = $n%2
      ? undef
        : pop @nodes;

    my @colored;
    for (@nodes) {
        push @colored, get_edges(\@nodes, $center);
        rotate(@nodes);
    }

    say "\n";
    print "="x10;
    say " N=$n";
    say "=== Colors: ", scalar @colored;
    say "=== Edges: ";
    say pp \@colored;
    say "=== Color Matrix:";
    say pp get_matrix(@colored);
}
[download]

OUTPUT:

========== N=5
=== Colors: 5
=== Edges: 
[
  [[0, 4], [1, 3]],
  [[1, 0], [2, 4]],
  [[2, 1], [3, 0]],
  [[3, 2], [4, 1]],
  [[4, 3], [0, 2]],
]
=== Color Matrix:
[
  [undef, 1, 4, 2, 0],
  [1, undef, 2, 0, 3],
  [4, 2, undef, 3, 1],
  [2, 0, 3, undef, 4],
  [0, 3, 1, 4],
]


========== N=6
=== Colors: 5
=== Edges: 
[
  [[0, 4], [1, 3], [5, 2]],
  [[1, 0], [2, 4], [5, 3]],
  [[2, 1], [3, 0], [5, 4]],
  [[3, 2], [4, 1], [5, 0]],
  [[4, 3], [0, 2], [5, 1]],
]
=== Color Matrix:
[
  [undef, 1, 4, 2, 0, 3],
  [1, undef, 2, 0, 3, 4],
  [4, 2, undef, 3, 1, 0],
  [2, 0, 3, undef, 4, 1],
  [0, 3, 1, 4, undef, 2],
  [3, 4, 0, 1, 2],
]


========== N=7
=== Colors: 7
=== Edges: 
[
  [[0, 6], [1, 5], [2, 4]],
  [[1, 0], [2, 6], [3, 5]],
  [[2, 1], [3, 0], [4, 6]],
  [[3, 2], [4, 1], [5, 0]],
  [[4, 3], [5, 2], [6, 1]],
  [[5, 4], [6, 3], [0, 2]],
  [[6, 5], [0, 4], [1, 3]],
]
=== Color Matrix:
[
  [undef, 1, 5, 2, 6, 3, 0],
  [1, undef, 2, 6, 3, 0, 4],
  [5, 2, undef, 3, 0, 4, 1],
  [2, 6, 3, undef, 4, 1, 5],
  [6, 3, 0, 4, undef, 5, 2],
  [3, 0, 4, 1, 5, undef, 6],
  [0, 4, 1, 5, 2, 6],
]


========== N=8
=== Colors: 7
=== Edges: 
[
  [[0, 6], [1, 5], [2, 4], [7, 3]],
  [[1, 0], [2, 6], [3, 5], [7, 4]],
  [[2, 1], [3, 0], [4, 6], [7, 5]],
  [[3, 2], [4, 1], [5, 0], [7, 6]],
  [[4, 3], [5, 2], [6, 1], [7, 0]],
  [[5, 4], [6, 3], [0, 2], [7, 1]],
  [[6, 5], [0, 4], [1, 3], [7, 2]],
]
=== Color Matrix:
[
  [undef, 1, 5, 2, 6, 3, 0, 4],
  [1, undef, 2, 6, 3, 0, 4, 5],
  [5, 2, undef, 3, 0, 4, 1, 6],
  [2, 6, 3, undef, 4, 1, 5, 0],
  [6, 3, 0, 4, undef, 5, 2, 1],
  [3, 0, 4, 1, 5, undef, 6, 2],
  [0, 4, 1, 5, 2, 6, undef, 3],
  [4, 5, 6, 0 .. 3],
]


========== N=9
=== Colors: 9
=== Edges: 
[
  [[0, 8], [1, 7], [2, 6], [3, 5]],
  [[1, 0], [2, 8], [3, 7], [4, 6]],
  [[2, 1], [3, 0], [4, 8], [5, 7]],
  [[3, 2], [4, 1], [5, 0], [6, 8]],
  [[4, 3], [5, 2], [6, 1], [7, 0]],
  [[5, 4], [6, 3], [7, 2], [8, 1]],
  [[6, 5], [7, 4], [8, 3], [0, 2]],
  [[7, 6], [8, 5], [0, 4], [1, 3]],
  [[8, 7], [0, 6], [1, 5], [2, 4]],
]
=== Color Matrix:
[
  [undef, 1, 6, 2, 7, 3, 8, 4, 0],
  [1, undef, 2, 7, 3, 8, 4, 0, 5],
  [6, 2, undef, 3, 8, 4, 0, 5, 1],
  [2, 7, 3, undef, 4, 0, 5, 1, 6],
  [7, 3, 8, 4, undef, 5, 1, 6, 2],
  [3, 8, 4, 0, 5, undef, 6, 2, 7],
  [8, 4, 0, 5, 1, 6, undef, 7, 3],
  [4, 0, 5, 1, 6, 2, 7, undef, 8],
  [0, 5, 1, 6, 2, 7, 3, 8],
]


========== N=10
=== Colors: 9
=== Edges: 
[
  [[0, 8], [1, 7], [2, 6], [3, 5], [9, 4]],
  [[1, 0], [2, 8], [3, 7], [4, 6], [9, 5]],
  [[2, 1], [3, 0], [4, 8], [5, 7], [9, 6]],
  [[3, 2], [4, 1], [5, 0], [6, 8], [9, 7]],
  [[4, 3], [5, 2], [6, 1], [7, 0], [9, 8]],
  [[5, 4], [6, 3], [7, 2], [8, 1], [9, 0]],
  [[6, 5], [7, 4], [8, 3], [0, 2], [9, 1]],
  [[7, 6], [8, 5], [0, 4], [1, 3], [9, 2]],
  [[8, 7], [0, 6], [1, 5], [2, 4], [9, 3]],
]
=== Color Matrix:
[
  [undef, 1, 6, 2, 7, 3, 8, 4, 0, 5],
  [1, undef, 2, 7, 3, 8, 4, 0, 5, 6],
  [6, 2, undef, 3, 8, 4, 0, 5, 1, 7],
  [2, 7, 3, undef, 4, 0, 5, 1, 6, 8],
  [7, 3, 8, 4, undef, 5, 1, 6, 2, 0],
  [3, 8, 4, 0, 5, undef, 6, 2, 7, 1],
  [8, 4, 0, 5, 1, 6, undef, 7, 3, 2],
  [4, 0, 5, 1, 6, 2, 7, undef, 8, 3],
  [0, 5, 1, 6, 2, 7, 3, 8, undef, 4],
  [5 .. 8, 0 .. 4],
]
[download]

Cheers Rolf
_{(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery}