Ramsey's theorem

From Rosetta Code
Ramsey's theorem is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

The task is to find a graph with 17 Nodes such that any 4 Nodes are neither totally connected nor totally unconnected, so demonstrating Ramsey's theorem.

C

For 17 nodes, (4,4) happens to have a special solution: arrange nodes on a circle, and connect all pairs with distances 1, 2, 4, and 8. It's easier to prove it on paper and just show the result than let a computer find it (you can call it optimization). <lang c>#include <stdio.h>

int main() { int a[17][17] = Template:0; int i, j, k; const char *mark = "01-";

for (i = 0; i < 17; i++) a[i][i] = 2;

for (k = 1; k <= 8; k <<= 1) { for (i = 0; i < 17; i++) { j = (i + k) % 17; a[i][j] = a[j][i] = 1; } }

for (i = 0; i < 17; i++) { for (j = 0; j < 17; j++) printf("%c ", mark[a[i][j]]); putchar('\n'); } return 0; }</lang>

Output:

(17 x 17 connectivity matrix)

- 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 
1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 
1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 
0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 
1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 
0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 
0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 
0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 
1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 
1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 
0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 
0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 
0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 
1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 
0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 
1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 

J

Interpreting this task as "reproduce the output of all the other examples", then here's a stroll to the goal through the J interpreter: <lang j> i.@<.&.(2&^.) N =: 17 NB. Count to N by powers of 2 1 2 4 8

  1 #~ 1 j. 0 _1:} i.@<.&.(2&^.) N =: 17                          NB.  Turn indices into bit mask

1 0 1 0 0 1 0 0 0 0 1

  (, |.) 1 #~ 1 j. 0 _1:} i.@<.&.(2&^.) N =: 17                   NB.  Cat the bitmask with its own reflection

1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1

  _1 |.^:(<N) _ , (, |.) 1 #~ 1 j. 0 _1:} <: i.@<.&.(2&^.) N=:17  NB.  Then rotate N times to produce the array

_ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _

  NB. Packaged up as a re-usable function
  ramsey =: _1&|.^:((<@])`(_ , [: (, |.) 1 #~ 1 j. 0 _1:} [: <: i.@<.&.(2&^.)@])) 

  ramsey 17

_ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 0 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _ 1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 _</lang> Yes, this is really how you solve problems in J.


Mathematica

<lang>CirculantGraph[17, {1, 2, 4, 8}]</lang>


Mathprog

Some lines in this example are too long (more than 80 characters). Please fix the code if it's possible and remove this message.

<lang>/*Ramsey 4 4 17

 This model finds a graph with 17 Nodes such that no clique of 4 Nodes is either fully
 connected, nor fully disconnected

 Nigel_Galloway
 January 18th., 2012
  • /

param Nodes := 17; var Arc{1..Nodes, 1..Nodes}, binary;

clique{a in 1..(Nodes-3), b in (a+1)..(Nodes-2), c in (b+1)..(Nodes-1), d in (c+1)..Nodes} : 1 <= Arc[a,b] + Arc[a,c] + Arc[a,d] + Arc[b,c] + Arc[b,d] + Arc[c,d] <= 5;

end;</lang>

This may be run with: <lang bash>glpsol --minisat --math R_4_4_17.mprog --output R_4_4_17.sol</lang> The solution may be viewed on this page. In the solution file, the first section identifies the number of nodes connected in this clique. In the second part of the solution, the status of each arc in the graph (connected=1, unconnected=0) is shown.

PARI/GP

This takes the C solution to its logical extreme. <lang parigp>matrix(17,17,x,y,my(t=(x-y)%17);t==2^min(valuation(t,2),3))</lang>

Python

Translation of: C

<lang python>def main():

   a = [[0] * 17 for i in range(17)]
   mark = "01-"
   for i in range(17):
       a[i][i] = 2
   k = 1
   while k <=8:
       for i in range(17):
           j = (i + k) % 17
           a[i][j] = a[j][i] = 1
       k <<= 1
   for i in range(17):
       for j in range(17):
           print(mark[a[i][j]], end=' ')
       print()


if __name__ == '__main__':

   main()</lang>
Output same as C:

REXX

Translation of: C

<lang rexx>/*REXX programs finds and displays a 17 node graph such that any four */ /*────── nodes are neither totally connected nor totally unconnected.*/ @.=0 /*initialize the node graph to 0.*/

    do d=0  for 17;  @.d.d=2;  end    /*set the diagonal elements to 2.*/

k=1

    do while k<=8
                   do i=0  for 17     /*process each column in array.  */
                   j= (i+k) // 17     /*set a  row,col  and  col,row.  */
                   @.i.j=1;  @.j.i=1  /*set two array elements to one. */
                   end   /*i*/
    k=k*2                             /*double the value of K each loop*/
    end   /*while k≤8*/
 do r=0  for 17; _=;  do c=0  for 17  /*show each row, build col by col*/
                      _=_ @.r.c       /*add this column to the row.    */
                      end   /*c*/
 say left(,9) translate(_,'-',2)    /*display the constructed row.   */
 end   /*r*/
                                      /*stick a fork in it, we're done.*/</lang>

output

(17x17 connectivity matrix):

           - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1
           1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1
           1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1 0
           0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0 1
           1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0 0
           0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0 0
           0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1 0
           0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1 1
           1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0 1
           1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0 0
           0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0 0
           0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1 0
           0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0 1
           1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1 0
           0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1 1
           1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 - 1
           1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 -

Run BASIC

<lang runbasic>dim a(17,17) for i = 1 to 17: a(i,i) = -1: next i k = 1 while k <= 8

 for i = 1 to 17
   j = (i + k) mod 17
   a(i,j) = 1
   a(j,i) = 1
 next i
 k = k * 2

wend for i = 1 to 17

 for j = 1 to 17
   print a(i,j);" ";
 next j
 print

next i</lang>

-1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 
1 -1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 
1 1 -1 1 1 0 1 0 0 0 1 1 0 0 0 1 0 
0 1 1 -1 1 1 0 1 0 0 0 1 1 0 0 0 1 
1 0 1 1 -1 1 1 0 1 0 0 0 1 1 0 0 0 
0 1 0 1 1 -1 1 1 0 1 0 0 0 1 1 0 0 
0 0 1 0 1 1 -1 1 1 0 1 0 0 0 1 1 0 
0 0 0 1 0 1 1 -1 1 1 0 1 0 0 0 1 1 
1 0 0 0 1 0 1 1 -1 1 1 0 1 0 0 0 0 
1 1 0 0 0 1 0 1 1 -1 1 1 0 1 0 0 0 
0 1 1 0 0 0 1 0 1 1 -1 1 1 0 1 0 0 
0 0 1 1 0 0 0 1 0 1 1 -1 1 1 0 1 0 
0 0 0 1 1 0 0 0 1 0 1 1 -1 1 1 0 0 
1 0 0 0 1 1 0 0 0 1 0 1 1 -1 1 1 0 
0 1 0 0 0 1 1 0 0 0 1 0 1 1 -1 1 0 
1 0 1 0 0 0 1 1 0 0 0 1 0 1 1 -1 0 
1 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 -1