Анограммы на слова

[Anton]

Код: Выделить всё

KEY = 1 : MAY = 1 : MEN = 2
clear screen
dim theWord$(30000)
dim ssWord$(30000)
dim codWord(30000,2)

root = 1

print "Loading dictionary file."
open "unixdict.txt" for reading as #1
print "Creating array of words."
while(not eof(1))
	n = n + 1
	line input #1 theWord$(n)
	ssWord$(n) = firma$(theWord$(n))
	insert(n, root)
wend
close #1

print "Checking for deranged anagrams.\n"
printResult(root)
 
end

sub firma$(word$)
	local cont, kk, lword, p$
	
	cont = 1
	lword = len(word$) - 1
	
	while(cont = 1)
		cont  = 0
	  	for kk = 1 to lword
	  		p$ = mid$(word$,kk,1)
		  	if p$ < mid$(word$,kk+1,1) then
		  		mid$(word$,kk,1) = mid$(word$,kk+1,1)
		  		mid$(word$,kk+1,1) = p$
		    	cont  = 1
		  	end if
	  	next kk
	wend
	return str$(lword+1,"%02g")+word$
end sub


sub insert(n, prev)
	if n <> prev  then
		if ssWord$(n) > ssWord$(prev) then
			if codWord(prev,MAY) = 0 then
				codWord(prev,MAY) = n
			else
				insert(n,codWord(prev,MAY))
			end if
		else
			if codWord(prev,MEN) = 0 then
				codWord(prev,MEN) = n
			else
				insert(n,codWord(prev,MEN))
			end if
		end if
	end if
end sub


sub printResult(nodo)
	static antNodo, tester
	local w1$, w2$, wlen, k
	
	if tester return
	
	if codWord(nodo,MAY) printResult(codWord(nodo,MAY))
	if ssWord$(nodo) = ssWord$(antNodo) then
		w1$ = theWord$(nodo) : w2$ = theWord$(antNodo) : wlen = len(w1$)
		tester = true
		for k = 1 to wlen
			if mid$(w1$,k,1) = mid$(w2$,k,1) then
				tester = false
				break
			end if
    	next k
    	if tester then
			print "Largest deranged anagram (length: ",wlen,")"
			print w1$," -> ",w2$
			return
		end if
	end if
	antNodo = nodo
	if codWord(nodo,MEN) printResult(codWord(nodo,MEN))
end sub