interfaces/xmaxima/Tkmaxima/Matrix.tcl

   1 ###### Matrix.tcl #################################################
   2 #
   3 #   Copyright (C) 2024 Jaime E. Villate
   4 #   Time-stamp: "2024-03-20 14:40:38 villate
   5 #
   6 #  For distribution under GNU public License. See COPYING.tcl
   7 #  (Based on William F. Schelter's work, Copyright (C) 1998)
   8 #
   9 ###################################################################
  10
  11 # In this file a matrix is represented as in Maxima.
  12 # Namely, as a list of rows, where each row is itself a list.
  13 # {{1 0} {0 1}} would then be the two by two identity.
  14 # vectors are represented by lists.
  15
  16 # mkMultLeftExpr
  17 # Given a matrix {{a00 a01} {a10 a11}} and a constant vector {k0 k1},
  18 # it returns the symbolic expression:
  19 # {prefix0 prefix1} {[expr {a00*$prefix0+a01*$prefix1+k0}]
  20 #    [expr {a10*$prefix0+a11*$prefix1+k1}]}
  21 # which will be used by mkMultLeft to define a procedure with input
  22 # parameters {prefix0 prefix1}
  23
  24 proc mkMultLeftExpr {mat prefix {constant ""}} {
  25     set vars ""
  26     set ans ""
  27     set n [llength [lindex $mat 0]]
  28     for { set i 0} { $i < $n} {incr i} { append vars " $prefix$i" }
  29     foreach row $mat c $constant {
  30         set prod ""
  31         set op ""
  32         foreach a $row v $vars {
  33             append prod "$op$a*\$$v"
  34             set op "+"}
  35         if {$c ne ""} {append prod "+$c"}
  36         append ans [concat \[expr [list $prod]\]]
  37         append ans " "}
  38     return [list $vars $ans]}
  39
  40 # mkMultLeftFun
  41 # Creates a procedure named "name" with as many input parameters as
  42 # the number of columns o matrix mat.
  43 # That procedure will return a vector with as many components as
  44 # the number of rows of mat.
  45 # If given, constant is a vector with as many components as the number
  46 # of rows of mat. Each component on the returned vector is the linear
  47 # combination of the input parameters with the corresponding row of mat,
  48 # plus the corresponding component of "constant" if it is given.
  49
  50 proc mkMultLeftFun {mat name {constant ""} } {
  51     set expr [mkMultLeftExpr $mat _a $constant]
  52     set bod1 [string trim [lindex $expr 1] " "]
  53     set bod [concat list [lindex $expr 1]]
  54     proc $name [lindex $expr 0] $bod}
  55
  56 # rotationMatrix
  57 # Computes the matrix of the rotation by azimuth th, and elevation ph
  58 # matrix([cos(th),sin(th),0], [-cos(ph)*sin(th),cos(ph)*cos(th),sin(ph)],
  59 #         [sin(ph)*sin(th),-sin(ph)*cos(th),cos(ph)]);
  60 proc rotationMatrix {th ph {ignore {} } } {
  61     set cph [expr {cos($ph)}]
  62     set sph [expr {sin($ph)}]
  63     set cth [expr {cos($th)}]
  64     set sth [expr {sin($th)}]
  65     return [list [list $cth $sth 0] \
  66                 [list [expr {-$cph*$sth}] [expr {$cph*$cth}] $sph] \
  67                 [list [expr {$sph*$sth}] [expr {-$sph*$cth}] $cph]]}
  68
  69 # matMul
  70 # Returns the product of matrices mat1 and mat2
  71 proc matMul {mat1 mat2} {
  72     set rows [llength $mat1]
  73     set cols [llength [lindex $mat2 0]]
  74     foreach r $mat2 {
  75         for {set j 0} {$j < $cols} {incr j} {
  76             lappend col$j [lindex $r $j]}}
  77     for {set i 0} {$i < $rows} {incr i} {
  78         for {set j 0} {$j < $cols} {incr j} {
  79             lappend row$i [vectDot [lindex $mat1 $i] [set col$j]]}
  80         lappend mat3 [set row$i]}
  81     return $mat3}
  82
  83 # vectDot
  84 # Returns the dot product of vectors vec1 and vec2
  85 proc vectDot {vec1 vec2} {
  86     set prod 0
  87     foreach c1 $vec1 c2 $vec2 {
  88         set prod [expr {$prod + $c1*$c2}]}
  89     return $prod}
  90
  91 # vectorOp
  92 # Returns the vector obtained by applying the infix operator "op"
  93 # between vectors vec1 and vec2
  94 proc vectorOp {vec1 op vec2} {
  95     set ans ""
  96     foreach ai $vec1 bi $vec2 {lappend ans [expr [list $ai $op $bi]]}
  97     return $ans}
  98
  99 # scalarTimesVector
 100 # Returns the vector obtained by multiplying vector by scalar
 101 proc scalarTimesVector {scalar vector} {
 102     foreach coord $vector {lappend ans [expr {$scalar*$coord}]}
 103     return $ans}
 104
 105 ## endsource matrix.tcl