Conjugate transpose: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) m (→{{header|Perl 6}}: minor style tweaks) |
(Added the Common Lisp version--~~~~) |
||
Line 302: | Line 302: | ||
Complex Matrix A is not normal</pre> |
Complex Matrix A is not normal</pre> |
||
=={{header|Common Lisp}}== |
|||
<lang Lisp> |
|||
(defun matrix-multiply (m1 m2) |
|||
(mapcar |
|||
(lambda (row) |
|||
(apply #'mapcar |
|||
(lambda (&rest column) |
|||
(apply #'+ (mapcar #'* row column))) m2)) m1)) |
|||
(defun identity-p (m &optional (tolerance 1e-6)) |
|||
"Is m an identity matrix?" |
|||
(loop for row in m |
|||
for r = 1 then (1+ r) do |
|||
(loop for col in row |
|||
for c = 1 then (1+ c) do |
|||
(if (eql r c) |
|||
(unless (< (abs (- col 1)) tolerance) (return-from identity-p nil)) |
|||
(unless (< (abs col) tolerance) (return-from identity-p nil)) ))) |
|||
T ) |
|||
(defun conjugate-transpose (m) |
|||
(apply #'mapcar #'list (mapcar #'(lambda (r) (mapcar #'conjugate r)) m)) ) |
|||
(defun hermitian-p (m) |
|||
(equalp m (conjugate-transpose m))) |
|||
(defun normal-p (m) |
|||
(let ((m* (conjugate-transpose m))) |
|||
(equalp (matrix-multiply m m*) (matrix-multiply m* m)) )) |
|||
(defun unitary-p (m) |
|||
(identity-p (matrix-multiply m (conjugate-transpose m))) ) |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
(hermitian-p |
|||
'((3 #C(2 1)) |
|||
(#C(2 -1) 1) )) |
|||
=> T |
|||
(normal-p |
|||
'((#C(0 1) 0) |
|||
(0 #C(3 -5)) )) |
|||
==> T |
|||
(unitary-p |
|||
'((0.70710677 0.70710677 0) |
|||
(#C(0 -0.70710677) #C(0 0.70710677) 0) |
|||
(0 0 1) )) |
|||
==> T |
|||
</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |