JustCode : Randomize Cats V1

This function will randomize categories and make sure that some do not sit next to each other.

 Metadata(en-US, Question, Label)
q1loop "blah" loop
{
_1 "_1",
_2 "_2",
_3 "_3",
_4 "_4",
_5 "_5",
_6 "_6",
_7 "_7",
_8 "_8",
_9 "_9"
} fields -
(
q1 ""
categorical [1..1]
{
_1 "_1",
_2 "_2",
_3 "_3",
_4 "_4",
_5 "_5"
};

) expand;
End Metadata

And in the routing

Routing(Web)

Dim i

    q1loop.Categories.Order = OrderConstants.oCustom
    For i = 1 to 20   ' test 20 times
        q1loop.Categories.Filter = RanNotTogether(q1loop,{_3,_4,_5},Null)
        q1loop[..].q1.Response.Initial = {_1}
        q1loop.Ask()
    Next

'! Returns a category list of all categories in question.categories
where none of the categories in notTogether are next to one another
Caution should be taken to ensure that there is enough room to allow for
the notTogether codes to be separated by at least one other code
For example, a question with 9 items having 5 items that can't be together
is not possible.
ARGS:  question - question whose categories are used
notTogether - category list of categories that cannot appear together
seed - if not Null, then used as the random seed
RETURNS:  category list randomized so that none of the notTogether categories are next to each other
EXAMPLE:
q10loop.Categories.Order = OrderConstants.oCustom
q10loop.Categories.Filter = RanNotTogether,q10loop,{coke,pepsi,rccola},Null)
!'

Function RanNotTogether(question,notTogether,seed)
    Dim randomCodes,notTogetherCodes
    Dim randomCodeList,randomCode,codeCount
    Dim FinalArray[],strFilter

    ' Make array large enough for all categories
    ReDim(FinalArray,question.Categories.Count)

    ' Initialize array to blanks
    For codeCount = LBound(FinalArray) to UBound(FinalArray)
        FinalArray[codeCount] = ""
    Next

    ' Codes allowed to be together
    randomCodes = SelectRange(question.Categories - notTogether)

    ' Codes not allowed to be together
    notTogetherCodes = SelectRange(notTogether)

    codeCount = 0
    ' Place codes not allowed to be next to each other
    If ( seed is not null ) Then SetRandomSeed(seed)
    randomCodeList = ransequence(0,UBound(FinalArray),1)

    For Each randomCode in randomCodeList
        Select Case ( randomCode )
            Case 0 ' Can't have any to right
                If FinalArray[randomCode + 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
            Case UBound(FinalArray) ' Can't have any to left
                If FinalArray[randomCode - 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
            Case Else ' Can't have any to right or left
                If FinalArray[randomCode + 1] = "" And FinalArray[randomCode - 1] = "" Then
                    FinalArray[randomCode] = notTogetherCodes[codeCount]
                    codeCount = codeCount + 1
                End If
        End Select

        ' If placed all those that can't be together, then get out of loop
        if ( codeCount > UBound(notTogetherCodes) ) Then Exit For
    Next

    ' Add the remaining codes
    codeCount = 0
    For Each randomCode in randomCodeList
        ' If haven't used this position, then put in the next remaining code
        If FinalArray[randomCode] = "" Then
            FinalArray[randomCode] = randomCodes[codeCount]
            codeCount = codeCount + 1
        End If
    Next

    ' convert to a categorical list and return
    strFilter = ""
    For codeCount = LBound(FinalArray) to UBound(FinalArray)
        strFilter = strFilter + question.Categories[CCategorical(FinalArray[codeCount])].Name + ","
    Next
    RanNotTogether = CCategorical("{" + Left(strFilter,Len(strFilter)-1) + "}")
End Function

End Routing

Leave a Comment