Dutch national flag problem

Revision 25 uploaded. A bug fixed in sorting a tuple with two items.


The Dutch national flag problem, introduced by Edsger W. Dijkstra. We have three colored type balls, one for each color from Dutch flag. We have to get a souffle of balls and then we have to make the minimum swaps to set the balls according to flag, Red then White then Blue balls.

The setup file of M2000 in the info.gsb file a Dutch module exist for fun. Here we will see the code, and how we can compute the changes before we did the swaps. We have a tuple which get a series of constant values, from an enumeration type named balls.

enum balls {Red, White, Blue}

We can set a variable with one of the three constants, say x=Red and we can read the name of constant using Eval$(x). The type of x is balls, so if we Print Type$(x) we get balls. The x value is not constant but if we place a number which didn't exist in the balls type then we get error. Red has value 1 by default. We can change this in the definition using Red=100 so the next one get 101 or we have to set the value using White=200 and so on.So the value of the constant can be used as a number. Internal is an object. So here we use arrays of one dimension which like all arrays in M2000 have a variant type and only the name add a restriction when we extract a value or place a value. A tuple has no name, so (White,) is one item tuple (look the comma after White), ot (,) is the empty tuple, or (Red, White) is a tuple with two values. We can fold other tuple as items of tuple. so ((1,2),(3,4)) is a tuple of two tuple. From tuple is easy to get a value, but we have to use a Return obj statement to return values to multiple indexes on a tuple. Or we can link a tuple to a name, an array name, so if variable a is a pointer to a tuple then a Link a to a() make a() the same array and we can strore and read values like in an array. We can't assign second time a  reference to a name (a Link is a reference), But we can make temporary names in a For obj { } block, so we can make for sort period a name as a reference and we can use this block several times to link different tuples. An array with a name with parenthesis has the same object at the bottom as the tuple, but used as a different interface. So a A()=B() make a shallow copy of B() to A(), but a pointer of a tuple just copy the pointer. Also another difference is that a pointer to an array use the array as one dimension, from 0. Arrays with names and parenthesis may have up to 10 dimension and we can set the lower an upper limit (negatives included). So let see what we have here in the Dutch National Flag Problem

We can make some lambda functions. These functions also may have closures. Here in fillarray we place a as a pointer to a tuple with three constants. Using another lambda inside the fillarray, we pass the a as closure so each time we use randomitem we get one value at random fro there. To finish it quickly we make an array a(size) using the << operator which execute the right function for each item. So we make the random array of size size, and then we place it as the return value, using = as a statement (get blue color when it is a statement, the M2000 editor is smart enough to know when this symbol isn't an operator but a statement).

fillarray=lambda a=(Red, White, Blue) (size as long=10)-> {
    if size<1 then size=1
    randomitem=lambda a->a#val(random(0,2))
    dim a(size)<<randomitem()
    =a()
}

We want to display an array so we make another lambda function: The $ symbol used every time we need a name to return a string value. So this function is a string function. We can use a normal function, but for fun we make it a lambda function. See that we check if a is an array. We can through the check, but sometimes is good to catch errors. The if then/end if is a variant of if  then { } structure. The for loop in m2000 always execute at least one time. The direction can be change if the last value is lower than the first one

Display$=lambda$ (s as array) ->{
    Document r$=eval$(array(s))
    if len(s)>1 then

    For i=1 to len(s)-1 {
        r$=", "+eval$(array(s,i))

    }
    end if
    =r$
}

We use a document object. This is like a string, when we use in string expressions. But we can use specific statements with this for some document tasks. Inside document object each paragraph is a separate string. So appending a string has no big cost.  The = operator works like append. To clear a document we use Clear statement. We see in above code that we use array(s, i) to get value from s at index i, the same can be done using s#val(i).

We need to check if an array is sorted or not so we make another function, which return a string. Also it is a lambda function, for fun. We use two times the return of a value. In a function the return statement = is optional (so we return 0 or empty string according the name of the function), and we can feed it more than one (replacing the last one). To exit from a function, we have to execute until the end of block, or exit from block. Here we use break, which breaks all blocks until the function block. We get a value, then we start a loop to check each k if x>k, to break it. A for loop in M2000 always execute one time (or half if a break or exit happen). If we place one item array we get an error, because we have to use two items. A test for one item has no meaning. A statement: if len(s)<1 then error "not used here"  can be used here but a function has to call with the right parameters, so the caller is responsible to make the right call.

TestSort$=lambda$ (s as array)-> {
    ="unsorted: "
    x=array(s)
    for i=1 to len(s)-1 {
        k=array(s,i)
        if x>k then break
        swap x, k
    }
    ="sorted: "
}

So now we need another function to get an array of the final position from the unsorted array. If a three item array (three balls for this context) was sorted before entering the Positions() function we get (0, 1, 2) where we read the 0 final position need to get from 0 (no swap), we read the 1 final position need to get from 1 and the final third ball is the third from original. So we have no swaps.

We use a stack object (has a collection deep inside), which we use no keys. We can easy adding to both ends (we say the top and the bottom). The basic idea to extract the positions has two values low and high, so at the end these separate the balls, to chunks. The function has to work when one or two kinds of balls just non included. When we found the ball for middle zone on flag,  we place it at the bottom of the stack using Data. When the loop ends, we have to get the items on stack converted to array. So c()=array(medpos) where medpos is a stack,  is an array with all the balls for middle color, the White. There is a function array() and for a parameter a pointer to a stack object move the items to an array, and empty the stack. Also we use a Stock statement to copy an array to another array, from two indexes and for a number of items.

So the function Positions return an array of Positions, from where we get an item. So if in index=0 we have a 5 that means that for a destination array in index 0 we copy the item from index 5 from the source array.

Positions=lambda mid=White (a as array) ->{
    m=len(a)
    dim Base 0, b(m)=-1
    low=-1
    high=m
    m--
    i=0
    medpos=stack
    link a to a()
    for i=m to 0 {
        if a(i)<=mid then exit
        high--
        b(high)=high
    }
    for i=0 to m {
        if a(i)>=mid then exit
        low++
        b(low)=low
    }
    if high-low>1 then
    for i=low+1 to high-1 {
        select case a(i)<=>Mid
        case -1
            low++ : b(low)=i
        case 1
        {
            high-- :b(high)=i
            if High<i then swap b(high), b(i)
        }
        else case
            stack medpos {data i}
        end select
    }
    end if
    if Len(medpos)>0 then
    dim c()
    c()=array(medpos)
    stock c(0) keep len(c()), b(low+1)
    for i=low+1 to high-1
           if b(i)>low and b(i)<high and b(i)<>i then swap b(b(i)), b(i)    
    next i
    end if
    if low>0  then
        for i=0 to low
            if b(i)<=low and b(i)<>i then swap b(b(i)), b(i)
        next 
    end if
    if High<m then
        for i=m to High
            if b(i)>=High and b(i)<>i then swap b(b(i)), b(i)
        next 
    end if
    =b()
}

So we can make a new array for flags just using the positions. One easy way is to copy the source array to destination and then scan the positions where index <> value, because if index=value that means that the item stay to the same position for source and destination arrays.

Another way is to make the changes in place. And that is the goal of this program.

To do that we need another function, the InPlace function. Here we place two arrays by reference. the position and the Final() which is the source and the destination array. When we have a position equal to index then we skip that. But when we have a position to place we have the information of the source item, so we keep the first item in z and place all the items until we find the same index again as position to copy and here we finish the inner swap multi action. Maybe there are more than one or no one inner swap actions. The InPlace function also return the counting of swaps

InPlace=Lambda (&p(), &Final()) ->{
    def i=0, j=-1, k=-1, many=0
    for i=0 to len(p())-1
        if p(i)<>i then
            j=i
            z=final(j)
            do
                final(j)=final(p(j))
                k=j
                j=p(j)
                p(k)=k
                many++
            until j=i
            final(k)=z
        end if
    next
    =many
}

This is the final program (as in Dutch module, in info.gsb, included file in M2000 setup, from revision 25, version 9.9):
Added the Three Way Partition from https://en.wikipedia.org/wiki/Dutch_national_flag_problem
Sometimes is better than the first algorithm. If the array is already sortec the first algorithm make no swaps. The second make a lot of swaps.

Report "Dutch Flag from Dijkstra"
const center=2
enum balls {Red, White, Blue}
fillarray=lambda a=(Red, White, Blue) (size as long=10)-> {
    if size<1 then size=1
    randomitem=lambda a->a#val(random(0,2))
    dim a(size)<<randomitem()
    =a()
}
Display$=lambda$ (s as array) ->{
    Document r$=eval$(array(s))
    if len(s)>1 then
    For i=1 to len(s)-1 {
        r$=", "+eval$(array(s,i))
    }
    end if
    =r$
}
TestSort$=lambda$ (s as array)-> {
    ="unsorted: "
    x=array(s)
    for i=1 to len(s)-1 {
        k=array(s,i)
        if x>k then break
        swap x, k
    }
    ="sorted: "
}
Positions=lambda mid=White (a as array) ->{
    m=len(a)
    dim Base 0, b(m)=-1
    low=-1
    high=m
    m--
    i=0
    medpos=stack
    link a to a()
    for i=m to 0 {
        if a(i)<=mid then exit
        high--
        b(high)=high
    }
    for i=0 to m {
        if a(i)>=mid then exit
        low++
        b(low)=low
    }
    if high-low>1 then
    for i=low+1 to high-1 {
        select case a(i)<=>Mid
        case -1
            low++ : b(low)=i
        case 1
        {
            high-- :b(high)=i
            if High<i then swap b(high), b(i)
        }
        else case
            stack medpos {data i}
        end select
    }
    end if
    if Len(medpos)>0 then
    dim c()
    c()=array(medpos)
    stock c(0) keep len(c()), b(low+1)
    for i=low+1 to high-1
           if b(i)>low and b(i)<high and b(i)<>i then swap b(b(i)), b(i)    
    next i
    end if
    if low>0  then
        for i=0 to low
            if b(i)<=low and b(i)<>i then swap b(b(i)), b(i)
        next 
    end if
    if High<m then
        for i=m to High
            if b(i)>=High and b(i)<>i then swap b(b(i)), b(i)
        next 
    end if
    =b()
}
InPlace=Lambda (&p(), &Final()) ->{
    def i=0, j=-1, k=-1, many=0
    for i=0 to len(p())-1
        if p(i)<>i then
            j=i
            z=final(j)
            do
                final(j)=final(p(j))
                k=j
                j=p(j)
                p(k)=k
                many++
            until j=i
            final(k)=z
        end if
    next
    =many
}


Dim final(), p(), second(), p1()
Rem final()=(White,Red,Blue,White,Red, Red, Blue)
Rem final()=(white, blue, red, blue, white)


final()=fillarray(30)
Print "Items: ";len(final())
Report TestSort$(final())+Display$(final())
\\ backup for final() for second example
second()=final()
p()=positions(final())
\\ backup p() to p1() for second example
p1()=p()




Report Center,  "InPlace"
rem Print p()   ' show array items
many=InPlace(&p(), &final())
rem print p()  ' show array items
Report TestSort$(final())+Display$(final())
print "changes: "; many


Report Center, "Using another array to make the changes"
final()=second()
\\ using a second array to place only the changes
item=each(p1())
many=0
While item {
    if item^=array(item) else final(item^)=second(array(item)) : many++
}
Report TestSort$(final())+Display$(final())
print "changes: "; many

Module three_way_partition (A as array, mid as balls, &swaps) {
    Def i, j, k
    k=Len(A)
    Link A to A()
    While j < k
        if A(j) < mid Then
            Swap A(i), A(j)
            swaps++
            i++
            j++
        Else.if A(j) > mid Then
            k--
            Swap A(j), A(k)
            swaps++
        Else
            j++
        End if
    End While
}
Many=0
Z=second()
Print
Report center, {Three Way Partition
}
Report TestSort$(Z)+Display$(Z)
three_way_partition Z, White, &many
Print
Report TestSort$(Z)+Display$(Z)
Print "changes: "; many