Data commit

Task/Vogels-approximation-method/Tcl/vogels-approximation-method-1.tcl

@@ -0,0 +1,104 @@
+package require Tcl 8.6
+
+# A sort that works by sorting by an auxiliary key computed by a lambda term
+proc sortByFunction {list lambda} {
+    lmap k [lsort -index 1 [lmap k $list {
+	list $k [uplevel 1 [list apply $lambda $k]]
+    }]] {lindex $k 0}
+}
+
+# A simple way to pick a “best” item from a list
+proc minimax {list maxidx minidx} {
+    set max -Inf; set min Inf
+    foreach t $list {
+	if {[set m [lindex $t $maxidx]] > $max} {
+	    set best $t
+	    set max $m
+	    set min Inf
+	} elseif {$m == $max && [set m [lindex $t $minidx]] < $min} {
+	    set best $t
+	    set min $m
+	}
+    }
+    return $best
+}
+
+# The approximation engine. Note that this does not change the provided
+# arguments at all since they are copied on write.
+proc VAM {costs demand supply} {
+    # Initialise the sorted sequence of pairs and the result dictionary
+    foreach x [dict keys $demand] {
+	dict set g $x [sortByFunction [dict keys $supply] {g {
+	    upvar 1 costs costs x x; dict get $costs $g $x
+	}}]
+	dict set row $x 0
+    }
+    foreach x [dict keys $supply] {
+	dict set g $x [sortByFunction [dict keys $demand] {g {
+	    upvar 1 costs costs x x; dict get $costs $x $g
+	}}]
+	dict set res $x $row
+    }
+
+    # While there's work to do...
+    while {[dict size $g]} {
+	# Select "best" demand
+	lassign [minimax [lmap x [dict keys $demand] {
+	    if {![llength [set gx [dict get $g $x]]]} continue
+	    set z [dict get $costs [lindex $gx 0] $x]
+	    if {[llength $gx] > 1} {
+		list $x $z [expr {[dict get $costs [lindex $gx 1] $x] - $z}]
+	    } else {
+		list $x $z $z
+	    }
+	}] 2 1] d dVal dCost
+
+	# Select "best" supply
+	lassign [minimax [lmap x [dict keys $supply] {
+	    if {![llength [set gx [dict get $g $x]]]} continue
+	    set z [dict get $costs $x [lindex $gx 0]]
+	    if {[llength $gx] > 1} {
+		list $x $z [expr {[dict get $costs $x [lindex $gx 1]] - $z}]
+	    } else {
+		list $x $z $z
+	    }
+	}] 2 1] s sVal sCost
+
+	# Compute how much to transfer, and with which "best"
+	if {$sCost == $dCost ? $sVal > $dVal : $sCost < $dCost} {
+	    set s [lindex [dict get $g $d] 0]
+	} else {
+	    set d [lindex [dict get $g $s] 0]
+	}
+	set v [expr {min([dict get $supply $s], [dict get $demand $d])}]
+
+	# Transfer some supply to demand
+	dict update res $s inner {dict incr inner $d $v}
+	dict incr demand $d -$v
+	if {[dict get $demand $d] == 0} {
+	    dict for {k n} $supply {
+		if {$n != 0} {
+		    # Filter list in dictionary to remove element
+		    dict set g $k [lmap x [dict get $g $k] {
+			if {$x eq $d} continue; set x
+		    }]
+		}
+	    }
+	    dict unset g $d
+	    dict unset demand $d
+	}
+	dict incr supply $s -$v
+	if {[dict get $supply $s] == 0} {
+	    dict for {k n} $demand {
+		if {$n != 0} {
+		    dict set g $k [lmap x [dict get $g $k] {
+			if {$x eq $s} continue; set x
+		    }]
+		}
+	    }
+	    dict unset g $s
+	    dict unset supply $s
+	}
+    }
+    return $res
+}

Task/Vogels-approximation-method/Tcl/vogels-approximation-method-2.tcl

@@ -0,0 +1,21 @@
+set COSTS {
+    W {A 16 B 16 C 13 D 22 E 17}
+    X {A 14 B 14 C 13 D 19 E 15}
+    Y {A 19 B 19 C 20 D 23 E 50}
+    Z {A 50 B 12 C 50 D 15 E 11}
+}
+set DEMAND {A 30 B 20 C 70 D 30 E 60}
+set SUPPLY {W 50 X 60 Y 50 Z 50}
+
+set RES [VAM $COSTS $DEMAND $SUPPLY]
+
+puts \t[join [dict keys $DEMAND] \t]
+set cost 0
+foreach g [dict keys $SUPPLY] {
+    puts $g\t[join [lmap n [dict keys $DEMAND] {
+	set c [dict get $RES $g $n]
+	incr cost [expr {$c * [dict get $COSTS $g $n]}]
+	expr {$c ? $c : ""}
+    }] \t]
+}
+puts "\nTotal Cost = $cost"