Arithmetic/Complex: Difference between revisions

Added solution for Action!
(→‎Pascal: no need to reinvent the wheel and define a custom record type since `complex` is already standardized in ISO 10206, besides there were multiple mistakes; move Free Pascal implementation under dedicated section →‎Free Pascal)
(Added solution for Action!)
Line 54:
1.5
3
</pre>
 
=={{header|Action!}}==
{{libheader|Action! Tool Kit}}
<lang Action!>INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit
 
TYPE Complex=[CARD r,i] ;REAL POINTER
 
BYTE FUNC Positive(REAL POINTER x)
BYTE ARRAY tmp
 
tmp=x
IF (tmp(0)&$80)=$00 THEN
RETURN (1)
FI
RETURN (0)
 
PROC PrintComplex(Complex POINTER x)
PrintR(x.r)
IF Positive(x.i) THEN
Put('+)
FI
PrintR(x.i) Put('i)
RETURN
 
PROC PrintComplexXYZ(Complex POINTER x,y,z CHAR ARRAY s)
Print("(") PrintComplex(x)
Print(") ") Print(s)
Print(" (") PrintComplex(y)
Print(") = ") PrintComplex(z)
PutE()
RETURN
 
PROC PrintComplexXY(Complex POINTER x,y CHAR ARRAY s)
Print(s)
Print("(") PrintComplex(x)
Print(") = ") PrintComplex(y)
PutE()
RETURN
 
PROC ComplexAdd(Complex POINTER x,y,res)
RealAdd(x.r,y.r,res.r) ;res.r=x.r+y.r
RealAdd(x.i,y.i,res.i) ;res.i=x.i+y.i
RETURN
 
PROC ComplexSub(Complex POINTER x,y,res)
RealSub(x.r,y.r,res.r) ;res.r=x.r-y.r
RealSub(x.i,y.i,res.i) ;res.i=x.i-y.i
RETURN
 
PROC ComplexMult(Complex POINTER x,y,res)
REAL tmp1,tmp2
 
RealMult(x.r,y.r,tmp1) ;tmp1=x.r*y.r
RealMult(x.i,y.i,tmp2) ;tmp2=x.i*y.i
RealSub(tmp1,tmp2,res.r) ;res.r=x.r*y.r-x.i*y.i
 
RealMult(x.r,y.i,tmp1) ;tmp1=x.r*y.i
RealMult(x.i,y.r,tmp2) ;tmp2=x.i*y.r
RealAdd(tmp1,tmp2,res.i) ;res.i=x.r*y.i+x.i*y.r
RETURN
 
PROC ComplexDiv(Complex POINTER x,y,res)
REAL tmp1,tmp2,tmp3,tmp4
 
RealMult(x.r,y.r,tmp1) ;tmp1=x.r*y.r
RealMult(x.i,y.i,tmp2) ;tmp2=x.i*y.i
RealAdd(tmp1,tmp2,tmp3) ;tmp3=x.r*y.r+x.i*y.i
RealMult(y.r,y.r,tmp1) ;tmp1=y.r^2
RealMult(y.i,y.i,tmp2) ;tmp2=y.i^2
RealAdd(tmp1,tmp2,tmp4) ;tmp4=y.r^2+y.i^2
RealDiv(tmp3,tmp4,res.r) ;res.r=(x.r*y.r+x.i*y.i)/(y.r^2+y.i^2)
 
RealMult(x.i,y.r,tmp1) ;tmp1=x.i*y.r
RealMult(x.r,y.i,tmp2) ;tmp2=x.r*y.i
RealSub(tmp1,tmp2,tmp3) ;tmp3=x.i*y.r-x.r*y.i
RealDiv(tmp3,tmp4,res.i) ;res.i=(x.i*y.r-x.r*y.i)/(y.r^2+y.i^2)
RETURN
 
PROC ComplexNeg(Complex POINTER x,res)
REAL neg
 
ValR("-1",neg) ;neg=-1
RealMult(x.r,neg,res.r) ;res.r=-x.r
RealMult(x.i,neg,res.i) ;res.r=-x.r
RETURN
 
PROC ComplexInv(Complex POINTER x,res)
REAL tmp1,tmp2,tmp3
 
RealMult(x.r,x.r,tmp1) ;tmp1=x.r^2
RealMult(x.i,x.i,tmp2) ;tmp2=x.i^2
RealAdd(tmp1,tmp2,tmp3) ;tmp3=x.r^2+x.i^2
RealDiv(x.r,tmp3,res.r) ;res.r=x.r/(x.r^2+x.i^2)
 
ValR("-1",tmp1) ;tmp1=-1
RealMult(x.i,tmp1,tmp2) ;tmp2=-x.i
RealDiv(tmp2,tmp3,res.i) ;res.i=-x.i/(x.r^2+x.i^2)
RETURN
 
PROC ComplexConj(Complex POINTER x,res)
REAL neg
 
ValR("-1",neg) ;neg=-1
RealAssign(x.r,res.r) ;res.r=x.r
RealMult(x.i,neg,res.i) ;res.i=-x.i
RETURN
 
PROC Main()
Complex x,y,res
REAL xr,xi,yr,yi,resr,resi
 
x.r=xr x.i=xi
y.r=yr y.i=yi
res.r=resr res.i=resi
 
IntToReal(5,x.r) IntToReal(3,x.i)
IntToReal(4,y.r) ValR("-3",y.i)
 
Put(125) PutE() ;clear screen
 
ComplexAdd(x,y,res)
PrintComplexXYZ(x,y,res,"+")
 
ComplexSub(x,y,res)
PrintComplexXYZ(x,y,res,"-")
 
ComplexMult(x,y,res)
PrintComplexXYZ(x,y,res,"*")
 
ComplexDiv(x,y,res)
PrintComplexXYZ(x,y,res,"/")
 
ComplexNeg(y,res)
PrintComplexXY(y,res," -")
 
ComplexInv(y,res)
PrintComplexXY(y,res," 1 / ")
 
ComplexConj(y,res)
PrintComplexXY(y,res," conj")
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Complex.png Screenshot from Atari 8-bit computer]
<pre>
(5+3i) + (4-3i) = 9+0i
(5+3i) - (4-3i) = 1+6i
(5+3i) * (4-3i) = 29-3i
(5+3i) / (4-3i) = .44+1.08i
-(4-3i) = -4+3i
1 / (4-3i) = .16+.12i
conj(4-3i) = 4+3i
</pre>
 
Anonymous user