RosettaCodeData/Task/Balanced-ternary/Liberty-BASIC/balanced-ternary.basic

138 lines
2.8 KiB
Plaintext

global tt$
tt$="-0+" '-1 0 1; +2 -> 1 2 3, instr
'Test case:
'With balanced ternaries a from string "+-0++0+", b from native integer -436, c "+-++-":
'* write out a, b and c in decimal notation;
'* calculate a * (b - c), write out the result in both ternary and decimal notations.
a$="+-0++0+"
a=deci(a$)
print "a",a, a$
b=-436
b$=ternary$(b)
print "b",b, b$
c$="+-++-"
c=deci(c$)
print "c",c, c$
'calculate in ternary
res$=multTernary$(a$, subTernary$(b$, c$))
print "a * (b - c)", res$
print "In decimal:",deci(res$)
print "Check:"
print "a * (b - c)", a * (b - c)
end
function deci(s$)
pow = 1
for i = len(s$) to 1 step -1
c$ = mid$(s$,i,1)
'select case c$
' case "+":sign= 1
' case "-":sign=-1
' case "0":sign= 0
'end select
sign = instr(tt$,c$)-2
deci = deci+pow*sign
pow = pow*3
next
end function
function ternary$(n)
while abs(n)>3^k/2
k=k+1
wend
k=k-1
pow = 3^k
for i = k to 0 step -1
sign = (n>0) - (n<0)
sign = sign * (abs(n)>pow/2)
ternary$ = ternary$+mid$(tt$,sign+2,1)
n = n - sign*pow
pow = pow/3
next
if ternary$ = "" then ternary$ ="0"
end function
function multTernary$(a$, b$)
c$ = ""
t$ = ""
shift$ = ""
for i = len(a$) to 1 step -1
select case mid$(a$,i,1)
case "+": t$ = b$
case "0": t$ = "0"
case "-": t$ = negate$(b$)
end select
c$ = addTernary$(c$, t$+shift$)
shift$ = shift$ +"0"
'print d, t$, c$
next
multTernary$ = c$
end function
function subTernary$(a$, b$)
subTernary$ = addTernary$(a$, negate$(b$))
end function
function negate$(s$)
negate$=""
for i = 1 to len(s$)
'print mid$(s$,i,1), instr(tt$, mid$(s$,i,1)), 4-instr(tt$, mid$(s$,i,1))
negate$=negate$+mid$(tt$, 4-instr(tt$, mid$(s$,i,1)), 1)
next
end function
function addTernary$(a$, b$)
'add a$ + b$, for now only positive
l = max(len(a$), len(b$))
a$=pad$(a$,l)
b$=pad$(b$,l)
c$ = "" 'result
carry = 0
for i = l to 1 step -1
a = instr(tt$,mid$(a$,i,1))-2
b = instr(tt$,mid$(b$,i,1))-2 '-1 0 1
c = a+b+carry
select case
case abs(c)<2
carry = 0
case c>0
carry =1: c=c-3
case c<0
carry =-1: c=c+3
end select
'print a, b, c
c$ = mid$(tt$,c+2,1)+c$
next
if carry<>0 then c$ = mid$(tt$,carry+2,1) +c$
'print c$
'have to trim leading 0's
i=0
while mid$(c$,i+1,1)="0"
i=i+1
wend
c$=mid$(c$,i+1)
if c$="" then c$="0"
addTernary$ = c$
end function
function pad$(a$,n) 'pad from right with 0 to length n
pad$ = a$
while len(pad$)<n
pad$ = "0"+pad$
wend
end function