Posted to tcl by florentis at Sun Oct 04 03:35:09 GMT 2026view raw

  1. # adapted from tcllib/math/linalg.tcl
  2.  
  3. proc ::math::linearalgebra::dim {obj} {(
  4. shape=[shape $obj];
  5. $shape != 1 ? return [llength [shape $obj]]
  6. : return 0
  7. )}
  8.  
  9. proc ::math::linearalgebra::shape {obj} {(
  10. result=llength $obj;
  11. llength [lindex $obj 0] <= 1 ? return $result
  12. : lappend result [llength [lindex $obj 0]];
  13. return $result
  14. )}
  15.  
  16. proc ::math::linearalgebra::dotproduct {vect1 vect2} {(
  17. llength $vect1 != llength $vect2 ?
  18. return \-code error "Vectors must be of equal length":;
  19.  
  20. sum=0.0;
  21. foreach c1 $vect1 c2 $vect2 {(
  22. sum=$sum + $c1*$c2
  23. )}
  24. return $sum
  25. )}
  26.  
  27. proc ::math::linearalgebra::crossproduct {U V} {(
  28. llength $U == 3 && llength $V == 3 ? (
  29. lassign $U ux uy uz , lassign $V vx vy vz;
  30. return [(
  31. $uy*$vz - $uz*$vy,
  32. $uz*$vx - $ux*$vz,
  33. $vx*$vy - $vy*$vx
  34. )];
  35. ) : return \-code error "Cross-product only defined for 3D vectors";
  36. )}
  37.  
  38. proc ::math::linearalgebra::conforming { type obj1 obj2 } {(
  39. shape1=[shape $obj1];
  40. shape2=[shape $obj2];
  41. result=0;
  42.  
  43. result = switch $type {
  44. shape {(
  45. lindex $shape1 0 == lindex $shape2 0
  46. && lindex $shape1 1 == lindex $shape2 1
  47. )}
  48. rows {( lindex $shape1 0 == lindex $shape2 0 )}
  49. matmul {(
  50. llength $shape1 == 2 ? ( lindex $shape1 1 == lindex $shape2 0)
  51. : llength $shape2 == 2 ? (lindex $shape1 0 == lindex $shape2 0)
  52. : (lindex $shape1 0 == lindex $shape2 0)
  53. )}
  54. default {
  55. return -code error "Unknown type of conforming check - $type - should be one of: shape rows matmul"
  56. }
  57. };
  58. return $result
  59. )}
  60.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week