Radix conversion

[Demivec]

@Edit: Removed.

[Little John]

When I run the code on OS X, the output for the base 36 to base 8 conversion seems strange to me

Code: Select all

base 36: AHZ46H67JLR4KCGFWQBDYIHO
base 8: °!^..~.&&#^&^°^///#°.&&/~~°^°/°/^~..&/°^°

Hello wilbert,

that is the intended output.
Most examples in the demo code use the default symbols from the following list:

Code: Select all

#StdSymbols$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 

At some point in the demo code, I wanted to show that he user of the module can use any other list of symbols, e.g.for output:

Code: Select all

symbols$ = "~#.^°/&!"

The fact that that special example uses its own symbol list for output is unfortunately not shown by the macro Demo_Vast(). I am sorry.

[wilbert]

At some point in the demo code, I wanted to show that he user of the module can use any other list of symbols

It makes sense now
I overlooked this.

[Little John]

New version 2.1 released,
added functions for conversion to and from balanced ternary

[Little John]

Fixed bugs in functions for balanced ternary.

[AZJIO]

I did it with big numbers. Now there is no limit on the length of the string.

Code: Select all

EnableExplicit

; bigint.pbi - https://www.purebasic.fr/english/viewtopic.php?p=458493#p458493
IncludeFile("bigint.pbi")

UseModule BigInt

Global Error_Procedure = 0
Declare StrToArrLetter(Array Arr.s{1}(1), String$)
Declare.s DecToNum(Dec$, Symbol$)
Declare.s NumToDec(num$, Symbol$, casesense = 0)

; число в массив, быстрая
Procedure StrToArrLetter(Array Arr.s{1}(1), String$)
	Protected LenStr, i
	LenStr = Len(String$)
	If LenStr
		ReDim Arr(LenStr - 1)
		PokeS(Arr(), String$, -1, #PB_String_NoZero)
	EndIf
EndProcedure

Procedure.s DecToNum(Dec$, Symbol$)
	Protected.BigInt BigDec, BigOst, Big1, BigArrSz, BigDec2
	Protected Out.s, Dim Arr.s{1}(1), ArrSz
	SetValue(Big1, 1)
	StrToArrLetter(Arr(), Symbol$)
	ArrSz = ArraySize(Arr()) + 1
	If Error_Procedure Or ArrSz < 2
		Error_Procedure = 1
		ProcedureReturn ""
	EndIf
	SetHexValue(BigDec, Dec$)
	SetValue(BigArrSz, ArrSz)
	Repeat
		Assign(BigOst, BigDec)
		ModMul(BigOst, Big1, BigArrSz)
		Subtract(BigDec, BigOst)
		Divide(BigDec2, BigDec, BigArrSz)
		Assign(BigDec, BigDec2)
		
		Out = Arr(Val("$" + GetHex(BigOst))) + Out
	Until Compare(BigDec2, Big1) = -1
	ProcedureReturn Out
EndProcedure

Procedure.s NumToDec(num$, Symbol$, casesense = 0)
	Protected.BigInt BigLenStr, BigM, BigOut, BigPos
	Protected i, j, Pos, LenStr, ArrSz, Dim Arr.s{1}(1)
	LenStr = Len(Symbol$) ; если набор символов менее 2-х, то не имеет смысла
	If LenStr < 2
		Error_Procedure = 1
		ProcedureReturn "0"
	EndIf
	SetValue(BigLenStr, LenStr)	

	StrToArrLetter(Arr(), num$) ; число в массив
	If Error_Procedure
		Error_Procedure = 1
		ProcedureReturn "0"
	EndIf
	ArrSz = ArraySize(Arr())
	For i = 0 To ArrSz
		Pos = FindString(Symbol$, Arr(i), 1, casesense)
		If Not Pos
			Error_Procedure = 2
			ProcedureReturn "0"
		EndIf
		SetValue(BigM, 1)
		For j = 1 To ArrSz - i
			Multiply(BigM, BigLenStr)
		Next
		SetValue(BigPos, Pos - 1)
		Multiply(BigM, BigPos)
		Add(BigOut, BigM)
	Next
	ProcedureReturn GetHex(BigOut)
EndProcedure

Debug "NumToDec = " + NumToDec("101", "01")
; абвгдежзийклмнопрстуфхцчшщъыьэюя

Define baza$, resDec$
baza$ =  " АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя,!"
resDec$ = NumToDec("Закодировал длиную строку", baza$)
; resDec$ = NumToDec("при", baza$)
Debug "NumToDec = " + resDec$
Debug "DecToNum = " + DecToNum(resDec$, baza$)
; Debug "Error = " + Error_Procedure