1# qcomplex.tcl --
2#    Small module for dealing with complex numbers
3#    The design goal was to make the operations as fast
4#    as possible, not to offer a nice interface. So:
5#    - complex numbers are represented as lists of two elements
6#    - there is hardly any error checking, all arguments are assumed
7#      to be complex numbers already (with a few obvious exceptions)
8#    Missing:
9#    the inverse trigonometric functions and the hyperbolic functions
10#
11
12namespace eval ::math::complexnumbers {
13    namespace export + - / * conj exp sin cos tan real imag mod arg log pow sqrt tostring
14}
15
16# complex --
17#    Create a new complex number
18# Arguments:
19#    real      The real part
20#    imag      The imaginary part
21# Result:
22#    New complex number
23#
24proc ::math::complexnumbers::complex {real imag} {
25    return [list $real $imag]
26}
27
28# binary operations --
29#    Implement the basic binary operations
30# Arguments:
31#    z1        First argument
32#    z2        Second argument
33# Result:
34#    New complex number
35#
36proc ::math::complexnumbers::+ {z1 z2} {
37    set result {}
38    foreach c $z1 d $z2 {
39        lappend result [expr {$c+$d}]
40    }
41    return $result
42}
43proc ::math::complexnumbers::- {z1 {z2 {}}} {
44    if { $z2 == {} } {
45        set z2 $z1
46        set z1 {0.0 0.0}
47    }
48    set result {}
49    foreach c $z1 d $z2 {
50        lappend result [expr {$c-$d}]
51    }
52    return $result
53}
54proc ::math::complexnumbers::* {z1 z2} {
55    set result {}
56    foreach {c1 d1} $z1 {break}
57    foreach {c2 d2} $z2 {break}
58
59    return [list [expr {$c1*$c2-$d1*$d2}] [expr {$c1*$d2+$c2*$d1}]]
60}
61proc ::math::complexnumbers::/ {z1 z2} {
62    set result {}
63    foreach {c1 d1} $z1 {break}
64    foreach {c2 d2} $z2 {break}
65
66    set denom [expr {$c2*$c2+$d2*$d2}]
67    return [list [expr {($c1*$c2+$d1*$d2)/$denom}] \
68                 [expr {(-$c1*$d2+$c2*$d1)/$denom}]]
69}
70
71# unary operations --
72#    Implement the basic unary operations
73# Arguments:
74#    z1        Argument
75# Result:
76#    New complex number
77#
78proc ::math::complexnumbers::conj {z1} {
79    foreach {c d} $z1 {break}
80    return [list $c [expr {-$d}]]
81}
82proc ::math::complexnumbers::real {z1} {
83    foreach {c d} $z1 {break}
84    return $c
85}
86proc ::math::complexnumbers::imag {z1} {
87    foreach {c d} $z1 {break}
88    return $d
89}
90proc ::math::complexnumbers::mod {z1} {
91    foreach {c d} $z1 {break}
92    return [expr {hypot($c,$d)}]
93}
94proc ::math::complexnumbers::arg {z1} {
95    foreach {c d} $z1 {break}
96    if { $c != 0.0 || $d != 0.0 } {
97        return [expr {atan2($d,$c)}]
98    } else {
99        return 0.0
100    }
101}
102
103# elementary functions --
104#    Implement the elementary functions
105# Arguments:
106#    z1        Argument
107#    z2        Second argument (if any)
108# Result:
109#    New complex number
110#
111proc ::math::complexnumbers::exp {z1} {
112    foreach {c d} $z1 {break}
113    return [list [expr {exp($c)*cos($d)}] [expr {exp($c)*sin($d)}]]
114}
115proc ::math::complexnumbers::cos {z1} {
116    foreach {c d} $z1 {break}
117    return [list [expr {cos($c)*cosh($d)}] [expr {-sin($c)*sinh($d)}]]
118}
119proc ::math::complexnumbers::sin {z1} {
120    foreach {c d} $z1 {break}
121    return [list [expr {sin($c)*cosh($d)}] [expr {cos($c)*sinh($d)}]]
122}
123proc ::math::complexnumbers::tan {z1} {
124    return [/ [sin $z1] [cos $z1]]
125}
126proc ::math::complexnumbers::log {z1} {
127    return [list [expr {log([mod $z1])}] [arg $z1]]
128}
129proc ::math::complexnumbers::sqrt {z1} {
130    set argz [expr {0.5*[arg $z1]}]
131    set modz [expr {sqrt([mod $z1])}]
132    return [list [expr {$modz*cos($argz)}] [expr {$modz*sin($argz)}]]
133}
134proc ::math::complexnumbers::pow {z1 z2} {
135    return [exp [* [log $z1] $z2]]
136}
137# transformational functions --
138#    Implement transformational functions
139# Arguments:
140#    z1        Argument
141# Result:
142#    String like 1+i
143#
144proc ::math::complexnumbers::tostring {z1} {
145    foreach {c d} $z1 {break}
146    if { $d == 0.0 } {
147        return "$c"
148    } else {
149        if { $c == 0.0 } {
150            if { $d == 1.0 } {
151                return "i"
152            } elseif { $d == -1.0 } {
153                return "-i"
154            } else {
155                return "${d}i"
156            }
157        } else {
158            if { $d > 0.0 } {
159                if { $d == 1.0 } {
160                    return "$c+i"
161                } else {
162                    return "$c+${d}i"
163                }
164            } else {
165                if { $d == -1.0 } {
166                    return "$c-i"
167                } else {
168                    return "$c${d}i"
169                }
170            }
171        }
172    }
173}
174
175#
176# Announce our presence
177#
178package provide math::complexnumbers 1.0.2
179