RosettaCodeData/Task/Balanced-ternary/FreeBASIC/balanced-ternary.basic

128 lines
3.1 KiB
Plaintext

#define MAX(a, b) iif((a) > (b), (a), (b))
Dim Shared As Integer pow, signo
Dim Shared As String t
t = "-0+"
Function deci(cadena As String) As Integer
Dim As Integer i, deci1
Dim As String c1S
pow = 1
For i = Len(cadena) To 1 Step -1
c1S = Mid(cadena,i,1)
signo = Instr(t, c1S)-2
deci1 = deci1 + pow * signo
pow *= 3
Next i
Return deci1
End Function
Function ternary(n As Integer) As String
Dim As String ternario
Dim As Integer i, k
While Abs(n) > 3^k/2
k += 1
Wend
k -= 1
pow = 3^k
For i = k To 0 Step -1
signo = (n>0) - (n<0)
signo *= (Abs(n) > pow/2)
ternario += Mid(t,signo+2,1)
n -= signo*pow
pow /= 3
Next
If ternario = "" Then ternario = "0"
Return ternario
End Function
Function negate(cadena As String) As String
Dim As String negar = ""
For i As Integer = 1 To Len(cadena)
negar += Mid(t, 4-Instr(t, Mid(cadena,i,1)), 1)
Next i
Return negar
End Function
Function pad(cadenaA As String, n As Integer) As String
Dim As String relleno = cadenaA
While Len(relleno) < n
relleno = "0" + relleno
Wend
Return relleno
End Function
Function addTernary(cadenaA As String, cadenaB As String) As String
Dim As Integer l = max(Len(cadenaA), Len(cadenaB))
Dim As Integer i, x, y, z
cadenaA = pad(cadenaA, l)
cadenaB = pad(cadenaB, l)
Dim As String resultado = ""
Dim As Byte llevar = 0
For i = l To 1 Step -1
x = Instr(t, Mid(cadenaA,i,1))-2
y = Instr(t, Mid(cadenaB,i,1))-2
z = x + y + llevar
If Abs(z) < 2 Then
llevar = 0
Elseif z > 0 Then
llevar = 1: z -= 3
Elseif z < 0 Then
llevar = -1: z += 3
End If
resultado = Mid(t,z+2,1) + resultado
Next i
If llevar <> 0 Then resultado = Mid(t,llevar+2,1) + resultado
i = 0
While Mid(resultado,i+1,1) = "0"
i += 1
Wend
resultado = Mid(resultado,i+1)
If resultado = "" Then resultado = "0"
Return resultado
End Function
Function subTernary(cadenaA As String, cadenaB As String) As String
Return addTernary(cadenaA, negate(cadenaB))
End Function
Function multTernary(cadenaA As String, cadenaB As String) As String
Dim As String resultado = ""
Dim As String tS = "", cambio = ""
For i As Integer = Len(cadenaA) To 1 Step -1
Select Case Mid(cadenaA,i,1)
Case "+": tS = cadenaB
Case "0": tS = "0"
Case "-": tS = negate(cadenaB)
End Select
resultado = addTernary(resultado, tS + cambio)
cambio += "0"
Next i
Return resultado
End Function
Dim As String cadenaA = "+-0++0+"
Dim As Integer a = deci(cadenaA)
Print " a:", a, cadenaA
Dim As Integer b = -436
Dim As String cadenaB = ternary(b)
Print " b:", b, cadenaB
Dim As String cadenaC = "+-++-"
Dim As Integer c = deci(cadenaC)
Print " c:", c, cadenaC
'calcular en ternario
Dim As String resS = multTernary(cadenaA, subTernary(cadenaB, cadenaC))
Print "a*(b-c):", deci(resS), resS
Print !"\nComprobamos:"
Print "a*(b-c): ", a * (b - c)
Sleep