RosettaCodeData/Task/State-name-puzzle/FreeBASIC/state-name-puzzle.basic
2024-11-04 21:53:44 -08:00

108 lines
3.6 KiB
Text

#include "string.bi"
Type KeyPair
As String key, pairs
End Type
Function SortString(text As String) As String
Static As Integer i, j
Static As String result, tmp
result = Lcase(text)
For i = 1 To Len(result) - 1
For j = i + 1 To Len(result)
If Mid(result, j, 1) < Mid(result, i, 1) Then
tmp = Mid(result, i, 1)
Mid(result, i, 1) = Mid(result, j, 1)
Mid(result, j, 1) = tmp
End If
Next j
Next i
Return result
End Function
Sub Play(states() As String, stateCount As Integer)
Static As Integer i, j, k, m, n
Static As Integer pairCount, found, posic
Static As String key, existingPairs
Static As KeyPair pairs(10000)
pairCount = 0
For i = 0 To stateCount - 2
For j = i + 1 To stateCount - 1
key = SortString(Trim(states(i) & states(j)))
found = -1
For k = 0 To pairCount - 1
If pairs(k).key = key Then
found = k
Exit For
End If
Next
If found >= 0 Then
existingPairs = pairs(found).pairs
posic = 1
While posic <= Len(existingPairs)
m = Cint(Mid(existingPairs, posic, 3))
n = Cint(Mid(existingPairs, posic + 3, 3))
If m <> i Andalso m <> j Andalso n <> i Andalso n <> j Then
Print states(i); ", "; states(j); " <==> "; states(m); ", "; states(n)
End If
posic += 6
Wend
pairs(found).pairs = pairs(found).pairs & Format(i, "000") & Format(j, "000")
Else
pairs(pairCount).key = key
pairs(pairCount).pairs = Format(i, "000") & Format(j, "000")
pairCount += 1
End If
Next j
Next i
End Sub
' Test program
Dim Shared As String states(49)
states(0) = "Alabama" : states(1) = "Alaska"
states(2) = "Arizona" : states(3) = "Arkansas"
states(4) = "California" : states(5) = "Colorado"
states(6) = "Connecticut" : states(7) = "Delaware"
states(8) = "Florida" : states(9) = "Georgia"
states(10) = "Hawaii" : states(11) = "Idaho"
states(12) = "Illinois" : states(13) = "Indiana"
states(14) = "Iowa" : states(15) = "Kansas"
states(16) = "Kentucky" : states(17) = "Louisiana"
states(18) = "Maine" : states(19) = "Maryland"
states(20) = "Massachusetts" : states(21) = "Michigan"
states(22) = "Minnesota" : states(23) = "Mississippi"
states(24) = "Missouri" : states(25) = "Montana"
states(26) = "Nebraska" : states(27) = "Nevada"
states(28) = "New Hampshire" : states(29) = "New Jersey"
states(30) = "New Mexico" : states(31) = "New York"
states(32) = "North Carolina": states(33) = "North Dakota"
states(34) = "Ohio" : states(35) = "Oklahoma"
states(36) = "Oregon" : states(37) = "Pennsylvania"
states(38) = "Rhode Island" : states(39) = "South Carolina"
states(40) = "South Dakota" : states(41) = "Tennessee"
states(42) = "Texas" : states(43) = "Utah"
states(44) = "Vermont" : states(45) = "Virginia"
states(46) = "Washington" : states(47) = "West Virginia"
states(48) = "Wisconsin" : states(49) = "Wyoming"
Dim Shared As String extras(1)
extras(0) = "Slender Dragon" : extras(1) = "Abalamara"
Play(states(), 50)
Print "==="
Dim combined(51) As String
For i As Integer = 0 To 49
combined(i) = states(i)
Next
For i As Integer = 0 To 1
combined(50 + i) = extras(i)
Next
Play(combined(), 52)
Sleep