Matrix Rotation of elements - Algorithms

[Ángel Martin]

I actually use a scratch matrix and copy elements one at a time from the source to the scratch, and when done do the bulk renaming source = scratch.

Here's the routine. you need to be familiar with the SandMatrix functions (an extension of the Advantage, itself an extension of the CCD ARRAY group...). The element copying happens in LBL 05 towards the end of the program.

PHP Code:

1    LBL "M<)R"    
2    "|-,#"    
3    MAT=    
4    DIM?    
5    2    
6     /         m/2
7    INT        int(m/2)
8    E    
9    -          int(m/2) - 1
10   I<>J    
11   STO 00     0,00(int(m/2))
12   LBL 00    
13   DIM?       m,00n
14   FRC        0,00n
15   RCL 00     k,00l
16   INT        k
17   E    
18   +          1+k
19   STO 02    
20   I<>J       0,00(1+k)
21   -          0,00(n-k-1)
22   RCL 02     k+1
23   +    
24   STO 01     (k+1),00(n-k-1)
24   LBL 01
25   E    
26   XEQ 05     shift row
27   ISG 01    
28   GTO 01     do next row
29   DIM?       m,00n
30   INT        m
31   RCL 01     k+1
32   -          m-k-1
33   I<>J       0,00(m-k-1)
34   RCL 02     1+k
35   =    
36   STO 01     (k+1),00(m-k-1)
37   DIM?       m,00n
38   RCL 00    
39   I<>J       x,00k
40   -          m,00(n-k)
41   FRC        0,00(n-k)
42   STO  02    0,00(n-k)
43   LBL  02    
44   E          increase row
45   XEQ 06     shift column
46   ISG  01    NEXT j
47   GTO  02    do next column
48   DIM?       m,00n
49   FRC        0,00n
50   I<>J       n 
51   RCL  00    
52   INT        k
53   -          (n-k)
54   E      
55   LASTX      k
56   +          2+k-1
57   I<>J       0,00(2-k-1)
58   STO 03     0,00(2-k-1)
59   +          (n-k),00(2-k-1)
60   STO  01    (n-k),00(2-k-1)
61   DIM?       m,00n
62   RCL  00    k,00l
63   -          (m-k),00(n-l)
64   INT        m-k
65   STO  02    (m-k)
66   LBL  03    
67   -1         decrease colum
68   XEQ  05    shift row
69   DSE  01    NEXT i
70   GTO  03    do next row
71   DIM?       m,00n
72   RCL  00    k,00l
73   -          (m-k),00(n-l)
74   INT        m-k
75   RCL 03     0,00(2-k-1)
76   +    
77   STO  01    (m-k),00(2+k-1)
78   RCL  00    
79   INT        k
80   E      
81   +          k+1
82   I<>J       0,00(1+k)
83   STO  02    0,00(1+k)
84   LBL  04    
85   -1    
86   XEQ  06    shift column
87   DSE  01    NEXT j
88   GTO  04    do next column
89   ISG  00    NEXT k
90   GTO  00    do next layer!
91   ASWAP    
92   MAT=       Make Matrix Equal 
93   PURFL    
94   MNAME?     restore Matrix Name
95   RTN    
96   LBL  05    
97   I<>J       0,001
98   RCL  01    
99   INT    
100  I<>J        i or j
101  GTO  07     0,00(1+k)
102  LBL  06    
103  RCL  01    
104  INT    
105  LBL  07    
106  RCL  02    
107  +    
108  +    
109  LASTX    
110  MSIJA      Sets Pointer
111  MR         Recall Element
112  RCL  Z (1)    
113  ASWAP    
114  MSIJA      Sets Pointer
115  X<>Y       Store by Row
116  MS    
117  ASWAP    
118  END