135 lines
3.8 KiB
Text
135 lines
3.8 KiB
Text
Structure anagram
|
|
word.s
|
|
letters.s
|
|
EndStructure
|
|
|
|
Structure wordList
|
|
List words.anagram()
|
|
EndStructure
|
|
|
|
#True = 1
|
|
#False = 0
|
|
|
|
Procedure.s sortLetters(*word.Character, wordLength)
|
|
;returns a string with the letters of a word sorted
|
|
Protected Dim letters.c(wordLength)
|
|
Protected *letAdr = @letters()
|
|
CopyMemoryString(*word, @*letAdr)
|
|
SortArray(letters(), #PB_Sort_Ascending, 0, wordLength - 1)
|
|
ProcedureReturn PeekS(@letters(), wordLength)
|
|
EndProcedure
|
|
|
|
;Compare a list of anagrams for derangement.
|
|
Procedure isDeranged(List anagram.s())
|
|
;If a pair of deranged anagrams is found return #True
|
|
;and and modify the list to include the pair of deranged anagrams.
|
|
Protected i, length, word.s, *ptrAnagram, isDeranged
|
|
Protected NewList deranged.s()
|
|
FirstElement(anagram())
|
|
length = Len(anagram())
|
|
Repeat
|
|
word = anagram()
|
|
*ptrAnagram = @anagram()
|
|
|
|
While NextElement(anagram())
|
|
isDeranged = #True
|
|
For i = 1 To length
|
|
If Mid(word, i, 1) = Mid(anagram(), i, 1)
|
|
isDeranged = #False
|
|
Break ;exit for/next
|
|
EndIf
|
|
Next
|
|
|
|
If isDeranged
|
|
AddElement(deranged())
|
|
deranged() = anagram()
|
|
AddElement(deranged())
|
|
deranged() = word
|
|
CopyList(deranged(), anagram())
|
|
ProcedureReturn #True ;deranged anagram found
|
|
EndIf
|
|
Wend
|
|
ChangeCurrentElement(anagram(), *ptrAnagram)
|
|
Until Not NextElement(anagram())
|
|
|
|
ProcedureReturn #False ;deranged anagram not found
|
|
EndProcedure
|
|
|
|
If OpenConsole()
|
|
;word file is assumed to be in the same directory
|
|
If Not ReadFile(0,"unixdict.txt"): End: EndIf
|
|
|
|
Define maxWordSize = 0, word.s, length
|
|
Dim wordlists.wordList(maxWordSize)
|
|
|
|
;Read word file and create separate lists of anagrams and their original
|
|
;words by length.
|
|
While Not Eof(0)
|
|
word = ReadString(0)
|
|
length = Len(word)
|
|
If length > maxWordSize
|
|
maxWordSize = length
|
|
Redim wordlists.wordList(maxWordSize)
|
|
EndIf
|
|
AddElement(wordlists(length)\words())
|
|
wordlists(length)\words()\word = word
|
|
wordlists(length)\words()\letters = sortLetters(@word, length)
|
|
Wend
|
|
CloseFile(0)
|
|
|
|
Define offset = OffsetOf(anagram\letters), option = #PB_Sort_Ascending
|
|
Define sortType = #PB_Sort_String
|
|
Define letters.s, foundDeranged
|
|
NewList anagram.s()
|
|
;start search from largest to smallest
|
|
For length = maxWordSize To 2 Step -1
|
|
|
|
If FirstElement(wordlists(length)\words()) ;only examine lists with words
|
|
;sort words to place anagrams next to each other
|
|
SortStructuredList(wordlists(length)\words(), option, offset, sortType)
|
|
|
|
With wordlists(length)\words()
|
|
letters = \letters
|
|
AddElement(anagram()): anagram() = \word
|
|
|
|
;Compose sets of anagrams and check for derangement with remaining
|
|
;words in current list.
|
|
While NextElement(wordlists(length)\words())
|
|
;Check for end of a set of anagrams?
|
|
If letters <> \letters
|
|
|
|
;if more than one word in a set of anagrams check for derangement
|
|
If ListSize(anagram()) > 1
|
|
If isDeranged(anagram())
|
|
foundDeranged = #True ;found deranged anagrams, stop processing
|
|
Break 2 ;exit while/wend and for/next
|
|
EndIf
|
|
EndIf
|
|
|
|
letters = \letters ;setup for next set of anagrams
|
|
ClearList(anagram())
|
|
EndIf
|
|
|
|
AddElement(anagram()): anagram() = \word
|
|
Wend
|
|
EndWith
|
|
|
|
EndIf
|
|
|
|
ClearList(anagram())
|
|
Next
|
|
|
|
;report results
|
|
If foundDeranged
|
|
Print("Largest 'Deranged' anagrams found are of length ")
|
|
PrintN(Str(length) + ":" + #CRLF$)
|
|
ForEach anagram()
|
|
PrintN(" " + anagram())
|
|
Next
|
|
Else
|
|
PrintN("No 'Deranged' anagrams were found." + #CRLF$)
|
|
EndIf
|
|
|
|
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
|
|
CloseConsole()
|
|
EndIf
|