Tk Library Source Code

Artifact 3396b991f964f1dfeede0eba16b39b993dc2ea3d:

Attachment "tcllib-1.10.patch" to ticket [1852519fff] added by mezis 2007-12-17 23:40:30.

---

--- tcllib-1.10/modules/math/linalg.tcl.orig	2007-12-17 15:40:14.000000000 +0100
+++ tcllib-1.10/modules/math/linalg.tcl	2007-12-17 17:21:02.000000000 +0100
@@ -1472,7 +1472,7 @@
     #
     set h {}
     set i 0
-    foreach row $matrix {
+    foreach row $A {
         set aii [lindex $row $i]
         set sum [expr {2.0*abs($aii) - [norm_one $row]}]
         incr i
@@ -1481,45 +1481,47 @@
             set h $sum
         }
     }
-    if { $h <= $eps } {
-        set h [expr {$h - sqrt($eps)}]
+    if { $h <= $epsilon } {
+        set h [expr {$h - sqrt($epsilon)}]
         # try to make smallest eigenvalue positive and not too small
-        set A [sub $A [mkIdentity $m $h]]
+        set A [sub $A [scale_mat $h [mkIdentity $m]]]
     } else {
         set h 0.0
     }
 
     #
     # Determine the SVD decomposition: this holds the
     # eigenvectors and eigenvalues
     #
-    foreach {U S V} [determineSVD $A $eps] {break}
+    foreach {U S V} [determineSVD $A $epsilon] {break}
 
     #
     # Rescale and flip signs if all negative or zero
     #
-    set evals {}
     for {set j 0} {$j < $n} {incr j} {
         set s 0.0
         set notpositive 0
         for {set i 0} {$i < $n} {incr i} {
-            set Aij [lindex $A $i $j]
-            if { $Aij <= 0.0 } {
+            set Uij [lindex $U $i $j]
+            if { $Uij <= 0.0 } {
                incr notpositive
             }
-            set s [expr {$s + $Aij*$Aij}]
+            set s [expr {$s + $Uij*$Uij}]
         }
         set s [expr {sqrt($s)}]
         if { $notpositive == $n } {
-            set sf [expr {0.0-$s}]
+            set sf [expr {-$s}]
         } else {
             set sf $s
         }
-        set colv [getcol $A $j]
-        setcol A [scale [expr {1.0/$sf}] $colv]
-        lappend evals [expr {$s+$h}]
+        set colv [getcol $U $j]
+        setcol U $j [scale_vect [expr {1.0/$sf}] $colv]
+    }
+    for {set j 0} {$j < $n} {incr j} {
+      lset S $j [expr {[lindex $S $j] + $h}]
     }
-    return [list $A $evals]
+    return [list $U $S]
 }
 
 # leastSquaresSVD --