[RESOLVED] Algorithm Help Needed

[Jimbo Jnr]

I need help to figure out algorithm in vb6 for creating groups of people given the total based on some rules. The groups need to be as even as possible. The Maximum people in a group is 8. The Minimum people in a group is 6. The groups need to be as close to the Maximum as possible.

So:
If the Total = 24 the algorithm will produce 3 Groups of 8

If the Total = 21 the algorithm will produce 3 Groups of 7
(not 2 groups of 8 and 1 group of 6)

If the Total = 26 the algorithm will produce 2 Groups of 7 and 2 groups of 6

I tried and failed to implement anything that works. Any help is greatly appreciated

[krtxmrtz]

I need help to figure out algorithm in vb6 for creating groups of people given the total based on some rules. The groups need to be as even as possible. The Maximum people in a group is 8. The Minimum people in a group is 6. The groups need to be as close to the Maximum as possible.

So:
If the Total = 24 the algorithm will produce 3 Groups of 8

If the Total = 21 the algorithm will produce 3 Groups of 7
(not 2 groups of 8 and 1 group of 6)

If the Total = 26 the algorithm will produce 2 Groups of 7 and 2 groups of 6

I tried and failed to implement anything that works. Any help is greatly appreciated

I assume the minimum people in the group is 2, else the solution is trivial, for a total of N people, N groups of 1 person.

[lintz]

This seems to work for me......

Private Sub Form_Load()

'If the Total = 24 the algorithm will produce 3 Groups of 8

'If the Total = 21 the algorithm will produce 3 Groups of 7
'(not 2 groups of 8 and 1 group of 6)

'If the Total = 26 the algorithm will produce 2 Groups of 7 and 2 groups of 6
Dim bSkip As Boolean
Dim i As Integer
Dim iRemainder As Integer
Dim iTotal As Integer
Dim iTotal2 As Integer
Dim iDivide(2) As Integer
iDivide(0) = 8
iDivide(1) = 7
iDivide(2) = 6

Dim iGroups(1) As Integer
Dim iLoop As Integer

iTotal = 23

    For i = 0 To 1
    
        If iTotal Mod iDivide(i) = 0 Then
        iGroups(0) = iTotal / iDivide(i)
        bSkip = True
        Exit For
        End If
        
    Next
    
    
If bSkip = False Then

    For i = 0 To 2
    
    iRemainder = Left$(iTotal / iDivide(i), 1)
    
        For iLoop = 0 To iRemainder - 1
        iTotal2 = iDivide(i) * (iRemainder - iLoop)
        
            If (iTotal - iTotal2) Mod iDivide(i + 1) = 0 Then
            iGroups(0) = iRemainder - iLoop
            iGroups(1) = (iTotal - iTotal2) / iDivide(i + 1)
            bSkip = True
            Exit For
            End If
            
        Next
      
        If bSkip = True Then
        Exit For
        End If
        
    Next
    
End If

Debug.Print iGroups(0) & " groups of " & iDivide(i) & " plus " & iGroups(1) & " groups of " & iDivide(i + 1)


End Sub

[Jimbo Jnr]

Trivial? The Minimum amount of people in a group is 6.
12 people would produce 2 groups of 6
13 people would produce 1 group of 7 and 1 group of 6
14 people would produce 2 groups of 7
and so on with no more than 8 people in any group

[Jimbo Jnr]

That seems perfect lintz. I was trying all sorts of convoluted nonsense.

Cheers

[krtxmrtz]

That's my approach...

Option Explicit
Dim N As Integer, MaxGroup As Integer, PperG As Integer, Diff As Integer

Private Sub Form_Click()
    Dim i As Integer
    Dim msg As String
    Dim quotient As Integer, remainder As Integer, eval As Integer
    Dim PperG As Integer   'The number of people per group
    'N is the total number of people
    N = Val(Text1.Text)
    'Initialize Diff to a large number
    Diff = N
    For i = 2 To 8
        quotient = N \ i
        remainder = N Mod i
        If remainder = 0 Then
            PperG = i
            Exit For
        End If
        eval = quotient - remainder
        If eval < Diff Then
            Diff = eval
            PperG = i
        End If
    Next
    msg = Trim(N \ PperG) & " groups of " & Trim(PperG) & " people"
    If N Mod i <> 0 Then msg = msg & " 1 group of " & Trim(N Mod PperG) & " people"
    MsgBox msg, vbOKOnly, "Result"

[lintz]

That seems perfect lintz. I was trying all sorts of convoluted nonsense.

Cheers

Glad to help

ps. Welcome to the forums

[Jimbo Jnr]

Thanks also Krtxmrts.
I think your version doesnt limit the maximum and minimum to 8 and 6 respectively which is what i need but I appriciate the time and effort.

[leinad31]

Another approach is to create groups based on 8 grouping (plus remainder), then add the "persons" one by one into the groups.

Private Function GetGroups(ByVal Total As Long) As Integer()
Dim intRet() As Integer
Dim lngIndex As Long

   If Total < 6 Or Total = 9 Or Total = 10 Or Total = 11 Then
      '9, 10, 11 will create trailing groups with not enough "persons"
      'another alternative is to check later on that all groups are more than six
      ReDim intRet(0):  GetGroups = intRet:  Exit Function
   End If
   
   ReDim intRet((Total - 1) \ 8)   'groups based on 8-grouping adjusted for 0-based array
   lngIndex = 0
   Do Until Total <= 0  'all assigned into groups
      intRet(lngIndex) = intRet(lngIndex) + 1  'assign a person
      Total = Total - 1                               'subtract him from population
      lngIndex = lngIndex + 1                      'adjust array index
      If lngIndex > UBound(intRet) Then lngIndex = 0
   Loop

   GetGroups = intRet
End Function

[Jimbo Jnr]

Thats perfect too leinad. Concise and clever

Good stuff

[bushmobile]

with leniad's code you could also assume that each group has 6 in at the start - giving you slightly less looping:

Private Function GetGroups(ByVal Total As Long) As Integer()
    Dim intRet() As Integer
    Dim lngIndex As Long, N As Long

    If Total < 6 Or Total = 9 Or Total = 10 Or Total = 11 Then
        ReDim intRet(0):  GetGroups = intRet:  Exit Function
    End If
    
    ReDim intRet((Total - 1) \ 8)
    For N = 0 To UBound(intRet)
        intRet(N) = 6
    Next N
    
    For N = (UBound(intRet) + 1) * 6 To Total - 1
        intRet(lngIndex) = intRet(lngIndex) + 1
        lngIndex = (lngIndex + 1) Mod (UBound(intRet) + 1)
    Next N
    
    GetGroups = intRet
End Function

[leinad31]

I did that originally, but then had second thoughts cause of the possibility that the grouping is invalid (less than 6 in a group) such as with population = 9,10,11. But if population is always large then it shouldn't be an issue and the shortcut can be applied safely.

[bushmobile]

but you deal with those separately

[leinad31]

I edited my post... I meant I wasn't 100 percent sure a valid grouping would be created for a small population.

EDIT: we can check Ubound value to see if its >= 6. If it is then grouping is valid.

EDIT2: above is wrong since array elements are supposed to be initialized to min of 6 so check will always be valid ^^

If Total < (((Total - 1) \ 8) +1) * 6 Then Invalid grouping, would be a better test and can be performed before any array processing.