Randomizing Indexes in an Array

[cafeenman]

Well... it's ugly but this is what I came up with.

Max Attribute is always 0 so don't need to generate a starting stat for it. This is to randomize the order stats get starting points rolled for so that it's not always biased in favor of the Index-order of the stats. I talked about it in chit-chat but now it's actual code.

This is just the part where I'm randomizing in the Indexes, not the rolling values for the stats part. This is what I was being vexxed by. It's orders of magnitude better than what I was doing but still probably absolutely the wrong way to do it.

What I'm trying to achieve is one and done rolling for stats (which calls this first).

It's returning 0 through 5 (MIN_ATTRIBUTE = 0, MAX_ATTRIBUTE - 1 = 5)

If someone can show me a better way I'd appreciate it.

Public Function RandomizeAttributeIndexes() As Long()
Dim m_Callstacker As New cCallStacker
Dim nAttributeIndex(MIN_PLAYER_ATTRIBUTE To MAX_PLAYER_ATTRIBUTE - 1) As Long
Dim fSuccess As Boolean
Dim nRnd As Long
Dim n As Long
Dim m As Long

' Does not include Development which always starts at 0.

m_Callstacker.Add NAME & ".RandomizeAttributeIndexes(Public Function)"

For n = LBound(nAttributeIndex) To UBound(nAttributeIndex)

  nAttributeIndex(n) = -1

Next n

Do

  fSuccess = True

  For n = LBound(nAttributeIndex) To UBound(nAttributeIndex)

    nRnd = RollDie(MAX_PLAYER_ATTRIBUTE - MIN_PLAYER_ATTRIBUTE) - 1

    If nAttributeIndex(n) = -1 Then

      For m = LBound(nAttributeIndex) To UBound(nAttributeIndex)

        If nAttributeIndex(m) = nRnd Then

          fSuccess = False

          Exit For

        End If

      Next m

      If fSuccess Then nAttributeIndex(n) = nRnd

    End If

  Next n

Loop Until fSuccess

For n = LBound(nAttributeIndex) To UBound(nAttributeIndex)

    Debug.Print "nAttributeIndex(" & n & ") = " & nAttributeIndex(n)

Next n

RandomizeAttributeIndexes = nAttributeIndex

Stop

End Function

[cafeenman]

Forgot an Exit For in there. No reason to keep looping through the m loop after fSuccess is already false.

This is the results of three quick runs:

nattributeindex(n) = 2
nattributeindex(n) = 1
nattributeindex(n) = 3
nattributeindex(n) = 0
nattributeindex(n) = 4
nattributeindex(n) = 5

nattributeindex(n) = 4
nattributeindex(n) = 0
nattributeindex(n) = 2
nattributeindex(n) = 1
nattributeindex(n) = 5
nattributeindex(n) = 3

nattributeindex(n) = 0
nattributeindex(n) = 1
nattributeindex(n) = 3
nattributeindex(n) = 4
nattributeindex(n) = 5
nattributeindex(n) = 2

Edit: Oops... did the debug.print string wrong.

This is the correct output:

nAttributeIndex(0) = 0
nAttributeIndex(1) = 1
nAttributeIndex(2) = 4
nAttributeIndex(3) = 3
nAttributeIndex(4) = 5
nAttributeIndex(5) = 2

[cafeenman]

Next thing.

Now I just have to marry these two procedures (the one above and this one).

Then I can test it and see if it actually works.

This is the rolling part.

Private Function RollStartingAttributeValue(ByRef AttributeID As PLAYER_ATTRIBUTES, ByRef AvailablePoints As Long) As Long
Dim m_Callstacker As New cCallStacker
Dim nMaxValue As Long
Dim nMinStart As Long
Dim nValue As Long

' Returns remaining Available Points.

' Caller needs to Initialize Min Values for each Attribute before calling this procedure so that
' all Attributes have at least the minimum required and those points are removed from the pool.

m_Callstacker.Add NAME & ".RollStartingAttributeValue(Private Function)"

nMinStart = nMinStartingAttributePoints(AttributeID)

'AvailablePoints = AvailablePoints - nMinStart ' Oops.  Was subtracting them twice.  Once before here.


If AvailablePoints < 0 Then Exit Function ' Somebody screwed up initialization of Mins and Maxes and should probably fix that.


If AvailablePoints + nMinStart >= nMaxStartingAttributePoints(AttributeID) Then ' Enough Points Available to Max the Starting Value for Attribute.

  nMaxValue = nMaxStartingAttributePoints(AttributeID) - nMinStart

Else ' Not enough Available Points to Max Attribute.

  nMaxValue = AvailablePoints

End If


nValue = RollDie(nMaxValue + 1) - 1

nStartingAttributePoints(AttributeID) = nMinStart + nValue

RollStartingAttributeValue = AvailablePoints - nValue

End Function

[cafeenman]

crap... and now I just realized this will not distribute all the points necessarily. I mean it could roll a bunch of 1's and leave hundreds of points. So now I'm back to the same problem I started with.

crap....

[cafeenman]

I think this solves the above problem. Really a brute-force way to do it but basically just gonna take any left-over points and distribute them point-by-point to Attributes that haven't reached their Max allowed starting value.

Thus:

Private Sub DistributeRemainingStartingPoints(ByRef AvailablePoints As Long)
Dim m_Callstacker As New cCallStacker
Dim nCounter As Long
Dim n As Long

m_Callstacker.Add NAME & ".DistributeRemainingStartingPoints(Private Sub)"

Do

  nCounter = nCounter + 1 ' Should be adding at least one point each time through.

  For n = LBound(nStartingAttributePoints) To UBound(nStartingAttributePoints)

    If AvailablePoints < 1 Then Exit Sub

    If nStartingAttributePoints(n) < nMaxStartingAttributePoints(n) Then

      nStartingAttributePoints(n) = nStartingAttributePoints(n) + 1

      AvailablePoints = AvailablePoints - 1

    End If

  Next n

  If nCounter >= nSumStartingAttributesMustEqual Then Exit Sub ' Bail out.  Something went wrong.
  
Loop

End Sub

[cafeenman]

GOT IT! (Still not resolved because of original post - better way to shuffle an array)

But it works and it's so way much faster and better than what I had before.

This is the Call that starts it all. I think I've edited all the above posts to show their current version.

Private Function RollRandomStartingAttributes() As Long
Dim m_Callstacker As New cCallStacker
Dim nAttributeIndex() As Long
Dim nAvailableStartingPoints As Long
Dim n As Long

m_Callstacker.Add NAME & ".RollRandomStartingAttributes(Private Function)"

nAvailableStartingPoints = nTotalStartingPoints

For n = MIN_PLAYER_ATTRIBUTE To MAX_PLAYER_ATTRIBUTE - 1

  nStartingAttributePoints(n) = nMinStartingAttributePoints(n)
  nAvailableStartingPoints = nAvailableStartingPoints - nMinStartingAttributePoints(n)

Next n

nAttributeIndex = RandomizeAttributeIndexes

For n = LBound(nAttributeIndex) To UBound(nAttributeIndex)

  nAvailableStartingPoints = RollStartingAttributeValue(nAttributeIndex(n), nAvailableStartingPoints)

Next n

DistributeRemainingStartingPoints nAvailableStartingPoints

RollRandomStartingAttributes = 0

End Function