home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Interactive Guide / c-cplusplus-interactive-guide.iso / c_ref / csource4 / 275_01 / lcau22.c < prev    next >
Text File  |  1980-01-01  |  20KB  |  675 lines
  1.  
  2. /* lcau22.c                */
  3. /* (2,2) Linear Cellular Automaton    */
  4.  
  5. /* Reference:                */
  6. /*                    */
  7. /*    Kenneth E. Perry            */
  8. /*    Abstract Mathematical Art        */
  9. /*    BYTE                */
  10. /*    December, 1986            */
  11. /*    pages 181-192            */
  12.  
  13. /*    Copyright (C) 1987        */
  14. /*    Copyright (C) 1988        */
  15. /*    Harold V. McIntosh        */
  16. /*    Gerardo Cisneros S.        */
  17.  
  18. /* G. Cisneros, 4.3.87                        */
  19. /* 10 April 1987 - modified for (4,2) [HVM]            */
  20. /* 26 April 1987 - Multiple menus [HVM]                */
  21. /* 28 April 1987 - back modified to (4,1) [HVM]            */
  22. /* 28 April 1987 - version for XVI Feria de Puebla [HVM]    */
  23. /* 14 May 1987 - modified for (3,1) and general rule [HVM]    */
  24. /* 19 May 1987 - modified for (2,2) [HVM]            */
  25. /* 20 May 1987 - modified for (2,3) [HVM]            */
  26. /* 21 May 1987 - Wolfram rule number [HVM]            */
  27. /* 8 June 1987 - general rule for (4,1) [HVM]             */
  28. /* 12 June 1987 - cartesian product of (2,1) rules [HVM]    */
  29. /* 12 June 1987 - (2,1) rule with memory  [HVM]            */
  30. /* 14 June 1987 - individual cycles of evolution [HVM]        */
  31. /* 17 June 1987 - p-adic representation in plane [HVM]        */
  32. /* 22 June 1987 - 2 speed gliders via 16 transitions [HVM]    */
  33. /* 26 June 1987 - push, pop the rule [HVM]            */
  34. /* 26 June 1987 - conserve position of rule cursor [HVM]    */
  35. /* 27 June 1987 - incremental rule construction [HVM]        */
  36. /* 29 June 1987 - conserve position of cell pointer [HVM]    */
  37. /* 30 June 1987 - mark & unmark transitions, xchg x&X [HVM]    */
  38. /* 25 July 1987 - display and edit de Bruijn diagrams [HVM]    */
  39. /* 27 July 1987 - graph of transition probabilities [HVM]    */
  40. /* 4 September 1987 - PROB21.C for option 't' [HVM]        */
  41. /* 21 October 1987 - program disks disappeared            */
  42. /* 20 December 1987 - program reconstructed from listings    */
  43. /* 20 February 1988 - RIJN21.C for option 'd' [HVM]        */
  44.  
  45. # include <bdos.h>
  46.  
  47. # define COLGRAF        4  /* graph resolution            */
  48. # define T80X25            3  /* text resolution            */
  49. # define WHCYMAG        1  /* color quad for normal screen    */
  50. # define YELREGR        2  /* alternative color palette     */
  51. # define CR                5  /* cursor reference - row editor    */
  52. # define CM                7  /* cursor reference - main menu    */
  53. # define CL               11  /* cursor reference - line editor    */
  54. # define AL                320  /* array length (screen width)    */
  55. # define SL               40  /* short array length        */
  56. # define KK                 2  /* number of states per cell        */
  57. # define DS        KK*KK*KK*KK*KK  /* number of distinct neighborhoods    */
  58. # define TS           5*(KK-1)+1  /* distinct sums w/totalistic rule    */
  59. # define BD               25  /* max number Bernstein coeffs    */ 
  60. # define NX                  7  /* number of sample rules        */
  61.  
  62. char xrule[NX][KK][KK][KK][KK][KK];
  63.  
  64. char ixrule[NX][DS]=
  65.  
  66.     "00010110011010010110100110010111",    /* totalistic rule #52    */
  67.     "00010110011010010110100110010110",    /* totalistic rule #20    */
  68.     "00010011101010011100110001100011",    /* mottled                 */
  69.     "00101110000110101011001111000100",    /*                      */
  70.     "01101000001100110011001100110011",    /*                */
  71.     "10010000101100110000000101111100",    /*                 */
  72.     "11111101001100110011001100110011"    /*                         */
  73.  
  74.     ;
  75.  
  76. char   ascrule[KK][KK][KK][KK][KK];
  77. char   trule[TS]="000000";
  78. int    binrule[KK][KK][KK][KK][KK];
  79. int    arr1[AL], arr2[AL];
  80. int    ix0, iy0;                    /* origin for pen moves */
  81. double bp[BD];
  82.  
  83. main()
  84. {
  85. int  i, j, i0, i1, i2, i3, i4;
  86. int  more = 'r';
  87. char a, b, c;
  88.  
  89. for (i=0; i<NX; i++) {                    /* copy to 3-index array */
  90. i0=0; i1=0; i2=0; i3=0; i4=0;
  91. for (j=0; j<DS; j++) {
  92.   xrule[i][i0][i1][i2][i3][i4]=ixrule[i][j];
  93.   i4++;
  94.   if (i4>KK-1) {i4=0; i3++;};
  95.   if (i3>KK-1) {i3=0; i2++;};
  96.   if (i2>KK-1) {i2=0; i1++;};
  97.   if (i1>KK-1) {i1=0; i0++;};
  98.   if (i0>KK-1) {i0=0; };
  99. };};
  100.  
  101.  
  102.     videopalette(WHCYMAG);                /* white/cyan/magenta */
  103.  
  104.     tuto();
  105.     while (!kbdst()) rand();                /* wait for keypress */
  106.     kbdin();                        /* ignore it */
  107.     videomode(T80X25);
  108.     videoscroll(0,0,CR,71,0,3);                /* menu on blue background */
  109.     videoscroll(CL+8,0,24,71,0,3);
  110.     xtoasc(rand()%NX);
  111.     ranlin();                        /* random initial array */
  112.  
  113.     while (more!='n') {                    /* execute multiple runs */
  114.     rmenu();
  115.     lmenu();
  116.     while (0<1) {                    /* set up one run */
  117.     c=kbdin();
  118.     if (c=='g') break;                    /* go draw graph */
  119.     if (c=='q') more='n';                /* quit for good */
  120.     if (more=='n') break;
  121.     switch (c) {
  122.     case '@':                    /* numbered tot rule */
  123.         nutoto(numin(0));
  124.         totoasc();
  125.         rmenu();
  126.         videocursor(0,CM,0);
  127.         break;
  128.     case '$':                    /* dozen totalistics */
  129.         j=numin(0);
  130.         for (i=0; i<12; i++) {
  131.           nutoto(j+i);
  132.           totoasc();
  133.           ranlin();
  134.           evolve();
  135.           };
  136.             videomode(T80X25);
  137.         rmenu();
  138.         lmenu();
  139.         break;
  140.     case 'T':                    /* totalistic rule */
  141.         xblnk();
  142.         tmenu();
  143.         edtrule();
  144.         totoasc();
  145.         for (i0=0; i0<KK; i0++) {
  146.         for (i1=0; i1<KK; i1++) {
  147.         for (i2=0; i2<KK; i2++) {
  148.         for (i3=0; i3<KK; i3++) {
  149.         for (i4=0; i4<KK; i4++) {
  150.         ascrule[i0][i1][i2][i3][i4]=trule[i0+i1+i2+i3+i4];
  151.         };};};};};
  152.         videocursor(0,CM,0);
  153.         rmenu();
  154.         break;
  155.     case 't':                    /* probability calculation */
  156.         edtri();
  157.         rmenu();
  158.         lmenu();
  159.         break;
  160.         case 'r':                    /* edit rule */    
  161.         xblnk();
  162.         edrule();
  163.         videocursor(0,CM,0);
  164.         rmenu();
  165.         break;
  166.         case 'l':                    /* edit cell string */
  167.         xblnk();
  168.         edline();
  169.         videocursor(0,CM,0);
  170.         lmenu();
  171.         break;
  172.         case '#':                    /* read stored rule */
  173.         xmenu(NX);
  174.         xtoasc(lim(1,numin(0),NX)-1);
  175.         rmenu();
  176.             break;
  177.     case 'D':                    /* run through samples */
  178.         for (i=0; i<NX; i++) {
  179.           xmenu(i);
  180.           xtoasc(i);
  181.           ranlin();
  182.           evolve();
  183.           };
  184.         videomode(T80X25);
  185.         rmenu();
  186.         break;
  187.     case 'd':                    /* de Bruijn diagram */
  188.         edijn();
  189.         rmenu();
  190.         lmenu();
  191.         break;
  192.         case 'u':                    /* sparse init arry */
  193.         xblnk();
  194.         for (i=0; i<AL; i++) arr1[i]=0;
  195.         arr1[AL/4]=1;
  196.             arr1[AL/2]=1;
  197.             arr1[(3*AL)/4]=1;
  198.             arr1[(3*AL)/4+2]=1;
  199.         lmenu();
  200.             break;
  201.     case 'w':                    /* Wolfram rulw # */
  202.         i=numin(0);
  203.         wmenu(i);
  204.         for (i0=0; i0<KK; i0++) {
  205.         for (i1=0; i1<KK; i1++) {
  206.         for (i2=0; i2<KK; i2++) {
  207.         for (i3=0; i3<KK; i3++) {
  208.         for (i4=0; i4<KK; i4++) {
  209.           ascrule[i0][i1][i2][i3][i4]='0'+i%KK;
  210.           i/=KK;
  211.         };};};};};
  212.         rmenu();
  213.         break;
  214.     case 'x':                    /* random rule */
  215.         xblnk();
  216.         for (i0=0; i0<KK; i0++) {
  217.         for (i1=0; i1<KK; i1++) {
  218.         for (i2=0; i2<KK; i2++) {
  219.         for (i3=0; i3<KK; i3++) {
  220.         for (i4=0; i4<KK; i4++) {
  221.           if ((KK*(KK*i0+i1)+i2)%4 == 0) i=rand();
  222.           ascrule[i0][i1][i2][i3][i4]='0'+i%KK;
  223.           i/=KK;
  224.         };};};};};
  225.         rmenu();
  226.         break;
  227.     case 'y':                    /* random line */
  228.         xblnk();
  229.         ranlin();
  230.             lmenu();
  231.         break;
  232.     case 'Y':                    /* symmetrize rule */
  233.         for (i0=0; i0<KK; i0++) {
  234.         for (i1=0; i1<KK; i1++) {
  235.         for (i2=0; i2<KK; i2++) {
  236.         for (i3=0; i3<KK; i3++) {
  237.         for (i4=0; i4<KK; i4++) {
  238.         ascrule[i4][i3][i2][i1][i0]=ascrule[i0][i1][i2][i3][i4];      
  239.         };};};};};
  240.         break;
  241.     case 'B':                    /* begin barrier */
  242.         a=kbdin();
  243.         b=kbdin();
  244.         ascrule[0][a-'0'][b-'0'][a-'0'][a-'0']=a;
  245.         ascrule[1][a-'0'][b-'0'][a-'0'][a-'0']=a;
  246.         ascrule[2][a-'0'][b-'0'][a-'0'][a-'0']=a;
  247.         rmenu();
  248.         break;
  249.     case 'E':                    /* end barrier */
  250.         a=kbdin();
  251.         b=kbdin();
  252.         ascrule[a-'0'][a-'0'][a-'0'][b-'0'][0]=b;
  253.         ascrule[a-'0'][a-'0'][a-'0'][b-'0'][1]=b;
  254.         ascrule[a-'0'][a-'0'][a-'0'][b-'0'][2]=b;
  255.         rmenu();
  256.         break;
  257.     case 'L':                    /* left glider link */
  258.         a=kbdin();
  259.         b=kbdin();
  260.         c=kbdin();
  261.         ascrule[a-'0'][a-'0'][a-'0'][b-'0'][c-'0']=c;
  262.         rmenu();
  263.         break;
  264.     case 'R':                    /* left glider link */
  265.         a=kbdin();
  266.         b=kbdin();
  267.         c=kbdin();
  268.         ascrule[a-'0'][a-'0'][a-'0'][b-'0'][c-'0']=a;
  269.         rmenu();
  270.         break;
  271.     case 'S':                    /* still life link */
  272.         a=