Magic squares for J 
Author Message
 Magic squares for J

   Here is a C magic squares program for J. Anyone already using
   an enhanced version of J can install it as the necessary
   functions are attached. Here is a sample go :

   9!:3(5)
   m=.77!:2
   s =. m 5
   s
17 23  4 10 11
24  5  6 12 18
 1  7 13 19 25
 8 14 20 21  2
15 16 22  3  9
   +/"1 s
65 65 65 65 65
   +/"_1 s
65 65 65 65 65
   m 10
92 98  4 85 86 17 23 79 10  11
99 80 81 87 93 24  5  6 12  18
 1  7 88 19 25 76 82 13 94 100
 8 14 20 21  2 83 89 95 96  77
15 16 22  3  9 90 91 97 78  84
67 73 54 60 61 42 48 29 35  36
74 55 56 62 68 49 30 31 37  43
51 57 63 69 75 26 32 38 44  50
58 64 70 71 52 33 39 45 46  27
40 41 47 28 34 65 66 72 53  59

   t 'm 100'
1.24 120412

=====cut here======  
/*     ALGORITHMS FOR MAGIC SQUARES TAKEN FROM */
/*        MATHEMATICAL RECREATIONS AND ESSAYS, 12TH ED., */
/*        BY W. W. ROUSE BALL AND H. S. M. COXETER */

    /* Parameter adjustments */
    a_dim1 = *lda;
    a_offset = a_dim1 + 1;
    a -= a_offset;

    /* Function Body */
    if (*n % 4 == 0) {
        goto L100;
    }
    if (*n % 2 == 0) {
        m = *n / 2;
    }
    if (*n % 2 != 0) {
        m = *n;
    }

/*     ODD ORDER OR UPPER CORNER OF EVEN ORDER */

    i__1 = m;
    for (j = 1; j <= i__1; ++j) {
        i__2 = m;
        for (i = 1; i <= i__2; ++i) {
            a[i + j * a_dim1] = 0.;
/* L10: */
        }
/* L20: */
    }
    i = 1;
    j = (m + 1) / 2;
    mm = m * m;
    i__1 = mm;
    for (k = 1; k <= i__1; ++k) {
        a[i + j * a_dim1] = (doublereal) k;
        i1 = i - 1;
        j1 = j + 1;
        if (i1 < 1) {
            i1 = m;
        }
        if (j1 > m) {
            j1 = 1;
        }
        if ((integer) a[i1 + j1 * a_dim1] == 0) {
            goto L30;
        }
        i1 = i + 1;
        j1 = j;
L30:
        i = i1;
        j = j1;
/* L40: */
    }
    if (*n % 2 != 0) {
        return 0;
    }

/*     REST OF EVEN ORDER */

    t = (doublereal) (m * m);
    i__1 = m;
    for (i = 1; i <= i__1; ++i) {
        i__2 = m;
        for (j = 1; j <= i__2; ++j) {
            im = i + m;
            jm = j + m;
            a[i + jm * a_dim1] = a[i + j * a_dim1] + t * 2;
            a[im + j * a_dim1] = a[i + j * a_dim1] + t * 3;
            a[im + jm * a_dim1] = a[i + j * a_dim1] + t;
/* L50: */
        }
/* L60: */
    }
    m1 = (m - 1) / 2;
    if (m1 == 0) {
        return 0;
    }
    i__1 = m1;
    for (j = 1; j <= i__1; ++j) {
        rswap_(&m, &a[j * a_dim1 + 1], &c__1, &a[m + 1 + j * a_dim1], &c__1);
/* L70: */
    }
    m1 = (m + 1) / 2;
    m2 = m1 + m;
    rswap_(&c__1, &a[m1 + a_dim1], &c__1, &a[m2 + a_dim1], &c__1);
    rswap_(&c__1, &a[m1 + m1 * a_dim1], &c__1, &a[m2 + m1 * a_dim1], &c__1);
    m1 = *n + 1 - (m - 3) / 2;
    if (m1 > *n) {
        return 0;
    }
    i__1 = *n;
    for (j = m1; j <= i__1; ++j) {
        rswap_(&m, &a[j * a_dim1 + 1], &c__1, &a[m + 1 + j * a_dim1], &c__1);
/* L80: */
    }
    return 0;

/*     DOUBLE EVEN ORDER */

L100:
    k = 1;
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
        i__2 = *n;
        for (j = 1; j <= i__2; ++j) {
            a[i + j * a_dim1] = (doublereal) k;
            if (i % 4 / 2 == j % 4 / 2) {
                a[i + j * a_dim1] = (doublereal) (*n * *n + 1 - k);
            }
            ++k;
/* L110: */
        }
/* L120: */
    }
    return 0;

Quote:
} /* magic_ */

/* rswap.f -- translated by f2c (version of 23 April 1993  18:34:30).
   You must link the resulting object file with the libraries:
        -lF77 -lI77 -lm -lc   (in that order)
*/

#include "f2c.h"

/* Subroutine */ int rswap_(n, x, incx, y, incy)
integer *n;
doublereal *x;
integer *incx;
doublereal *y;
integer *incy;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer i;
    static doublereal t;
    static integer ix, iy;

    /* Parameter adjustments */
    --y;
    --x;

    /* Function Body */
    if (*n <= 0) {
        return 0;
    }
    ix = 1;
    iy = 1;
    if (*incx < 0) {
        ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
        iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
        t = x[ix];
        x[ix] = y[iy];
        y[iy] = t;
        ix += *incx;
        iy += *incy;
/* L10: */
    }
    return 0;

Quote:
} /* rswap_ */

F1(mgic){PROLOG; A z; I n;
  F1RANK(0,mgic,0); RZ(w);
  w=pcvt(INT,mag(w));
  ASSERT(AT(w)&INT,EVDOMAIN); n=i0(w);
  GA(z, FL,n*n, 2L, 0L);
  AS(z)[0] = AS(z)[1]=n;
  magic_(AV(z),&n,&n);
  EPILOG(pcvt(INT,z));
Quote:
}



Fri, 09 Feb 1996 10:09:54 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Magic Squares

2. Help Please! Magic Square

3. Magic Squares

4. Magic Squares

5. f77 magic square code

6. Fill a table (like a magic square)

7. Solving Magic Squares

8. Magic Square

9. any1 done a magic square in c++ using class

10. Magic square

11. Heuristic search routine for Magic-N Squares puzzle?

12. JS-EAI with *JS*-callback

 

 
Powered by phpBB® Forum Software