RosettaCodeData/Task/Permutations-by-swapping/BASIC256/permutations-by-swapping.basic

39 lines
884 B
Plaintext

call perms(3)
print
call perms(4)
end
subroutine perms(n)
dim p((n+1)*4)
for i = 1 to n
p[i] = -i
next i
s = 1
do
print "Perm: [ ";
for i = 1 to n
print abs(p[i]); " ";
next i
print "] Sign: "; s
k = 0
for i = 2 to n
if p[i] < 0 and (abs(p[i]) > abs(p[i-1])) and (abs(p[i]) > abs(p[k])) then k = i
next i
for i = 1 to n-1
if p[i] > 0 and (abs(p[i]) > abs(p[i+1])) and (abs(p[i]) > abs(p[k])) then k = i
next i
if k then
for i = 1 to n #reverse elements > k
if abs(p[i]) > abs(p[k]) then p[i] = -p[i]
next i
if p[k] < 0 then i = k-1 else i = k+1
temp = p[k]
p[k] = p[i]
p[i] = temp
s = -s
end if
until k = 0
end subroutine