Balanced ternary: Difference between revisions

Content added Content deleted
(Added Julia language)
m (→‎{{header|REXX}}: added/changed comments and whitespace, used a template for the OUTPUTs, optimized a function.)
Line 4,051: Line 4,051:
=={{header|REXX}}==
=={{header|REXX}}==
The REXX program could be optimized by using &nbsp; (procedure) with &nbsp; '''expose''' &nbsp; and having the &nbsp; <big>'''$.'''</big> &nbsp; and &nbsp; <big>'''@.'''</big> &nbsp; variables set only once.
The REXX program could be optimized by using &nbsp; (procedure) with &nbsp; '''expose''' &nbsp; and having the &nbsp; <big>'''$.'''</big> &nbsp; and &nbsp; <big>'''@.'''</big> &nbsp; variables set only once.
<lang rexx>/*REXX pgm converts decimal ◄───► balanced ternary; also performs arithmetic.*/
<lang rexx>/*REXX program converts decimal ◄───► balanced ternary; it also performs arithmetic. */
numeric digits 10000 /*be able to handle gihugic numbers. */
numeric digits 10000 /*be able to handle gihugic numbers. */
Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by subroutine*/
Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by subroutine*/
Bo = '-436' ; Bbt = d2bt(Bo) ; @ = '(decimal)'
Bo = '-436' ; Bbt = d2bt(Bo); @ = '(decimal)'
Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
call btShow '[a]', Abt
call btShow '[a]', Abt
call btShow '[b]', Bbt
call btShow '[b]', Bbt
call btShow '[c]', Cbt
call btShow '[c]', Cbt
say; $bt = btMul(Abt,btSub(Bbt,Cbt))
say; $bt = btMul(Abt, btSub(Bbt, Cbt) )
call btShow '[a*(b-c)]', $bt
call btShow '[a*(b-c)]', $bt
exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*────────────────────────────────────────────────────────────────────────────*/
d2bt: procedure; parse arg x 1; p=0; $.='-'; $.1='+'; $.0=0; #=
d2bt: procedure; parse arg x 1; p=0; $.='-'; $.1='+'; $.0=0; #=
x=x/1
x=x / 1
do until x==0; _=(x//(3**(p+1)))%3**p
do until x==0; _= (x // (3** (p+1) ) ) % 3**p
if _== 2 then _= -1
if _== 2 then _= -1; else if _== -2 then _=1
if _== -2 then _= 1
x=x - _ * (3**p); p=p+1; #=$._ || #
x=x-_*(3**p); p=p+1; #=$._ || #
end /*until*/; return #
/*──────────────────────────────────────────────────────────────────────────────────────*/
end /*until ···*/
bt2d: procedure; parse arg x; r=reverse(x); #=0; $.=-1; $.0=0; _='+'; $._=1
return #
do j=1 for length(x); _=substr(r,j,1); #= # + $._ * 3**(j-1); end; return #
/*────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
bt2d: procedure; parse arg x; r=reverse(x); #=0; $.=-1; $.0=0; _='+'; $._=1
btAdd: procedure; parse arg x,y; rx=reverse(x); ry=reverse(y); carry=0
do j=1 for length(x); _=substr(r,j,1); #=#+$._*3**(j-1); end
@.=0 ; _='-'; @._= -1; _="+"; @._=1
return #
$.='-'; $.0=0; $.1= '+'
/*────────────────────────────────────────────────────────────────────────────*/
#=; do j=1 for max( length(x), length(y) )
btAdd: procedure; parse arg x,y; rx=reverse(x); ry=reverse(y); carry=0
@.=0 ; _='-'; @._=-1; _="+"; @._=1
x_=substr(rx, j, 1); xn=@.x_
y_=substr(ry, j, 1); yn=@.y_
$.='-'; $.0=0; $.1='+'
#=; do j=1 for max(length(x),length(y))
s=xn + yn + carry; carry= 0
x_=substr(rx,j,1); xn=@.x_
if s== 2 then do; s=-1; carry= 1; end
y_=substr(ry,j,1); yn=@.y_
if s== 3 then do; s= 0; carry= 1; end
s=xn+yn+carry ; carry= 0
if s==-2 then do; s= 1; carry=-1; end
if s== 2 then do; s=-1; carry= 1; end
#=$.s || #
if s== 3 then do; s= 0; carry= 1; end
end /*j*/
if s==-2 then do; s= 1; carry=-1; end
if carry\==0 then #=$.carry || #; return btNorm(#)
/*──────────────────────────────────────────────────────────────────────────────────────*/
#=$.s || #
end /*j*/
btMul: procedure; parse arg x 1 x1 2, y 1 y1 2; if x==0 | y==0 then return 0
if carry\==0 then #=$.carry||#; return btNorm(#)
S=1; x=btNorm(x); y=btNorm(y) /*handle: 0-xxx values.*/
if x1=='-' then do; x=btNeg(x); S=-S; end /*positate the number. */
/*────────────────────────────────────────────────────────────────────────────*/
if y1=='-' then do; y=btNeg(y); S=-S; end /* " " " */
btMul: procedure; parse arg x 1 x1 2, y 1 y1 2; if x==0 | y==0 then return 0
S=1; x=btNorm(x); y=btNorm(y) /*handle: 0-xxx values.*/
if length(y)>length(x) then parse value x y with y x /*optimize " " */
P=0
if x1=='-' then do; x=btNeg(x); S=-S; end /*positate.*/
if y1=='-' then do; y=btNeg(y); S=-S; end /* " */
do until y==0 /*keep adding 'til done*/
if length(y)>length(x) then parse value x y with y x /*optimize.*/
P=btAdd(P, x) /*multiple the hard way*/
y=btSub(y, '+') /*subtract 1 from Y.*/
P=0
do until y==0 /*keep adding 'til done*/
end /*until*/
P=btAdd(P,x) /*multiple the hard way*/
if S==-1 then P=btNeg(P); return P /*adjust the product sign; return. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
y=btSub(y,'+') /*subtract 1 from Y.*/
end /*until*/
btNeg: return translate(arg(1), '-+', "+-") /*negate bal_ternary #.*/
btNorm: _=strip(arg(1),'L',0); if _=='' then _=0; return _ /*normalize the number.*/
if S==-1 then P=btNeg(P) /*adjust product sign. */
return P /*return the product P.*/
btSub: return btAdd(arg(1), btNeg(arg(2))) /*subtract two BT args.*/
btShow: say center(arg(1),9) right(arg(2),20) @@ right(bt2d(arg(2)),9) @; return</lang>
/*────────────────────────────────────────────────────────────────────────────*/
{{out|output|text=&nbsp; when using the default input:}}
btNeg: return translate(arg(1), '-+', "+-") /*negate the bal_tern #*/
btNorm: _=strip(arg(1),'L',0); if _=='' then _=0; return _ /*normalize a #*/
btSub: return btAdd(arg(1), btNeg(arg(2))) /*subtract two BT args.*/
btShow: say center(arg(1),9) right(arg(2),20) @@ right(bt2d(arg(2)),9) @; return</lang>
'''output''' &nbsp; when using the default inputs:
<pre>
<pre>
[a] +-0++0+ balanced ternary = 523 (decimal)
[a] +-0++0+ balanced ternary = 523 (decimal)