Anonymous user
Best shuffle: Difference between revisions
→{{header|Prolog}}: Added PureBasic
(→{{header|Prolog}}: Added PureBasic) |
|||
Line 672:
true .
</pre>
=={{header|PureBasic}}==
This solution creates cycles of letters of letters that are then rotated to produce the final maximal shuffle. It includes an extra sort step that ensures the original string to be returned if it is repeatedly shuffled.
<lang PureBasic>Structure charInfo
Char.s
List Position.i()
count.i ;number of occurrences of Char
EndStructure
Structure cycleInfo
Char.s
Position.i
EndStructure
Structure cycle
List cycle.cycleInfo()
EndStructure
Procedure.s shuffleWordLetters(word.s)
Protected i
Dim originalLetters.s(len(word) - 1)
For i = 1 To Len(word)
originalLetters(i - 1) = Mid(word, i, 1)
Next
Dim shuffledLetters.s(0)
CopyArray(originalLetters(), shuffledLetters())
;record original letters and their positions
Protected curChar.s
NewList letters.charInfo()
NewMap *wordInfo.charInfo()
For i = 0 To ArraySize(originalLetters())
curChar = originalLetters(i)
If FindMapElement(*wordInfo(), curChar)
AddElement(*wordInfo()\position())
*wordInfo()\position() = i
Else
*wordInfo(curChar) = AddElement(letters())
If *wordInfo()
*wordInfo()\Char = curChar
AddElement(*wordInfo()\position())
*wordInfo()\position() = i
EndIf
EndIf
Next
ForEach letters()
letters()\count = ListSize(letters()\Position())
Next
SortStructuredList(letters(), #PB_Sort_Ascending, OffsetOf(charInfo\Char), #PB_Sort_String) ;extra sort step, not strictly necessary
SortStructuredList(letters(), #PB_Sort_Descending, OffsetOf(charInfo\count), #PB_Sort_integer)
;construct letter cycles
FirstElement(letters())
Protected maxLetterCount = letters()\count
Dim letterCycles.cycle(maxLetterCount - 1)
Protected curCycleIndex
ForEach letters()
ForEach letters()\Position()
With letterCycles(curCycleIndex)
AddElement(\cycle())
\cycle()\Char = letters()\Char
\cycle()\Position = letters()\position()
EndWith
curCycleIndex = (curCycleIndex + 1) % maxLetterCount
Next
Next
;rotate letters in each cycle
Protected isFirst, prevChar.s, pos_1
For i = 0 To maxLetterCount - 1
With letterCycles(i)
isFirst = #True
ForEach \cycle()
If Not isFirst
shuffledLetters(\cycle()\Position) = prevChar
Else
pos_1 = \cycle()\Position
isFirst = #False
EndIf
prevChar = \cycle()\Char
Next
shuffledLetters(pos_1) = prevChar
EndWith
Next
;score and display shuffle
Protected shuffledWord.s, ignored
For i = 0 To ArraySize(shuffledLetters())
shuffledWord + shuffledLetters(i)
If shuffledLetters(i) = originalLetters(i)
ignored + 1
EndIf
Next
PrintN(word + ", " + shuffledWord + ", (" + Str(ignored) + ")")
ProcedureReturn shuffledWord
EndProcedure
If OpenConsole()
shuffleWordLetters("abracadabra")
shuffleWordLetters("seesaw")
shuffleWordLetters("elk")
shuffleWordLetters("grrrrrr")
shuffleWordLetters("up")
shuffleWordLetters("a")
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</lang>
Sample output:
<pre>abracadabra, daabarbraac, (0)
seesaw, eawess, (0)
elk, lke, (0)
grrrrrr, rgrrrrr, (5)
up, pu, (0)
a, a, (1)</pre>
=={{header|REXX}}==
<lang rexx>/*REXX program to find best shuffle (of a character string). */
| |||