Artifact
31297e616b65adb6d26f0b1b9c0267ba18618cc3:
Attachment "linalgTest.tcl" to
ticket [1784637fff]
added by
bwallner
2007-08-30 14:56:12.
#source linalg.tcl ;# 1.0
#source linalg.tcl ;# 1.0.1
puts [package require math::linearalgebra]
namespace import ::math::linearalgebra::*
set anzG 9
set anzU 4
set p { 1 1 1 1 1 1 1 1 1 }
set A { \
{ 0.91 -0.41 0 0 } \
{ 0.5 -0.86 0 0 } \
{-0.96 -0.29 0 0 } \
{-0.95 0.31 0 0 } \
{ 0 0 0.92 0.4 } \
{ 0 0 0.96 -0.28} \
{ 0 0 -0.72 0.7 } \
{ 0 0 -0.45 0.89} \
{-0.23 -0.97 0.23 0.97} \
}
set l { 0.8 0 0 0.4 0 -0.7 0.6 0 -1.2 }
puts l:\n[show $l]\n
puts p:\n[show $p]\n
puts A:\n[show $A]\n
set P [mkDiagonal $p]
puts P:\n[show $P]\n
set AT [transpose $A]
puts "\[transpose \$A\]:\n[show $AT]\n"
set N [matmul [matmul $AT $P] $A]
puts N:\n[show $N]\n
set n [matmul [matmul $AT $P] $l]
puts "\[matmul \[matmul \$AT \$P\] \$l\]:\n[show $n]\n"
# if matrix is singular
set Q [solveGauss $N [mkIdentity $::anzU]]
puts Q:\n[show $Q]\n
#if { [catch {solveGauss $N [mkIdentity $::anzU]} Q] } {
# return 1
#}
set x [matmul $Q $n]
puts x:\n[show $x]\n
set v [sub [matmul $A $x] $l]
puts v:\n[show $v]\n
puts "\[transpose \$v\]:\n[show [transpose $v]]\n"
puts "\[matmul \[transpose \$v\] \$P\]\]:\n[show [matmul [transpose $v] $P]]"
puts "pvv:\n[show [matmul [matmul [transpose $v] $P] $v]]"
set pvv [matmul [matmul [transpose $v] $P] $v]
exit
set m0 0.1
if { ($anzG - $::anzU) > 0 } {
set m0 [expr {sqrt( $pvv/($anzG - $::anzU))}]
}
# Fehler der Unbekannten
set i 0
puts QXX:[show [mkDiagonal $Q]]
foreach QXX [mkDiagonal $Q] {
if { $QXX < 0 } {
set QXX 0
}
set qxx($i) [expr {$m0 * sqrt($QXX)}]
incr i
}
puts "x: $x"
puts "v: $v"
puts "pvv: $pvv"
puts "QXX: $QXX"
