aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

37
Task/Topswops/XPL0/topswops-1.xpl0 Normal file
View file

@ -0,0 +1,37 @@
code ChOut=8, CrLf=9, IntOut=11;
int N, Max, Card1(16), Card2(16);
proc Topswop(D); \Conway's card swopping game
int D; \depth of recursion
int I, J, C, T;
[if D # N then \generate N! permutations of 1..N in Card1
[for I:= 0 to N-1 do
[for J:= 0 to D-1 do \check if object (letter) already used
if Card1(J) = I+1 then J:=100;
if J < 100 then
[Card1(D):= I+1; \card number not used so append it
Topswop(D+1); \recurse next level deeper
];
];
]
else [\determine number of topswops to get card 1 at beginning
for I:= 0 to N-1 do Card2(I):= Card1(I); \make working copy of deck
C:= 0; \initialize swop counter
while Card2(0) # 1 do
[I:= 0; J:= Card2(0)-1;
while I < J do
[T:= Card2(I); Card2(I):= Card2(J); Card2(J):= T;
I:= I+1; J:= J-1;
];
C:= C+1;
];
if C>Max then Max:= C;
];
];
[for N:= 1 to 10 do
[Max:= 0;
Topswop(0);
IntOut(0, N); ChOut(0, ^ ); IntOut(0, Max); CrLf(0);
];
]

36
Task/Topswops/XPL0/topswops-2.xpl0 Normal file
View file

@ -0,0 +1,36 @@
code CrLf=9, IntOut=11, Text=12;
int N, D, Best(16);
proc TrySwaps(A, F, S);
int A, F, S;
int B(16), I, J, K;
[if D > Best(N) then Best(N):= D;
loop [if A(S)=-1 ! A(S)=S then quit;
if D+Best(S) <= Best(N) then return;
if S = 0 then quit;
S:= S-1;
];
D:= D+1;
for I:= 0 to S do B(I):= A(I);
K:= 1;
for I:= 1 to S do
[K:= K<<1;
if B(I)=-1 & (F&K)=0 ! B(I)=I then
[J:= I; B(0):= J;
while J do [J:= J-1; B(I-J):= A(J)];
TrySwaps(B, F!K, S);
];
];
D:= D-1;
];
int I, X(16);
[for I:= 0 to 16-1 do
[X(I):= -1; Best(I):= 0];
X(0):= 0;
for N:= 1 to 13 do
[D:= 0;
TrySwaps(X, 1, N-1);
IntOut(0, N); Text(0, ": "); IntOut(0, Best(N)); CrLf(0);
];
]