# Part of the Hume La package
# (C)Copyright 2001, Hume Integration Services

source la.tcl
catch { namespace import La::*}

if { [info commands dim] == {} } {
  puts "Cannot find La package procedures like dim"
  return
  }

if {[string compare test [info procs test]] == 1} then \
  {source defs}

test mathprec {compute precision of math calculations} {
   set eps [mathprec]
   expr $eps + 1 > 1
} {1}

test dim-1 {various good args} {
    set list {}
    foreach arg { {} {2.3} {2 1 0 2.3} {2 2 2 1.1 1.2 1.3 1.4} {3 1 1 1 1}} {
        lappend list [dim $arg]
        }
    set list
} {{} 0 1 2 3}

test dim-2 {bad vector arg} {
    catch {dim {2 0 3 1 2 3}} txt
    set txt
} {improper length of matrix}

test dim-3 {bad scalar arg} {
    catch {dim {2 0 0 3.14}} txt
    set txt
} {improper length of vector}

test dim-4 {bad vector arg} {
    catch {dim {2 3 0 1 2 3 4}} txt
    set txt
} {improper length of vector}

test dim-5 {overlong matrix arg} {
    catch {dim {2 3 1 1 2 3 4}} txt
    set txt
} {improper length of matrix}

test dim-6 {short matrix arg} {
    catch {dim {2 3 1 1 2}} txt
    set txt
} {improper length of matrix}

test dim-7 {incomplete vector/matrix} {
    catch {dim {2 1}} txt
    set txt
} {improper La operand format}

test dim-8 {wrong type arg} {
    catch {dim {hello world}} txt
    set txt
} {improper La operand format}

test dim-9 {wrong type arg} {
    catch {dim {hello}} txt
    set txt
} {improper La operand format}

test dotprod-1 {vxv good} {
    dotprod {2 3 0 1 2 3} {2 3 0 1 2 3}
} {14.0}

test dotprod-2 {v x v bad} {
    catch {dotprod {2 3 0 1 2 3} {2 4 0 1 2 3 4}} txt
    set txt
} {Assumed length does not seem proper.}

test dotprod-3 {v x Nx1 good} {
    dotprod {2 3 0 1 2 3} {2 3 1 1 2 3}
} {14.0}

test dotprod-4 {v x 1XN good} {
    dotprod {2 3 0 1 2 3} {2 1 3 1 2 3}
} {14.0}

test dotprod-5 {1xN x Nx1 good} {
    dotprod {2 1 3 1 2 3} {2 3 1 1 2 3}
} {14.0}

test dotprod-6 {1xN x v good} {
    dotprod {2 1 3 1 2 3} {2 3 0 1 2 3}
} {14.0}

test dotprod-7 {1xN x 1xN good} {
    dotprod {2 1 3 1 2 3} {2 1 3 1 2 3}
} {14.0}
test dotprod-8 {Nx1 x v good} {
    dotprod {2 3 1 1 2 3} {2 3 0 1 2 3}
} {14.0}
test dotprod-9 {Nx1 x 1xN good} {
    dotprod {2 3 1 1 2 3} {2 1 3 1 2 3}
} {14.0}
test dotprod-10 {Nx1 x Nx1 good} {
    dotprod {2 3 1 1 2 3} {2 3 1 1 2 3}
} {14.0}

test dotprod-11 {Nx1 x NxN good} {
    dotprod {2 3 1 1 2 3} {2 3 3 1 2 3 4 5 6 7 8 9}
} {14.0}

test dotprod-12 {Nx1 x NxN good, 2nd row} {
    dotprod {2 3 1 1 2 3} {2 3 3 1 2 3 0 1 0 7 8 9} 3 3 6
} {2.0}

test dotprod-13 {Nx1 x NxN good, 2nd col} {
    dotprod {2 3 1 1 2 3} {2 3 3 1 2 3 0 1 0 7 8 9} 3 3 4 1 3
} {28.0}

test join_cols-1 {v v good} {
    join_cols {2 3 0 1 2 3} {2 3 0 1.1 2.2 3.3}
} {2 3 2 1 1.1 2 2.2 3 3.3}

test join_cols-2 {v v bad} {
    catch {join_cols {2 3 0 1 2 3} {2 4 0 1.1 2.2 3.3 4.4}} txt
    set txt 
} {cannot append columns with inequal rows A[3,] + B[4,]}

test join_cols-3 {m v good} {
    join_cols {2 3 3 1 2 3 4 5 6 7 8 9} {2 3 0 1.1 2.2 3.3}
} {2 3 4 1 2 3 1.1 4 5 6 2.2 7 8 9 3.3}

test join_cols-4 {v m good} {
    join_cols {2 3 0 1.1 2.2 3.3} {2 3 3 1 2 3 4 5 6 7 8 9} 
} {2 3 4 1.1 1 2 3 2.2 4 5 6 3.3 7 8 9}

test join_cols-3 {m m good} {
    join_cols {2 3 3 1 2 3 4 5 6 7 8 9} {2 3 3 1 2 3 4 5 6 7 8 9}
} {2 3 6 1 2 3 1 2 3 4 5 6 4 5 6 7 8 9 7 8 9}

test join_rows-1 {v v equal} {
    join_rows {2 3 0 1 2 3} {2 3 0 1.1 2.2 3.3}
} {2 6 1 1 2 3 1.1 2.2 3.3}

test join_rows-2 {v v not equal} {
   catch {join_rows {2 3 0 1 2 3} {2 2 0 1.1 2.2}} txt
    set txt 
} {2 5 1 1 2 3 1.1 2.2}

test join_rows-3 {m v bad} {
    catch {join_rows {2 3 3 1 2 3 4 5 6 7 8 9} {2 3 0 1.1 2.2 3.3}} txt
    set txt
} {cannot append rows with inequal columns A[,3] + B[,1]}

test join_rows-4 {m v good} {
    catch {join_rows {2 3 3 1 2 3 4 5 6 7 8 9} [transpose {2 3 0 1.1 2.2 3.3}]} txt
    set txt
} {2 4 3 1 2 3 4 5 6 7 8 9 1.1 2.2 3.3}

test join_rows-5 {v m good} {
    join_rows [transpose {2 3 0 1.1 2.2 3.3}] {2 3 3 1 2 3 4 5 6 7 8 9} 
} {2 4 3 1.1 2.2 3.3 1 2 3 4 5 6 7 8 9}

test join_cols-6 {m m good} {
    join_rows {2 3 3 1 2 3 4 5 6 7 8 9} {2 3 3 1 2 3 4 5 6 7 8 9}
} {2 6 3 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9}

test lassign_br-1 {good} {
    set a {1 2 3}
    lassign_br a 1 2.2
    set a
} {1 2.2 3}

test lassign_br-2 {out-of-range} {
    set a {1 2 3}
    catch {lassign_br a 3 2.2} txt
    set txt
} {list doesn't contain element 3}

test madd-1 {matrix add} {
    set a {2 2 2 1 2 3 4}
    madd $a $a
} {2 2 2 2 4 6 8}

test madd-2 {matrix add} {
    set a {2 2 2 1 2 3 4}
    catch {madd $a {2 1 1 2}} txt
    set txt
} {arguments are not conformable A[2,2] vs B[1,1]}

test mcols-1 {col count} {
    mcols {2 1 3 1 2 3}
} {3}


test mdiag-1 {v} {
    mdiag {2 3 0 1 2 3}
} {2 3 3 1 0 0 0 2 0 0 0 3}

test mdiag-2 {1xN} {
    mdiag {2 1 3 1 2 3}
} {2 3 3 1 0 0 0 2 0 0 0 3}

test mdiag-3 {Nx1} {
    mdiag {2 3 1 1 2 3}
} {2 3 3 1 0 0 0 2 0 0 0 3}


test mevsvd-1 {evals of hilbert matrix} {
   global mevect
   set mevect [mhilbert 4]
   mevsvd_br mevect evals
   set txt evals=\n[show $evals %.6g]\n
   append txt vects=\n[show $mevect %.6g]
   set txt
} {evals=
1.50021 0.169141 0.00673827 9.67023e-005
vects=
0.792608 -0.582076 0.179186 -0.0291933
0.451923 0.370502 -0.741918 0.328712
0.322416 0.509579 0.100228 -0.791411
0.252161 0.514048 0.638283 0.514553}

test mevsvd-2 {evect test} {
    global mevect
    set m [mmult [transpose $mevect] $mevect]
    show [mround $m]
} {1.0 0.0 0.0 0.0
0.0 1.0 0.0 0.0
0.0 0.0 1.0 0.0
0.0 0.0 0.0 1.0}


test mident-1 {1} {
   mident 1
} {2 1 1 1}

test mident-2 {3} {
   mident 3
} {2 3 3 1 0 0 0 1 0 0 0 1}

test mident-3 {3.5} {
   catch {mident 3.5} txt
   set txt
} {improper size "3.5"}

test mlssvd {Nash data} {
  set A {2 13 5 \
 1  563 262 461 221\
 1  658 291 473 222\
 1  676 294 513 221\
 1  749 302 516 218\
 1  834 320 540 217\
 1  973 350 596 218\
 1 1079 386 650 218\
 1 1151 401 676 225\
 1 1324 446 769 228\
 1 1499 492 870 230\
 1 1690 510 907 237\
 1 1735 534 932 235\
 1 1778 559 956 236}
    set y {2 13 0\
 305 342 331 339 354 369 378 368 405 438 438 451 485}
    set x [mlssvd $A $y 0.0 {}]
 show $x %.6f
} {207.782626 -0.046192 1.019387 -0.159823 -0.290376}

test mmult-1 {good} {
    set id3 [mident 3]
    mmult $id3 $id3
} {2 3 3 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0}

test mmult-2 {good} {
    set id3 [mident 3]
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    mmult $id3 $m
} {2 3 3 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0}

test mmult-3 {good} {
    set id3 [mident 3]
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    mmult $m $id3
} {2 3 3 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0}

test mmult-4 {m v good} {
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    mmult $m {2 3 0 1 2 3}
} {2 3 1 14.0 32.0 50.0}

test mmult-5 {m v mismatch} {
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    catch {mmult $m {2 4 0 1 2 3 4}} txt
    set txt
} {matrices are not conformable A[3,3] x B[4,1]}

test mmult-6 {v m mismatch} {
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    catch {mmult {2 3 0 1 2 3} $m} txt
    set txt
} {matrices are not conformable A[3,1] x B[3,3]}

test mmult-7 {vt m match} {
    set m {2 3 3 1 2 3 4 5 6 7 8 9}
    catch {mmult [transpose {2 3 0 1 2 3}] $m} txt
    set txt
} {2 1 3 30.0 36.0 42.0}

test mnorms-1 {id3} {
    show [mnorms [mident 3]] %6.4f
} {0.3333 0.3333 0.3333
0.5774 0.5774 0.5774}

test mnorms-2 {3x3 mat} {
    show [mnorms {2 3 3 1 2 3 4 5 6 7 8 9}] %6.4f
} {4.0000 5.0000 6.0000
3.0000 3.0000 3.0000}

test mnorms-3 {2x2 mat} {
    show [mnorms {2 2 2 1 2 1 2}] %6.4f
} {1.0000 2.0000
0.0000 0.0000}

test mnorms-4 {4x2 mat} {
    show [mnorms {2 4 2 1 2 -1 -2 3 5 -5 -3}] %6.4f
} {-0.5000 0.5000
3.4157 3.6968}

test mnormalize-1 {4x2 mat} {
    set m {2 4 2 1 2 -1 -2 3 5 -5 -3}
    mnorms_br m means sigmas
    show [mnormalize $m $means $sigmas] %6.4f
} {0.4392 0.4058
-0.1464 -0.6763
1.0247 1.2173
-1.3175 -0.9468}

test mrange-1 {3x3 mat} {
   set m {2 3 3 1 2 3 4 5 6 7 8 9}
   mrange $m 0 1
} {2 3 2 1 2 4 5 7 8}

test mrange-2 {3x3 mat} {
   set m {2 3 3 1 2 3 4 5 6 7 8 9}
   mrange $m 2 2
} {2 3 1 3 6 9}

test mrange-3 {3x3 mat index err} {
   set m {2 3 3 1 2 3 4 5 6 7 8 9}
   catch {mrange $m 3 3} txt
   set txt 
} {column index 3 > 2}

test mrows-1 {row count} {
  mrows {2 1 3 1 2 3}
} {1}

test msolve-1 {inverse of hilbert matrix} {
   global mevect
   set mevect [mhilbert 4]
   set mevect [msolve $mevect [mident 4]]
   show $mevect
} {16.0 -120.0 240.0 -140.0
-120.0 1200.0 -2700.0 1680.0
240.0 -2700.0 6480.0 -4200.0
-140.0 1680.0 -4200.0 2800.0}

test msolve-2 {minv test} {
    global mevect
    set m [mmult [transpose [mhilbert 4]] $mevect]
    show [mround $m]
} {1.0 0.0 0.0 0.0
0.0 1.0 0.0 0.0
0.0 0.0 1.0 0.0
0.0 0.0 0.0 1.0}

test moffset-1 {add const} {
   set m {2 3 2 1 2 3 4 5 6}
   moffset $m 0
} {2 3 2 1 2 3 4 5 6}

test moffset-2 {add const} {
   set m {2 3 2 1 2 3 4 5 6}
   moffset $m 0.1
} {2 3 2 1.1 2.1 3.1 4.1 5.1 6.1}

test mscale-1 {mult const} {
   set m {2 3 2 1 2 3 4 5 6}
   mscale $m 0.1
} {2 3 2 0.1 0.2 0.3 0.4 0.5 0.6}

test madjust-1 {mult const} {
   set m {2 3 2 1 2 3 4 5 6}
   madjust $m 2.0 0.1
} {2 3 2 2.1 4.1 6.1 8.1 10.1 12.1}

test msum-1 {reduce vector} {
    msum {2 3 0 1 2 3}
} {6.0}

test msum-2 {reduce matrix cols} {
    msum {2 3 3 1 2 3 4 5 6 7 8 9}
} {2 3 0 12.0 15.0 18.0}

test msum-3 {reduce matrix to scalar} {
    msum [msum {2 3 3 1 2 3 4 5 6 7 8 9}]
} {45.0}

test promote-1 {scalar} {
    promote 3.1415
} {2 1 1 3.1415}

test promote-2 {vector} {
    promote {2 2 0 1 2}
} {2 2 1 1 2}

test promote-3 {matrix} {
    promote {2 2 1 1 2}
} {2 2 1 1 2}

test promote-4 {3-D} {
    promote {3 1 1 1 3.14}
} {3 1 1 1 3.14}

test demote-1 scalar {
   demote 3.14
} {3.14}

test demote-2 {vector 1} {
    demote {2 1 0 3.14}
} {3.14}

test demote-3 {vector 2} {
    demote {2 2 0 1 2}
} {2 2 0 1 2}

test demote-4 {matrix Nx1} {
   demote {2 3 1 1 2 3}
} {2 3 0 1 2 3}

test demote-5 {matrix 1xN} {
   demote {2 1 3 1 2 3}
} {2 3 0 1 2 3}

test demote-6 {garbarge} {
   catch {demote {garbage in garbage out}} txt
   set txt
} {improper La operand format}

test show-1 {optional separators} {
   set m {2 2 3 1 2 3 4 5 6}
   show $m {} , \;
} {1,2,3;4,5,6}

test show-2 {optional separators, non default format} {
   set m {2 2 3 1 2 3 4 5 6}
   show $m %g , \;
} {1,2,3;4,5,6}

test show-3 {optional separators, non-default format} {
   set m {2 2 3 1 2 3 4 5 6}
   show $m %.1f , \;
} {1.0,2.0,3.0;4.0,5.0,6.0}

test show-4 {optional separators} {
   set v {2 3 0 1 2 3}
   show $v {} , 
} {1,2,3}

test show-5 {optional separators, non default format} {
   set v {2 3 0 1 2 3}
   show $v %g , 
} {1,2,3}

test show-6 {optional separators, non default format} {
   set v {2 3 0 1 2 3}
   show $v %.1f , 
} {1.0,2.0,3.0}

test transpose-1 vector {
   transpose {2 3 0 1 2 3}
} {2 1 3 1 2 3}

test transpose-2 {nxm mat} {
  transpose {2 3 2 1 2 3 4 5 6}
} {2 2 3 1 3 5 2 4 6}

test vdiag-1 {diag of matrix} {
   set m {2 3 3 1 2 3 4 5 6 7 8 9}
   vdiag $m
} {2 3 0 1 5 9}

test vdiag-2 {diag of matrix} {
   set m {2 2 3 1 2 3 4 5 6}
   vdiag $m
} {2 2 0 1 5}

test vtrim-1 vect {
  vtrim {2 3 0 1 2 3}
} {1 2 3}