Jump to content

Conjugate transpose: Difference between revisions

m
→‎{{header|Haskell}}: Applied hindent for Rosetta 80 char width. Slightly foregrounded shared predicate structure.
m (Removed unused member functions)
m (→‎{{header|Haskell}}: Applied hindent for Rosetta 80 char width. Slightly foregrounded shared predicate structure.)
Line 1,127:
=={{header|Haskell}}==
Slow implementation using lists.
<lang haskell>import Data.ListComplex (transposeComplex(..), conjugate)
import Data.ComplexList (transpose)
 
type Matrix a = [[a]]
Line 1,134:
main :: IO ()
main =
mapM_ (\a -> do
(\a -> do
putStrLn "\nMatrix:"
putStrLn mapM_ print a"\nMatrix:"
mapM_ putStrLnprint "Conjugate Transpose:"a
putStrLn "\nMatrixConjugate Transpose:"
mapM_ print (conjTranspose a)
putStrLn $ "Hermitian? " ++ show (isHermitianMatrix a)
putStrLn $ "NormalHermitian? " ++ show (isNormalMatrixisHermitianMatrix a)
putStrLn $ "UnitaryNormal? " ++ show (isUnitaryMatrixisNormalMatrix a))
putStrLn ([[[3,$ "Unitary? " ++ show (isUnitaryMatrix 2:+1],a))
([ [[3, 2 :+ 1], [2 :+ (-1), 1 ]],
, [[1, 1, 0], [0, 1, 1], [1, 0, 1]],
, [ [[sqrt 2 / 2 :+ 0, sqrt 2 / 2 :+ 0, 0 ],
, [0 :+ sqrt 2 / 2, 0 :+ (-sqrt 2 / 2), 0 ],
, [0, 10, 0 :+ 1],
]
[0, 0, 0:+1]]] :: [Matrix (Complex Double)])
 
isHermitianMatrix, isNormalMatrix, isUnitaryMatrix
[[1, 1, 0],
:: RealFloat a
[0, 1, 1],
conjTranspose :: Num a => Matrix (Complex a) -> Matrix (Complex a)Bool
[1, 0, 1]],
isHermitianMatrix a = amTest `approxEqualMatrix`id conjTranspose a
 
isNormalMatrix = mTest mmct (mmul =<< conjTranspose)
[[sqrt 2/2:+0, sqrt 2/2:+0, 0 ],
[0:+sqrt 2/2, 0:+ (-sqrt 2/2), 0 ],
[0, 0, 0:+1]]] :: [Matrix (Complex Double)])
 
isHermitianMatrix, isNormalMatrix, isUnitaryMatrix ::= RealFloatmTest ammct =>(ident Matrix. (Complex alength) -> Bool
isHermitianMatrix a = a `approxEqualMatrix` conjTranspose a
isNormalMatrix a = (a `mmul` conjTranspose a) `approxEqualMatrix` (conjTranspose a `mmul` a)
isUnitaryMatrix a = (a `mmul` conjTranspose a) `approxEqualMatrix` ident (length a)
 
mTest
approxEqualMatrix :: (Fractional a, Ord a) => Matrix (Complex a) -> Matrix (Complex a) -> Bool
:: RealFloat a
approxEqualMatrix a b = length a == length b && length (head a) == length (head b) &&
=> (a2 -> Matrix (Complex a)) -> (a2 -> Matrix (Complex a)) -> a2 -> Bool
and (zipWith approxEqualComplex (concat a) (concat b))
mTest f g = (approxEqualMatrix . f) <*> g
where approxEqualComplex (rx :+ ix) (ry :+ iy) = abs (rx - ry) < eps && abs (ix - iy) < eps
eps = 1e-14
 
mmct
mmul :: Num a => Matrix a -> Matrix a -> Matrix a
:: RealFloat a
mmul a b = [[sum (zipWith (*) row column) | column <- transpose b] | row <- a]
=> Matrix (Complex a) -> Matrix (Complex a)
mmct = mmul <*> conjTranspose
 
approxEqualMatrix
ident :: Num a => Int -> Matrix a
:: (Fractional a, Ord a)
ident size = [[fromIntegral $ div a b * div b a | a <- [1..size]] | b <- [1..size]]
approxEqualMatrix :: (Fractional a, Ord a) => Matrix (Complex a) -> Matrix (Complex a) -> Bool
approxEqualMatrix a b =
length a == length b &&
approxEqualMatrix a b = length a == length b && length (head a) == length (head b) &&
and (zipWith approxEqualComplex (concat a) (concat b))
where
approxEqualComplex (rx :+ ix) (ry :+ iy) =
where approxEqualComplex (rx :+ ix) (ry :+ iy) = abs (rx - ry) < eps && abs (ix - iy) < eps
eps = 1e-14
 
mmul
conjTranspose :: Num a => Matrix (Complex a) -> Matrix (Complex a)
:: Num a
mmul :: Num a => Matrix a -> Matrix a -> Matrix a
mmul a b =
mmul a b[ =[ [[sum (zipWith (*) row column) | column <- transpose b] | row <- a]
| column <- transpose b ]
| row <- a ]
 
ident
:: Num a
ident :: Num a => Int -> Matrix a
ident size =
ident size =[ [[ fromIntegral $ div a b * div b a | a <- [1..size]] | b <- [1..size]]
| a <- [[1, 1,.. size] 0],
| b <- [1 .. size] ]
 
conjTranspose
:: Num a
=> Matrix (Complex a) -> Matrix (Complex a)
conjTranspose = map (map conjugate) . transpose</lang>
Output:
9,659

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.