Anonymous user
Random Latin squares: Difference between revisions
Added solution for Action!
m (→{{header|Haskell}}: Added missing imports, tidied, applied Ormolu) |
(Added solution for Action!) |
||
Line 93:
1 0 4 3 2
0 3 1 2 4
</pre>
=={{header|Action!}}==
<lang Action!>DEFINE PTR="CARD"
DEFINE DIMENSION="5"
TYPE Matrix=[
PTR data ;BYTE ARRAY
BYTE dim]
PTR FUNC GetPtr(Matrix POINTER mat BYTE x,y)
RETURN (mat.data+x+y*mat.dim)
PROC PrintMatrix(Matrix POINTER mat)
BYTE x,y
BYTE POINTER d
d=GetPtr(mat,0,0)
FOR y=0 TO mat.dim-1
DO
FOR x=0 TO mat.dim-1
DO
PrintB(d^) Put(32)
d==+1
OD
PutE()
OD
RETURN
PROC KnuthShuffle(BYTE ARRAY tab BYTE size)
BYTE i,j,tmp
i=size-1
WHILE i>0
DO
j=Rand(i+1)
tmp=tab(i)
tab(i)=tab(j)
tab(j)=tmp
i==-1
OD
RETURN
PROC LatinSquare(Matrix POINTER mat)
BYTE x,y,yy,shuffled
BYTE POINTER ptr1,ptr2
BYTE ARRAY used(DIMENSION)
ptr1=GetPtr(mat,0,0)
FOR y=0 TO mat.dim-1
DO
FOR x=0 TO mat.dim-1
DO
ptr1^=x
ptr1==+1
OD
OD
;first row
ptr1=GetPtr(mat,0,0)
KnuthShuffle(ptr1,mat.dim)
;middle rows
FOR y=1 TO mat.dim-2
DO
shuffled=0
WHILE shuffled=0
DO
ptr1=GetPtr(mat,0,y)
KnuthShuffle(ptr1,mat.dim)
shuffled=1
yy=0
WHILE shuffled=1 AND yy<y
DO
x=0
WHILE shuffled=1 AND x<mat.dim
DO
ptr1=GetPtr(mat,x,yy)
ptr2=GetPtr(mat,x,y)
IF ptr1^=ptr2^ THEN
shuffled=0
FI
x==+1
OD
yy==+1
OD
OD
OD
;last row
FOR x=0 TO mat.dim-1
DO
Zero(used,mat.dim)
FOR y=0 TO mat.dim-2
DO
ptr1=GetPtr(mat,x,y)
yy=ptr1^ used(yy)=1
OD
FOR y=0 TO mat.dim-1
DO
IF used(y)=0 THEN
ptr1=GetPtr(mat,x,mat.dim-1)
ptr1^=y
EXIT
FI
OD
OD
RETURN
PROC Main()
BYTE ARRAY d(25)
BYTE i
Matrix mat
mat.data=d
mat.dim=DIMENSION
FOR i=1 TO 2
DO
LatinSquare(mat)
PrintMatrix(mat)
PutE()
OD
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Random_Latin_squares.png Screenshot from Atari 8-bit computer]
<pre>
3 1 2 4 0
1 4 0 2 3
4 0 3 1 2
2 3 1 0 4
0 2 4 3 1
2 1 3 4 0
3 0 4 2 1
4 3 1 0 2
1 2 0 3 4
0 4 2 1 3
</pre>
| |||