Sorry your browser is not supported!

t$ = "ABCDE"
dim temporary(fast len(t$)) as string
tPtr = get arrayptr(temporary())

unlink array temporary()

tPtr = DBPString_to_CStyle(t$,tPtr)

dim combos(fast len(t$) ^ 3) as string

link array temporary(),tPtr

count as integer
count = 0

while count < fast len(t$) ^ 3
	a$ = temporary(rnd(4)+1)
	b$ = temporary(rnd(4)+1)
	c$ = temporary(rnd(4)+1)
	s$ = a$ + b$ + c$
	if checkForDuplicates(s$) = 1 and fast len(s$) = 3
		combos(count) = s$
		print s$
		count = count + 1
	endif
endwhile

print "Success"
print array count(combos())

wait key

end

function checkForDuplicates(t as string)
	local unique as integer : unique = 1
	
	for i = 0 to array count(combos())
		if combos(i) = t then unique = 0 : break
	next i
endfunction unique

//DBP string to C-style string conversion (C++ string to character array)
function DBPString_to_CStyle(t as string,ptr as integer)
	local aLen as integer : aLen=get arrayptr count(ptr)
	local sLen as integer : sLen=fast len(t)
	dim tmp(aLen) as string
	link array tmp(),ptr
	for i=0 to sLen
		tmp(i)=mid$(t,i)
	next i
	ptr=get arrayptr(tmp())
	unlink array tmp()
endfunction ptr

a$="ABCDE"
z=len(a$)
g=0
for a=1 to z
   for b=1 to z
      for c=1 to z
         if a <> b and a <> c and b <> c
            w$=mid$(a$,a)+mid$(a$,b)+mid$(a$,c)
            print w$;" ";
            g=g+1
            if g mod 5 = 0
               print
            endif
         endif
      next c
   next b
next a
print
print "Count = ";g
wait key

  n!
______
(n-m)!

for n = 0 to 13
	print n;"! = ";factorial(n)
next n

wait key
end

function factorial(n)
	fn as dword = 1
	for k = 1 to n
		if fn*k < fn then fn=0 : exit //value overflow error.
		fn = fn*k
	next k
endfunction fn

do
	input "Available characters:> ";n
	input "String Length:> ";m
	print "Possible Permutations: ";factorial(n) / factorial(n-m)
	print "PRESS ANY KEY TO LOOP"
	wait key
	cls
loop
end

function factorial(n)
	fn as dword = 1
	for k = 1 to n
		if fn*k < fn then fn=0 : exit //value overflow error.
		fn = fn*k
	next k
endfunction fn

do
	input "Number of available characters:> ";n
	input "String length:> ";m
	print "Possible permutations: ";factorial(n) / factorial(n-m)
	print "PRESS ANY KEY TO LOOP"
	wait key
	cls
loop
end

function factorial(n)
	fn as dword = 1
	for k = 1 to n
		if fn*k < fn then fn=0 : exit //value overflow error.
		fn = fn*k
	next k
endfunction fn

a$ = "ABCDE"
a = 3
global z
z = 0
e(a$,a,"")
print
print "COUNT = ";z
wait key
end

function e(a$,a,w$)
   for c = 1 to len(a$)
      n$ = w$ + mid$(a$,c)
      if len(n$) = a
         print n$;" ";
         z = z + 1
         if z mod 10 = 0
            print
         endif
      else
         f$=""
         for f = 1 to len(a$)
            if f <> c
               f$ = f$ + mid$(a$,f)
            endif
         next f
         e(f$,a,n$)
      endif
   next c
endfunction

global a
global w

a$ = "ABCDEFGHIJKL"
a = 8

perms = factorial(len(a$)) / factorial(len(a$)-a)
dim word$(perms)
w = 0
t1=timer()
e(a$,"")
t2=timer()
if w <= 10
   for f=1 to w
      print f;" = ";word$(f)
   next f
else
   for f=1 to 5
      print f;" = ";word$(f)
   next f
   print "..."
   for f=w-4 to w
      print f;" = ";word$(f)
   next f
endif
print
print "EXPECTED COUNT = ";perms
print "ACTUAL COUNT = ";w
print
print "SECONDS = ";str$((t2-t1)/1000.0,2)
wait key
end

function e(a$,w$)
   for c = 1 to len(a$)
      n$ = w$ + mid$(a$,c)
      if len(n$) = a
         inc w : word$(w) = n$
      else
         e(left$(a$,c-1) + right$(a$,len(a$)-c),n$)
      endif
   next c
endfunction

function factorial(n)
   fn as dword = 1
   for k = 1 to n
      if fn*k < fn then fn=0 : exit
      fn = fn*k
   next k
endfunction fn

sync on : sync rate 0

a$ = "ABCDEFGHIJKL"
a = 8

perms = factorial(len(a$)) / factorial(len(a$)-a)
dim word$(perms)
w = 0
t1=timer()
gosub findperms
t2=timer()
if w <= 10
   for f=1 to w : print f;" = ";word$(f) : next f
else
   for f=1 to 5 : print f;" = ";word$(f) : next f
   print "..."
   for f=w-4 to w : print f;" = ";word$(f) : next f
endif
print
print "EXPECTED COUNT = ";perms
print "ACTUAL COUNT = ";w
print
print "SECONDS = ";str$((t2-t1)/1000.0,2)
sync : sync
wait key
end

findperms:
dim p$(a,2)
dim p(a)
p$(1,1) = a$
p$(1,2) = ""
p(1) = 0
letter = 1
perms:
f$ = p$(letter,1)
f = p(letter)
inc f
if f > len(f$)
   dec letter
   if letter = 0
      return
   endif
   goto perms
endif
w$ = p$(letter,2) + mid$(f$,f)
p(letter) = f
if letter = a
   inc w : word$(w) = w$
else
   inc letter
   p$(letter,1) = left$(f$,f-1) + right$(f$,len(f$)-f)
   p$(letter,2) = w$
   p(letter) = 0
endif
goto perms

function factorial(n)
   fn as dword = 1
   for k = 1 to n
      if fn*k < fn then fn = 0 : exit
      fn = fn*k
   next k
endfunction fn

ABCDE (start)
BACDE (swap 1 and 2)
CABDE (swap 1 and 3)
DABCE (swap 1 and 4)
EABCD (swap 1 and 5)
AEBCD (swap 1 and 2)
BEACD (swap 1 and 3)
CEABD (swap 1 and 4)
DEABC (swap 1 and 5)
EDABC (swap 1 and 2)
ADEBC (swap 1 and 3)
BDEAC (swap 1 and 4)
CDEAB (swap 1 and 5)
DCEAB (swap 1 and 2)
ECDAB (swap 1 and 3)
ACDEB (swap 1 and 4)
BCDEA (swap 1 and 5)
CBDEA (swap 1 and 2)
DBCEA (swap 1 and 3)
EBCDA (swap 1 and 4)
ABCDE (swap 1 and 5)
oh poop! We've repeated the first string already!
Note that no matter what length string you take each line is unique! (until the first string is repeated.)

do
	input "Number of available characters:> ";n
	input "String length:> ";k
	p = factorial(n) / factorial(n-k)
	gosub defineSourceString
	w = permutations(a$,k)
	
	print "Permutations found: "; w
	print "Possible permutations: ";p
	print "PRESS ANY KEY TO LOOP"
	wait key
	cls
loop
end
//

defineSourceString:
	a$=""
	for i = 1 to n
		a$ = a$ + chr$(64+i)
	next i
return
//

function permutations(a$,k)
	n = len(a$)
	w = 0
	n$ = a$

	`Will only find the first n!/(n-2)! permutations.
	repeat
		for x = 2 to n
			inc w
			oldn$ = n$
			if w/k = int(w/k) then print left$(n$,k)
			n$ = mid$(n$,x) + right$(left$(n$,x-1),x-2) + mid$(n$,1) + right$(n$,n-x)
		next x
	until n$ = a$
endfunction w
//

function factorial(n)
	fn = 1
	for k = 1 to n
		if fn*k < fn then fn=0 : exit //integer overflow error (n! =/= 0)
		fn = fn*k
	next k
endfunction fn

do
	input "Number of available characters:> ";n
	gosub defineSourceString
	`input "Desired string length:> ";k
	k=n
	p = factorial(n) / factorial(n-k)
	dim word$(p)
	
	t1=timer()
	w = permutations(a$)
	t2=timer()
	
	if w <= 30
		for f=1 to w : print f;" = ";word$(f) : next f
	else
		for f=1 to 5 : print f;" = ";word$(f) : next f
		print "..."
		for f=w-4 to w : print f;" = ";word$(f) : next f
	endif
	print
	print "Permutations found: ";w
	print "Possible permutations: ";p
	print "Time taken: ";str$((t2-t1)/1000.0,2)
	print "PRESS ANY KEY CHECK FOR DUPLICATES"
	wait key:cls 0
	rem search for duplicates
	dups=0
	for y = 1 to w-1
		for x = y+1 to w
			if word$(x) = word$(y)
				inc dups
				print y;" and ";x;" = ";word$(x)
			endif
		next x
	next y
	if dups=0
		print "NO DUPLICATES FOUND. PRESS ANY KEY TO LOOP."
	else
		print "ERROR: ";dups;" DUPLICATES FOUND!!"
	endif
	wait key:cls
loop
end
//

defineSourceString:
	a$=""
	for i = 1 to n
		a$ = a$ + chr$(64+i)
	next i
return
//

function permutations(a$)
	n = len(a$)
	w = 0
	meta = factorial(n-1)
	
	for m = 1 to meta
		inc w : word$(w)=a$
		rem scroll string through all positions.
		for i = 1 to n-1
			a$ = right$(a$,1) + left$(a$,n-1)
			inc w : word$(w)=a$		
		next i
		
		rem swap two characters over to change string "topology".
		inc mm
		if mm > n-1 then mm=1
		a$ = left$(a$,mm-1) + mid$(a$,mm+1) + mid$(a$,mm) + right$(a$,n-mm-1)
	next m
endfunction w
//

function factorial(n)
	fn = 1
	for k = 1 to n
		if fn*k < fn then fn=0 : exit //integer overflow error (n! =/= 0)
		fn = fn*k
	next k
endfunction fn
//

| <-- divides the held letters to the left from the free letters on the right. Only free letters will be manipulated.
Every single manipulation is a right-to-left rotation of the free string.
The first character of the string is held for len(source)-2 cycles.

Source string: abcde
a|cdeb
a|debc
a|ebcd
ae|cdb
ae|dbc
aed|cb
ae|cbd
ae|bdc
a|bdce
a|dceb
a|cebd
ac|bde
ac|deb
acd|be
ac|bed
ac|edb
a|edbc
a|dbce
a|bced
ab|edc
ab|dce
abd|ec
ab|ecd
ab|cde
bcdea... since this is the same "topology as we started with we can be certain that each leading letter will have a valid pattern,
  all we have to do is avoid storing these 5 strings twice. I'm sure these special rules for the first letter are probably what causes it to not work for 4 length.