Algorithm to limit number of consecutive characters

[trisuglow]

I need an algorithm that takes a string of characters and a number as parameters. It will output a string.

The numeric parameter is the maximum number of identical characters that can be consecutive in the output string.

The output string should contain the same characters, and be the same length, as the input string. The only difference is that the order of the characters in the output is such that the maximum consecutive characters is not exceeded.

For example, F("aaaabbac", 2) = "aabaabac" would be a valid result.


My thinking so far is along these lines:

do loop
    start from left of string
    count consecutive characters
    if count > max_consecutive then
        swap current character with next (different) character (may have to wrap round to the start of the string to find this)
    endif
until no set of consecutive characters exceeds max_consecutive 

I'd be grateful for comments and also some ideas on how to test the algorithm.

[BestS]

Let's try something:
Letter by letter we move through the string.
aaaabaaaab
First letter is "a" so we store it in a variable
(dim strCheck as string, strAll as string)
strAll = "aaaabaaaab"

strCheck = left$("aaabaaab",1)
Now we check the second, if it is again "a" then we check the third
if it is again "a" then we replace it?
Is this what you need?

[trisuglow]

Yes, that sounds like what I'm talking about.

The code I developed from my pseudo code (see earlier in this thread) is as follows:

m_objMaterials is a collection that contains (for the sake of simplicity) single characters. In reality the collection contains objects that are identified by their TypeID property.

MaxConsecutive is a function that returns the maximum number of consecutive characters.

The idea is that you keep calling LimitConsecutive() until it returns False.


The function seems to work ok, but there are three things I could do with help on:

1. Could the function be more efficient and/or simpler.
2. What is the maximum number of times the function has to be called to get the final result? (Obviously this is dependant on the number of different items, total quantity of items and the maximum consecutive items)
3. How can I test the function to prove that it will work for all input.

Private Function LimitConsecutive() As Boolean
'Returns TRUE if materials have been swapped to prevent the maximum number of
'consecutive material types being exceeded.
    Dim blnResult       As Boolean
    Dim lngLoop         As Long
    Dim lngIndex        As Long
    Dim lngCount        As Long
    Dim objTemp         As New CMaterials
    
    lngCount = 1
    
    For lngLoop = 1 To Size - 1
        If m_objMaterials(lngLoop).TypeID = m_objMaterials(lngLoop + 1).TypeID Then
            lngCount = lngCount + 1
        Else
            lngCount = 1
        End If
        If lngCount > MaxConsecutive Then
'There are too many of the same material type in a contiguous block.
            blnResult = True
            Set objTemp = m_objMaterials(lngLoop + 1)
            lngIndex = lngLoop + 2
'Search forward to find a different material type.
            If lngIndex <= Size Then
                While (lngIndex < Size) And (m_objMaterials(lngIndex).TypeID = objTemp.TypeID)
                    lngIndex = lngIndex + 1
                Wend
            Else
'Already at the end. Start again from the beginning.
                lngIndex = 1
            End If
            If m_objMaterials(lngIndex).TypeID <> objTemp.TypeID Then
'Found one - swap with the last one in the contiguous block.
                Set m_objMaterials(lngLoop + 1) = m_objMaterials(lngIndex)
                Set m_objMaterials(lngIndex) = objTemp
                Exit For
            Else
'Continue to search from the beginning.
                lngIndex = 1
                While (lngIndex < lngLoop + 1) And (m_objMaterials(lngIndex).TypeID = objTemp.TypeID)
                    lngIndex = lngIndex + 1
                Wend
                If m_objMaterials(lngIndex).TypeID <> objTemp.TypeID Then
'Found one now - swap with the last one in the contiguous block.
                    Set m_objMaterials(lngLoop + 1) = m_objMaterials(lngIndex)
                    Set m_objMaterials(lngIndex) = objTemp
                    Exit For
                Else
                    'Error - could not apply required limit.", , "TODO"
                End If
            End If
        End If
    Next
    LimitConsecutive = blnResult
End Function

[westconn1]

Dim maxl As Integer, mystr As String, s, mystart As Integer, pos As Integer, mychar As String
Dim i As Integer
maxl = 3
mystart = 1
pos = 1
mystr = "qqqqqqqqqweeeerrrrrrrtttttttttyyuuuuuuuuuiiiiiooooooooppppppppp"
 
For i = 1 To Len(mystr)
    mychar = String(maxl + 1, Mid(mystr, i, 1))
    pos = InStr(i, mystr, mychar)
    If Not pos = 0 Then
    If pos = i Then
        mystr = Left(mystr, i + maxl - 1) & Right(mystr, Len(mystr) - i - maxl) & Mid(mystr, i, 1)
        i = i - 1
        End If
    End If
Next
Debug.Print mystr

try this

pete

[BestS]

Wow that's a long one...I can not even get it all right now...
I gave just an idea that came to my mind:
stplit the string letter by letter and then swap them, but you already SO...

[trisuglow]

Thanks Pete,

Even though I'm not actually dealing with strings in my real-world application it's a good idea. I can make a string based on the TypeIDs of my objects, apply your algorithm to it, and then reorder the collection based on the contents of the string.

I tried your code with some different values as follows and it got stuck in a loop, but I can probably work that out for myself.

Thanks again.

Option Explicit
 
Private Sub Command1_Click()
Dim maxl As Integer, mystr As String, s, mystart As Integer, pos As Integer, mychar As String
Dim i As Integer
maxl = 2
mystart = 1
pos = 1
mystr = "11111112223"
 
For i = 1 To Len(mystr)
    mychar = String(maxl + 1, Mid(mystr, i, 1))
    pos = InStr(i, mystr, mychar)
    If Not pos = 0 Then
    If pos = i Then
        mystr = Left(mystr, i + maxl - 1) & Right(mystr, Len(mystr) - i - maxl) & Mid(mystr, i, 1)
        i = i - 1
        End If
    End If
Next
Debug.Print mystr
End Sub

[westconn1]

it would have to get stuck if there are too many "1" s to split up

if you get a string "pppppppppppppppppppppppppppppppppppp" no way you can make it do what you asked

pete

[trisuglow]

it would have to get stuck if there are too many "1" s to split up

But in my example it should be able to transform 11111112223 to 11211211213.

[Frans C]

Try this one:

Private Function LimitConsecutive(ByRef mystr As String, ByVal MaxOccur As Integer) As Boolean
Dim strResult As String
Dim strBuffer As String
Dim strChar As String
Dim i As Integer
Dim intOccur As Integer
    ' loop through the string
    For i = 1 To Len(mystr)
        strChar = Mid(mystr, i, 1)
        If i = 1 Then
            ' the first character, just add it
            strResult = strChar
            intOccur = 1
        Else
            ' check if the character is the same as the last one
            If strChar = Left(strResult, 1) Then
                ' do we exceed the maximum
                If intOccur >= MaxOccur Then
                    ' add it to the buffer
                    strBuffer = strBuffer & strChar
                Else
                    ' add it to the result
                    strResult = strResult & strChar
                    intOccur = intOccur + 1
                End If
            Else
                strResult = strResult & strChar
                ' if we have characters in the buffer, we can add them
                If Len(strBuffer) > 0 Then
                    ' add characters from the buffer
                    If Len(strBuffer) > MaxOccur Then
                        ' buffer is larger the max occurence, add as much as is permitted
                        strResult = strResult & Left(strBuffer, MaxOccur)
                        intOccur = MaxOccur
                        ' remove these characters from the buffer
                        strBuffer = Right(strBuffer, Len(strBuffer) - MaxOccur)
                    Else
                        ' whole buffer can be added
                        strResult = strResult & strBuffer
                        intOccur = Len(strBuffer)
                        ' empty the buffer
                        strBuffer = ""
                    End If
                Else
                    intOccur = 1
                End If
            End If
         End If
    Next
    If Len(strBuffer) > 0 Then
        ' there are still characters in the buffer, we didn't manage to perform the operation
        LimitConsecutive = False
        mystr = strResult & strBuffer
    Else
        ' buffer is empty, all is fine
        LimitConsecutive = True
        mystr = strResult
    End If
End Function

You can use it like this:

Private Sub Command1_Click()
Dim blnSucceeded As Boolean
Dim MyString As String
    MyString = "11111112223"
    blnSucceeded = LimitConsecutive(MyString, 2)
    If blnSucceeded Then
        MsgBox MyString
    Else
        MsgBox "Failed"
    End If
End Sub

[Al42]

But in my example it should be able to transform 11111112223 to 11211211213.

If you already know the input data you don't need code. If you need code, your algorithm has to allow for input data of the form of "1111111111111111112". Your analysis can't handle that.

Either the output data can't be the same length as the input data, the intervening items can't be taken solely from the input data or you have to rethink the whole thing.

[trisuglow]

AI42,

I can pre-validate the input to the alogrithm to ensure that a valid output is possible.

[trisuglow]

FransC,

Thanks, I'll have a look at this tomorrow.