# vectorspace.tcl --
# Define vector spaces over arbitrary fields
#
# Notes:
# Procedures of one and two arguments only are expanded
# No provision for scalar-vector operations or for reducing
# operations such as summing all components. All operations
# are considered to be component-by-component.
#
# vectorspace --
# Set up the vector space of given dimension over a given field
# Arguments:
# name Name of the vector space
# field Name of the algebraic construct (a field or some other
# construct like a ring)
# dim Number of dimensions
# Result:
# Name of the new vector space
# Note:
# The field is represented by a namespace containing one or
# more exported procedures of one or two arguments. The
# vector space is represented by procedures based on these
# procedures that are expanded to take care of vector-valued
# arguments
#
proc vectorspace {name field dim} {
#
# Check that the namespace "field" exists, then construct
# a namespace whose procedures are vector-based extensions
# of the original
#
if { ! [namespace exists $field] } {
error "Field $field is unknown"
}
namespace eval $name {}
#
# A constructor procedure
#
proc ${name}::vector {args} [string map [list DIM $dim] {
if { [llength $args] != DIM } {
error "Wrong number of arguments"
}
return $args
}] ;# End string map
foreach op [namespace eval $field {namespace export}] {
set args_op [namespace eval $field [list info args $op]]
switch -- [llength $args_op] {
"1" {
namespace eval $name [list namespace export $op]
proc ${name}::$op {v} [string map [list FIELD $field OP $op DIM $dim] {
set r {}
if { [llength $v] != DIM } {
error "Argument has wrong dimension"
}
foreach c $v {
lappend r [FIELD::OP $c]
}
return $r
}] ;# End string map
}
"2" {
namespace eval $name [list namespace export $op]
proc ${name}::$op {u v} [string map [list FIELD $field OP $op DIM $dim] {
set r {}
if { [llength $u] != DIM || [llength $v] != DIM } {
error "At least one argument has wrong dimension"
}
foreach c $u d $v {
lappend r [FIELD::OP $c $d]
}
return $r
}] ;# End string map
}
"default" {
# Ignore
}
}
}
return $name
}
#
# Create a few functions to test this idea
#
namespace eval float {
proc cos {x} {expr {cos($x)}}
proc + {x y} {expr {$x+$y}}
proc - {x y} {expr {$x-$y}}
proc * {x y} {expr {$x*$y}}
namespace export cos + - *
}
# main --
# Test the vectorspace procedure
#
# 1. Create a three-dimensional vector space
# 2. Create a space of 3x3 matrices
#
vectorspace R^3 float 3
vectorspace R3x3 R^3 3
puts "3D vectors:"
set a [R^3::vector 1 2 3]
set b [R^3::vector 4 1 2]
set c [R^3::vector 2 5 1]
puts "Sum: [R^3::+ $a $b]"
puts "Difference: [R^3::- $a $b]"
puts "Cosine: [R^3::cos $c]"
puts "3x3 matrices:"
set A [R3x3::vector $a $b $c]
set B [R3x3::vector $c $a $b]
set C [R3x3::vector $b $c $a]
puts "Sum: [R3x3::+ $A $B]"
puts "Difference: [R3x3::- $A $B]"
puts "Cosine: [R3x3::cos $C]"[ Category Mathematics ]
