Source code in the tcl programming language

proc orderDisjoint {theList theOrderList} {
    foreach item $theOrderList {incr n($item)}
    set is {}
    set i 0
    foreach item $theList {
	if {[info exist n($item)] && [incr n($item) -1] >= 0} {
	    lappend is $i
	}
	incr i
    }
    foreach item $theOrderList i $is {lset theList $i $item}
    return $theList
}


proc orderDisjoint {theList theOrderList} {
    foreach item $theOrderList {incr n($item)}
    set is -
    set i 0
    foreach item $theList {
	if {[info exist n($item)] && [incr n($item) -1] >= 0} {
	    lappend is $i
	}
	incr i
    }
    set i 0
    foreach item $theOrderList {
	if {[incr n($item)] <= 1} {
	    lset theList [lindex $is [incr i]] $item
	}
    }
    return $theList
}


foreach {items order} {
    "the cat sat on the mat" "mat cat"
    "the cat sat on the mat" "cat mat"
    "A B C A B C A B C"      "C A C A"
    "A B C A B D A B E"      "E A D A"
    "A B"                    "B"
    "A B"                    "B A"
    "A B B A"                "B A"
} {
    puts "'$items' with '$order' => '[orderDisjoint $items $order]'"
}