Data commit

Task/LU-decomposition/Tcl/lu-decomposition-1.tcl

@@ -0,0 +1,68 @@
+package require Tcl 8.5
+namespace eval matrix {
+    namespace path {::tcl::mathfunc ::tcl::mathop}
+
+    # Construct an identity matrix of the given size
+    proc identity {order} {
+	set m [lrepeat $order [lrepeat $order 0]]
+	for {set i 0} {$i < $order} {incr i} {
+	    lset m $i $i 1
+	}
+	return $m
+    }
+
+    # Produce the pivot matrix for a given matrix
+    proc pivotize {matrix} {
+	set n [llength $matrix]
+	set p [identity $n]
+	for {set j 0} {$j < $n} {incr j} {
+	    set max [lindex $matrix $j $j]
+	    set row $j
+	    for {set i $j} {$i < $n} {incr i} {
+		if {[lindex $matrix $i $j] > $max} {
+		    set max [lindex $matrix $i $j]
+		    set row $i
+		}
+	    }
+	    if {$j != $row} {
+		# Row swap inlined; too trivial to have separate procedure
+		set tmp [lindex $p $j]
+		lset p $j [lindex $p $row]
+		lset p $row $tmp
+	    }
+	}
+	return $p
+    }
+
+    # Decompose a square matrix A by PA=LU and return L, U and P
+    proc luDecompose {A} {
+	set n [llength $A]
+	set L [lrepeat $n [lrepeat $n 0]]
+	set U $L
+	set P [pivotize $A]
+	set A [multiply $P $A]
+
+	for {set j 0} {$j < $n} {incr j} {
+	    lset L $j $j 1
+	    for {set i 0} {$i <= $j} {incr i} {
+		lset U $i $j [- [lindex $A $i $j] [SumMul $L $U $i $j $i]]
+	    }
+	    for {set i $j} {$i < $n} {incr i} {
+		set sum [SumMul $L $U $i $j $j]
+		lset L $i $j [/ [- [lindex $A $i $j] $sum] [lindex $U $j $j]]
+	    }
+	}
+
+	return [list $L $U $P]
+    }
+
+    # Helper that makes inner loop nicer; multiplies column and row,
+    # possibly partially...
+    proc SumMul {A B i j kmax} {
+	set s 0.0
+	for {set k 0} {$k < $kmax} {incr k} {
+	    set s [+ $s [* [lindex $A $i $k] [lindex $B $k $j]]]
+	}
+	return $s
+    }
+}

Task/LU-decomposition/Tcl/lu-decomposition-2.tcl

@@ -0,0 +1,49 @@
+# Code adapted from Matrix_multiplication and Matrix_transposition tasks
+namespace eval matrix {
+    # Get the size of a matrix; assumes that all rows are the same length, which
+    # is a basic well-formed-ness condition...
+    proc size {m} {
+	set rows [llength $m]
+	set cols [llength [lindex $m 0]]
+	return [list $rows $cols]
+    }
+
+    # Matrix multiplication implementation
+    proc multiply {a b} {
+	lassign [size $a] a_rows a_cols
+	lassign [size $b] b_rows b_cols
+	if {$a_cols != $b_rows} {
+	    error "incompatible sizes: a($a_rows, $a_cols), b($b_rows, $b_cols)"
+	}
+	set temp [lrepeat $a_rows [lrepeat $b_cols 0]]
+	for {set i 0} {$i < $a_rows} {incr i} {
+	    for {set j 0} {$j < $b_cols} {incr j} {
+		lset temp $i $j [SumMul $a $b $i $j $a_cols]
+	    }
+	}
+	return $temp
+    }
+
+    # Pretty printer for matrices
+    proc print {matrix {fmt "%g"}} {
+	set max [Widest $matrix $fmt]
+	lassign [size $matrix] rows cols
+	foreach row $matrix {
+	    foreach val $row width $max {
+		puts -nonewline [format "%*s " $width [format $fmt $val]]
+	    }
+	    puts ""
+	}
+    }
+    proc Widest {m fmt} {
+	lassign [size $m] rows cols
+	set max [lrepeat $cols 0]
+	foreach row $m {
+	    for {set j 0} {$j < $cols} {incr j} {
+		set s [format $fmt [lindex $row $j]]
+		lset max $j [max [lindex $max $j] [string length $s]]
+	    }
+	}
+	return $max
+    }
+}

Task/LU-decomposition/Tcl/lu-decomposition-3.tcl

@@ -0,0 +1,13 @@
+# This does the decomposition and prints it out nicely
+proc demo {A} {
+    lassign [matrix::luDecompose $A] L U P
+    foreach v {A L U P} {
+	upvar 0 $v matrix
+	puts "${v}:"
+	matrix::print $matrix %.5g
+	if {$v ne "P"} {puts "---------------------------------"}
+    }
+}
+demo {{1 3 5} {2 4 7} {1 1 0}}
+puts "================================="
+demo {{11 9 24 2} {1 5 2 6} {3 17 18 1} {2 5 7 1}}