Sub Globals
'These global variables will be redeclared each time the activity is created.
'These variables can only be accessed from this module.
Type CodeBittingCombo (Code As String, Bitting As String)
Dim Bittings As Map ' contains the code/bittings to be arranged
Dim KeySets As List ' contains the arranged code/bittings for all key sets
Dim KeySet As Map ' contains the arranged code/bittings for a single key set
Dim Key As Int ' Key number
End Sub
Sub Activity_Create(FirstTime As Boolean)
'Do not forget to load the layout file created with the visual designer. For example:
'Activity.LoadLayout("Layout1")
KeySets.Initialize
Bittings.Initialize
' Bittings.Put("40466", "1242334212")
' Bittings.Put("40879", "1242334223")
' Bittings.Put("40470", "1242334234")
' Bittings.Put("40717", "1242334344")
' Bittings.Put("40795", "1242334232")
' Bittings.Put("13383", "1242334243")
' Bittings.Put("40551", "1242334443")
' Bittings.Put("40145", "1242334322")
' Bittings.Put("40953", "1242334324")
' Bittings.Put("40342", "1242334434")
' Bittings.Put("10383", "1243334213")
' Bittings.Put("2409", "1243334224")
' Bittings.Put("12461", "1243334244")
' Bittings.Put("20535", "1243334222")
' Bittings.Put("11448", "1243334242")
' Bittings.Put("3831", "1244334243")
' Bittings.Put("18764", "1244334212")
' Bittings.Put("9485", "1244334223")
' Bittings.Put("9599", "1244334234")
' Bittings.Put("40261", "1242334342")
' Bittings.Put("6408", "1243334442")
' Bittings.Put("11778", "1242334423")
' Bittings.Put("4489", "1243334424")
' Bittings.Put("15979", "1242334432")
' Bittings.Put("3893", "1244334432")
' Bittings.Put("19164", "1243334422")
' Bittings.Put("7161", "1244334423")
' Bittings.Put("7201", "1244334232")
' Bittings.Put("13331", "1244334342")
' Bittings.Put("17341", "1244334322")
' Bittings.Put("12813", "1244334324")
' Bittings.Put("10008", "1243332422")
' Bittings.Put("19164", "1243334422")
' Bittings.Put("10383", "1243334213")
' Bittings.Put("17054", "1243332132")
' Bittings.Put("11448", "1243334242")
' Bittings.Put("14571", "1243332244")
' Bittings.Put("06313", "1243332444")
' Bittings.Put("10666", "1243331212")
' Bittings.Put("04259", "1243332123")
' Bittings.Put("14451", "1243332134")
' Bittings.Put("13315", "1243331223")
' Bittings.Put("18917", "1243331243")
' Bittings.Put("12461", "1243334244")
' Bittings.Put("03554", "1243331232")
' Bittings.Put("02409", "1243334224")
' Bittings.Put("20535", "1243334222")
' Bittings.Put("00801", "1243331113")
' Bittings.Put("03447", "1243331124")
' Bittings.Put("00001", "1243331234")
' Bittings.Put("09726", "1243332224")
' Bittings.Put("12641", "1243332424")
' Bittings.Put("04489", "1243334424")
' Bittings.Put("11770", "1243332112")
' Bittings.Put("02136", "1243332213")
' Bittings.Put("15405", "1243332242")
' Bittings.Put("13005", "1243332442")
' Bittings.Put("06408", "1243334442")
Bittings.Put("0K001", "232131-321151")
Bittings.Put("0K002", "252131-321151")
Bittings.Put("0K003", "224131-321151")
Bittings.Put("0K004", "244131-321151")
Bittings.Put("0K005", "264131-321151")
Bittings.Put("0K006", "126231-321151")
Bittings.Put("0K007", "246231-321151")
Bittings.Put("0K008", "266231-321151")
Bittings.Put("0K009", "241331-321151")
Bittings.Put("0K010", "262331-321151")
Bittings.Put("0K011", "254331-321151")
Bittings.Put("0K012", "215431-321151")
Bittings.Put("0K013", "235431-321151")
Bittings.Put("0K014", "256431-321151")
Bittings.Put("0K015", "221531-321151")
Bittings.Put("0K016", "241531-321151")
Bittings.Put("0K017", "262531-321151")
Bittings.Put("0K018", "213531-321151")
Bittings.Put("0K019", "233531-321151")
Bittings.Put("0K020", "254531-321151")
Bittings.Put("0K021", "215631-321151")
Bittings.Put("0K022", "235631-321151")
Bittings.Put("0K023", "256631-321151")
Bittings.Put("0L349", "432131-321151")
Bittings.Put("0L351", "424131-321151")
Bittings.Put("0L352", "444131-321151")
Bittings.Put("0L353", "464131-321151")
Bittings.Put("0L354", "426231-321151")
Bittings.Put("0L355", "446231-321151")
Bittings.Put("0L356", "466231-321151")
Bittings.Put("0L359", "454331-321151")
Bittings.Put("0L361", "435431-321151")
Bittings.Put("0L362", "456431-321151")
Bittings.Put("0L364", "441531-321151")
Bittings.Put("0L365", "462531-321151")
Bittings.Put("0L368", "454531-321151")
Bittings.Put("0L370", "435631-321151")
Bittings.Put("0L371", "456631-321151")
Bittings.Put("0M701", "664131-321151")
Bittings.Put("0M703", "646231-321151")
Bittings.Put("0M704", "666231-321151")
Bittings.Put("0M707", "654331-321151")
Bittings.Put("0M709", "656431-321151")
Bittings.Put("0M711", "641531-321151")
Bittings.Put("0M712", "662531-321151")
Bittings.Put("0M714", "654531-321151")
Bittings.Put("0M715", "635631-321151")
Bittings.Put("0M716", "656631-321151")
BeginKeySearch
End Sub
Sub BeginKeySearch()
Key = 0
GetKeys
' It's at this point that we should now have a bunch of keys (another bad pun) in the LIST
' We sort the LIST by the number of combinations in Descending order
' The LIST does not have a numbered KEY - we don't need one.
Dim SortedKeySets As List
SortedKeySets.Initialize
Dim KeyNum As Int = 0
Log (CRLF & "Sorted sets")
Do While KeySets.Size > 0
' Find the first set that has the most keys
Dim SetSize As Int = 0
Dim HighestSet As Map
Dim HighestNdx As Int = 0
For SetNdx = 0 To KeySets.Size - 1
Dim Set As Map = KeySets.Get(SetNdx)
If Set.Size > SetSize Then
SetSize = Set.Size
HighestSet = Set
HighestNdx = SetNdx
End If
Next
' Display each of the combinations for the key
KeyNum = KeyNum + 1
Log("Key #" & KeyNum)
For Ndx = 0 To HighestSet.Size - 1
Dim Code As String = HighestSet.GetKeyAt(Ndx)
Dim Bitting As String = HighestSet.GetValueAt(Ndx)
Log(Code & " " & Bitting)
Next
Log(CRLF & " ") ' just for the sake of being pretty
' Now remove the set that we have just shown
KeySets.RemoveAt(HighestNdx)
Loop
End Sub
Sub GetKeys()
If Bittings.Size = 0 Then Return ' make sure we don't keep running in a loop
Key = Key + 1
Log("Key " & Key)
' Create a new Map to contain the keys for this set of combinations
Dim NewKeySet As Map
NewKeySet.Initialize
KeySet = NewKeySet ' copy the reference so we can access the list
' adding the new KeySet to the LIST is also done by REFERENCE
' So when we add a new combination to the KeySet it will also be in the LIST
KeySets.Add(KeySet)
' start by finding the lowest key combo
Dim LowestCombo As Int
LowestCombo = FindLowestCombo
Dim Code As String = Bittings.GetKeyAt(LowestCombo)
Dim Bitting As String = Bittings.GetValueAt(LowestCombo)
' The lowest combination is always the first in the set
KeySet.Put(Code, Bitting)
Log(Code & " " & Bitting) ' Show in the log as well
' Remove the code/combination from the list
Bittings.Remove(Code)
' Go and find the next lowest key combination
FindNextLowest(Bitting) ' this is a recursive routine
GetKeys ' call myself again until we run out of combinations
End Sub
Sub FindLowestCombo() As Int
' This is the easy part as we're looking for the lowest bitting value
' That also has the lowest number of changes from right to left
' Loop through each to find the lowest
' Result is used to determine if a combination was found.
' It is an index to the combination that is the lowest
' A value other than -1 means that a combination was found.
Dim Result As Int = -1
Dim Lowest As String = "ZZZZZZZZZZZZZZZZZZ" ' start with a high value first
' iterate through each bitting to find the lowest
For ndx = 0 To Bittings.Size - 1
Dim thisBitting As String = Bittings.GetValueAt(ndx)
If thisBitting.CompareTo(Lowest) < 0 Then
Lowest = thisBitting
Result = ndx
End If
Next
' We should now have the lowest bitting
Return Result
End Sub
Sub FindNextLowest(CurrentLowest As String)
Dim Lowest As Int = -1 ' Index into Bittings map with the lowest Bitting Combination
Dim LowestBitting As String = "" ' Lowest bitting combination found
Dim Changes As Int = 0
Dim PrevChanges As Int = 99 ' start with a high value
Dim NewLowest As String = "ZZZZZZZZZZZZZZZZZZ" ' start with a high value
' iterate through each remaining bitting combination
' We're looking for a bitting with the fewest number of changes as possible and with the lowest value
For ndx = 0 To Bittings.Size - 1
Dim ThisBitting As String = Bittings.GetValueAt(ndx)
Dim ThisChar As String
Dim LowestChar As String
Changes = 0
' starting on the right iterate through each character in the bitting comparing it to the
' current lowest that was passed into this function
For pos = ThisBitting.Length - 1 To 0 Step -1
ThisChar = ThisBitting.CharAt(pos)
LowestChar = CurrentLowest.CharAt(pos)
If ThisChar.CompareTo(LowestChar) >= 0 Then
If ThisChar.CompareTo(LowestChar) > 0 Then
' only count the changes/differences
Changes = Changes + 1
End If
Else
' ignore any bitting that is/has a lower value
Changes = -1
Exit
End If
Next
If Changes > 0 And Changes <= PrevChanges Then
If ThisBitting.CompareTo(NewLowest) < 0 Then
NewLowest = ThisBitting
PrevChanges = Changes
Lowest = ndx
End If
End If
Next
If Lowest = -1 Then Return ' nothing was found to be lower
' Add the next key combination to our set
Dim LowestBitting As String = Bittings.GetValueAt(Lowest)
Dim Code As String = Bittings.GetKeyAt(Lowest)
KeySet.Put(Code, LowestBitting)
Log(Code & " " & LowestBitting)
Bittings.Remove(Code) ' remove this combination so we don't use it again
FindNextLowest(LowestBitting) ' recursively call myself for the next key
End Sub