Source code in the m2000 programming language

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)<
    =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
        }
        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)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
        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