Rosetta Code

Conjugate transpose: Difference between revisions

Page Discussion

Conjugate transpose (view source)

Revision as of 22:29, 14 August 2016

531 bytes added ,  7 years ago
m
→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, simplified some functions.
m (→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, simplified some functions.)
Line 1,588:
 
=={{header|REXX}}==
<lang rexx>/*REXX pgmprogram performs a conjugate transpose on a complex square matrix. */
parse arg N elements; if N==''|N=="," then N=3 /*Not specified? Then use the default.*/
M.k=0; do r=1 for /*Matrix has all elements equal to zero*/N
do c=1 for N; k=k+1; M.r.c=word(word(elements,k) 1,1); end /*c*/
k=0; do r=1 for N
do c=1 for N; k=k+1; M.r.c=word(word(elements,k) 1,1);end end /*cr*/
call showCmat 'MHM' ,N /*display a nicely formatted matrix. */▼
end /*r*/
identity.=0; do do d=1 for N; identity.d.d=1; end /*d*/▼
 
call showCmatconjCmat 'MMH', "M" ,N ,N /*displayconjugate athe nicely formattedM matrix. ───► MH */
call showCmat 'MH' ,N /*display a nicely formatted matrix. */
▲identity.=0; do d=1 for N; identity.d.d=1; end /*d*/
call conjCmat 'MH', "M" ,N /*conjugate the M matrix ───► MH */
▲call showCmat 'MH' ,N /*display a nicely formatted matrix. */
say 'M is Hermitian: ' word('no yes',isHermitian('M',"MH",N)+1)
call multCmat 'M', 'MH', 'MMH', N /*multiple the two matrices together. */
call multCmat 'MH', 'M', 'MHM', N /* " " " " " */
say ' M is Normal: ' word('no yes', isHermitian('MMH', "MHM", N) + 1)
say ' M is Unary: ' word('no yes', isUnary('M', N) + 1)
say 'MMH is Unary: ' word('no yes', isUnary('MMH', N) + 1)
say 'MHM is Unary: ' word('no yes', isUnary('MHM', N) + 1)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────one─liner subroutines─────────────────────*/
cP: procedure; arg ',' pc; return word( strip( translate(pc, , 'IJ') ) 0, 1)
rP: procedure; parse arg r ','; return word( r 0, 1) /*◄──maybe return a 0 ↑ */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
conjCmat: parse arg matX,matY,rows 1 cols; call normCmat matY, rows
do r=1 for rows; _=
do c=1 for cols; v=value(matY'.'r"."c)
rP=rP(v); cP=-cP(v); call value matX'.'c"."r, rP','cP
end /*c*/
end /*r*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
isHermitian: parse arg matX,matY,rows 1 cols; call normCmat matX, rows
call normCmat matY, rows
do r=1 for rows; _=
do c=1 for cols
if value(matX'.'r"."c) \= value(matY'.'r"."c) then return 0
end /*c*/
end /*r*/
return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
isUnary: parse arg matX,rows 1 cols
do r=1 for rows; _=
do c=1 for cols; z=value(matX'.'r"."c); rP=rP(z); cP=cP(z)
if abs(sqrt(rP(z)**2 + cP(z)**2) - (r==c)) >= .0001 then return 0
end /*c*/
end /*r*/
return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
multCmat: parse arg matA,matB,matT,rows 1 cols; call value matT'.', 0
do r=1 for rows; _=
do c=1 for cols
do k=1 for cols; T=value(matT'.'r"."c); Tr=rP(T); Tc=cP(T)
A=value(matA'.'r"."k); Ar=rP(A); Ac=cP(A)
B=value(matB'.'k"."c); Br=rP(B); Bc=cP(B)
Pr=Ar*Br - Ac*Bc; Pc=Ac*Br + Ar*Bc; Tr=Tr+Pr; Tc=Tc+Pc
call value matT'.'r"."c,Tr','Tc
end /*k*/
end /*c*/
end /*r*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
normCmat: parse arg matN,rows 1 cols
do r=1 to rows; _=
do c=1 to cols; v=translate(value(matN'.'r"."c), , "IiJj")
parse upper var v real ',' cplx
if real\=='' then real=real/1
if cplx\=='' then cplx=cplx/1; if cplx=0 then cplx=
if cplx\=='' then cplx=cplx"j"
call value matN'.'r"."c, strip(real','cplx, "T", ',')
end /*c*/
end /*r*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
showCmat: parse arg matX,rows,cols; if cols=='' then cols=rows; @@=left('',6)
say; say center('matrix' matX, 79, '─'); call normCmat matX, rows, cols
do r=1 to rows; _=
do c=1 to cols; _=_ @@ left(value(matX'.'r"."c), 9); end /*c*/
say _
end /*r*/
say; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=numeric form; m.h=9d+6
numeric digits 9; numericparse form;value h=d+6;format(x,2,1,,0) 'E0' if x<0with theng 'E' do_ .; x g=-x;g i=*.5'ie';_ % end2
parsem.=9; value format(x,2,1,,do j=0) 'E0' while withh>9; g 'E' _ m.j=h; g h=g*.5'e'_h%2+1; end /*j*/
do jk=0j+5 whileto h>9;0 by -1; numeric digits m.j=hk; hg=h%2(g+1x/g)*.5; end /*jk*/; return g</lang>
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return (g/1)i /*make complex if X < 0.*/</lang>
'''output''' &nbsp; when using the default input:
<pre>
Line 1,694 ⟶ 1,690:
MHM is Unary: no
</pre>
'''output''' &nbsp; when using the input of: &nbsp; <tt> 3 &nbsp; .7071 &nbsp; .7071 &nbsp; 0 &nbsp; 0,.7071 &nbsp; 0,-.7071 &nbsp; 0 &nbsp; 0 &nbsp; 0 &nbsp; 0,1 </tt>
<pre>
───────────────────────────────────matrix M────────────────────────────────────
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/211920"