Yep another code reviewed and augmented code from Guimauve and Michael Vogel huge number library.
The original code was found here : Huge #'s
I hope you will enjoy it as much as I do since the fully operational division is implemented.
EDIT : 1 The working code is presented at the 4th post in this topic. Sorry for the inconvenience.
EDIT : 2 For the working code look for file version 1.3.0. Sorry for the inconvenience.
Best regards
StarBootics
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : VogelsNumberFormat
; File Name : VogelsNumberFormat - OOP.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : November 9th, 2020
; Last Update : November 14th, 2020
; PureBasic code : V5.73 beta 4
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming notes
;
; 1. Based on the code from Guimauve which itself is based on
; the original code by Michael Vogel.
;
; 2. The division algorithm is based on explanations found on
; this website :
;
; http://justinparrtech.com/JustinParr-Tech/home/
;
; Do a search with the keywords "INTEGER DIVISION"
;
; Or you can watch on YouTube the video "Simple Algorithm for
; Arbitrary-Precision Integer Division".
;
; https://www.youtube.com/watch?v=6bpLYxk9TUQ
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
DeclareModule VogelsNumberFormat
#CORRECT = 0
#UNDEFINED = -1
#INFINITIVE = -2
#OVERFLOW = -3
#DIVISION_BY_ZERO = -4
#NOT_IMPLEMENTED = -5
Interface VNF
GetStatus.w()
Set(*Other)
Reset()
Copy.i()
Swapping(*Other)
To_String.s(Group.i = 0)
From_String(P_String.s)
ZapLeadZeroes()
Zero()
One()
Absolute()
IsEqual.b(*Other, Abs.b = 0)
IsGreaterThan.b(*Other, Abs.b = 0)
IsPositive.b()
Positive()
Negative()
Plus.i(*Other)
Minus.i(*Other)
Add(*Other)
Substract(*Other)
Product.i(*Other)
Multiply(*Other)
Halve(*Residue = #Null)
Double()
Increment()
Decrement()
Square()
Power.i(Exponent.l, *Error.Byte = #Null)
Divide.i(*Divisor, *Residue)
Factorial(Value.l)
Fibonacci(Value.l)
Randomize(MaximumDigitCount.l, MinimumDigitCount.l = 0)
ReadVogelsNumberFormat(FileID.i)
WriteVogelsNumberFormat(FileID.i)
Free()
EndInterface
Declare.i New(P_String.s = "0")
EndDeclareModule
Module VogelsNumberFormat
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Internal Constants declaration <<<<<
#NEGATIVE = 1
#POSITIVE = 0
#LIMB_SIZE = 9
#RADIX = 1000000000
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure declaration <<<<<
Structure Private_Members
VirtualTable.i
Status.w
Sign.w
List Limbs.q()
EndStructure
; <<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Getter <<<<<
Procedure.w GetStatus(*This.Private_Members)
ProcedureReturn *This\Status
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Setter <<<<<
Procedure Set(*This.Private_Members, *Other.Private_Members)
*This\Status = *Other\Status
*This\Sign = *Other\Sign
CopyList(*Other\Limbs(), *This\Limbs())
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Reset operator <<<<<
Procedure Reset(*This.Private_Members)
*This\Status = #CORRECT
*This\Sign = #POSITIVE
ClearList(*This\Limbs())
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Copy operatror <<<<<
Procedure.i Copy(*This.Private_Members)
*Copy.Private_Members = AllocateStructure(Private_Members)
*Copy\VirtualTable = ?START_METHODS
*Copy\Status = *This\Status
*Copy\Sign = *This\Sign
CopyList(*This\Limbs(), *Copy\Limbs())
ProcedureReturn *Copy
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Swapping operator <<<<<
Procedure Swapping(*This.Private_Members, *Other.Private_Members)
Swap *This\Status, *Other\Status
Swap *This\Sign, *Other\Sign
NewList TempThis.q()
NewList TempOther.q()
CopyList(*This\Limbs(), TempThis())
CopyList(*Other\Limbs(), TempOther())
CopyList(TempOther(), *This\Limbs())
CopyList(TempThis(), *Other\Limbs())
FreeList(TempThis())
FreeList(TempOther())
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Error operator (Private) <<<<<
Procedure Private_Error(*This.Private_Members, type, stype)
If type >= 0
type = stype
EndIf
*This\Status = type
Debug "ERROR " + Str(type)
ProcedureReturn Type
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The To_String transformation operator <<<<<
Procedure.s To_String(*This.Private_Members, Group.i = 0)
If *This\Status < #CORRECT
Select *This\Status
Case #UNDEFINED
VFN_2_String.s = "Undefined"
Case #INFINITIVE
VFN_2_String = "Infinitive"
If *This\Sign
VFN_2_String = "Minus " + VFN_2_String
EndIf
Case #OVERFLOW
VFN_2_String = "Overflow"
Case #NOT_IMPLEMENTED
VFN_2_String = "Not Implemented"
Case #DIVISION_BY_ZERO
VFN_2_String = "Division by zero"
EndSelect
ProcedureReturn VFN_2_String
Else
If LastElement(*This\Limbs())
VFN_2_String + Str(*This\Limbs())
While PreviousElement(*This\Limbs())
VFN_2_String + RSet(Str(*This\Limbs()), #LIMB_SIZE, "0")
Wend
Else
VFN_2_String + "0"
EndIf
If Group <= 0
If *This\Sign
FormatedNumber.s = "-" + VFN_2_String
Else
FormatedNumber = VFN_2_String
EndIf
ElseIf Group >= 1
NumberLen = Len(VFN_2_String)
Start = NumberLen % Group
FormatedNumber = Left(VFN_2_String, Start)
CharsID = Start + 1
While CharsID <= NumberLen - Start
FormatedNumber + " " + Mid(VFN_2_String, CharsID, Group)
CharsID + Group
Wend
FormatedNumber = LTrim(FormatedNumber)
If *This\Sign
FormatedNumber = "-" + FormatedNumber
EndIf
EndIf
ProcedureReturn FormatedNumber
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The From_String transformation operator <<<<<
Procedure From_String(*This.Private_Members, P_String.s)
Reset(*This)
*This\Sign = #POSITIVE
If FindString(P_String, " ")
P_String = RemoveString(P_String, " ")
EndIf
NumID = Len(P_String) - #LIMB_SIZE
While NumID > 0
AddElement(*This\Limbs())
*This\Limbs() = Val(Mid(P_String, NumID + 1, #LIMB_SIZE))
NumID - #LIMB_SIZE
Wend
NumID = Val(Mid(P_String, 1, 9 + NumID))
If NumID < 0
*This\Sign = #NEGATIVE
NumID = -NumID
EndIf
AddElement(*This\Limbs())
*This\Limbs() = NumID
*This\Status = #CORRECT
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The ZapLeadZeroes operator <<<<<
Procedure ZapLeadZeroes(*This.Private_Members)
; Strip leading zeros (000.000.000)
If LastElement(*This\Limbs())
Exit_Condition.b = #False
While Exit_Condition = #False
If *This\Limbs() = 0
DeleteElement(*This\Limbs())
If LastElement(*This\Limbs()) = #Null
Exit_Condition = #True
EndIf
ElseIf *This\Limbs() <> 0
Exit_Condition = #True
EndIf
Wend
EndIf
If ListSize(*This\Limbs()) = 0
AddElement(*This\Limbs())
*This\Limbs() = 0
*This\Status = #CORRECT
*This\Sign = #POSITIVE
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Zero operator <<<<<
Procedure Zero(*This.Private_Members)
ClearList(*This\Limbs())
*This\Status = #CORRECT
*This\Sign = #POSITIVE
AddElement(*This\Limbs())
*This\Limbs() = 0
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The One operator <<<<<
Procedure One(*This.Private_Members)
ClearList(*This\Limbs())
*This\Status = #CORRECT
*This\Sign = #POSITIVE
AddElement(*This\Limbs())
*This\Limbs() = 1
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Absolute operator <<<<<
Procedure Absolute(*This.Private_Members)
*This\Sign = #POSITIVE
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The IsEqual test operator <<<<<
Procedure.b IsEqual(*This.Private_Members, *Other.Private_Members, Abs.b = 0)
If ListSize(*This\Limbs()) <> ListSize(*Other\Limbs())
ProcedureReturn #False
ElseIf (Abs = 0) And (*This\Sign <> *Other\Sign)
ProcedureReturn #False
Else
FirstElement(*Other\Limbs())
ForEach *This\Limbs()
If *This\Limbs() <> *Other\Limbs()
ProcedureReturn #False
EndIf
NextElement(*Other\Limbs())
Next
ProcedureReturn #True
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The IsGreaterThan test operator <<<<<
Procedure.b IsGreaterThan(*This.Private_Members, *Other.Private_Members, Abs.b = 0)
If *This = *Other
ProcedureReturn #False
EndIf
If Abs = 0
If *This\Sign <> *Other\Sign
If *This\Sign = #POSITIVE
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
Else
If ListSize(*This\Limbs()) > ListSize(*Other\Limbs())
ProcedureReturn #True
ElseIf ListSize(*This\Limbs()) < ListSize(*Other\Limbs())
ProcedureReturn #False
Else
FirstElement(*Other\Limbs())
ForEach *This\Limbs()
Delta = *This\Limbs() - *Other\Limbs()
If Delta > 0
ProcedureReturn #True
ElseIf Delta < 0
ProcedureReturn #False
EndIf
NextElement(*Other\Limbs())
Next
ProcedureReturn #False
EndIf
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The IsPositive test operator <<<<<
Procedure.b IsPositive(*This.Private_Members)
If *This\Sign = #POSITIVE
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Positive operator <<<<<
Procedure Positive(*This.Private_Members)
*This\Sign = #POSITIVE
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Negative operator <<<<<
Procedure Negative(*This.Private_Members)
*This\Sign = #NEGATIVE
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add operator (Private) <<<<<
Procedure Private_Add(*Result.Private_Members, *CacheA.Private_Members, *CacheB.Private_Members)
Protected s.q
*Result\Sign = *CacheA\Sign
If ListSize(*CacheA\Limbs()) < ListSize(*CacheB\Limbs())
Swap *CacheA, *CacheB
EndIf
ForEach *CacheA\Limbs()
s + *CacheA\Limbs()
If ListIndex(*CacheA\Limbs()) < ListSize(*CacheB\Limbs())
SelectElement(*CacheB\Limbs(), ListIndex(*CacheA\Limbs()))
s + *CacheB\Limbs()
EndIf
AddElement(*Result\Limbs())
*Result\Limbs() = s % #RADIX
s / #RADIX
Next
If s <> 0
AddElement(*Result\Limbs())
*Result\Limbs() = s
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Substract operator (Private) <<<<<
Procedure Private_Sub(*Result.Private_Members, *CacheA.Private_Members, *CacheB.Private_Members)
Protected s.q
If *CacheA\Sign <> *CacheB\Sign
*CacheB\Sign = *CacheA\Sign
Private_Add(*Result, *CacheA, *CacheB)
Else
If IsGreaterThan(*CacheA, *CacheB, #True)
*Result\Sign = *CacheA\Sign
Else
Swap *CacheA, *CacheB
*Result\Sign = #NEGATIVE - *CacheA\Sign
EndIf
ForEach *CacheA\Limbs()
s + *CacheA\Limbs()
If ListIndex(*CacheA\Limbs()) < ListSize(*CacheB\Limbs())
SelectElement(*CacheB\Limbs(), ListIndex(*CacheA\Limbs()))
s - *CacheB\Limbs()
EndIf
If s < 0
AddElement(*Result\Limbs())
*Result\Limbs() = s + #RADIX
s = -1
Else
AddElement(*Result\Limbs())
*Result\Limbs() = s
s = 0
EndIf
Next
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Plus operator : N = T + A <<<<<
Procedure.i Plus(*This.Private_Members, *Other.Private_Members, *Error.Byte = #Null)
*New.Private_Members = AllocateStructure(Private_Members)
*New\VirtualTable = ?START_METHODS
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Error = Private_Error(*New, *CacheA\Status, *CacheB\Status)
If *Error <> #Null
*Error\b = Error
EndIf
Else
If *CacheA\Sign <> *CacheB\Sign
*CacheB\Sign = *CacheA\Sign
Private_Sub(*New, *CacheA, *CacheB)
Else
Private_Add(*New, *CacheA, *CacheB)
EndIf
ZapLeadZeroes(*New)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn *New
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Minus operator : N = T - A <<<<<
Procedure.i Minus(*This.Private_Members, *Other.Private_Members, *Error.Byte = #Null)
*New.Private_Members = AllocateStructure(Private_Members)
*New\VirtualTable = ?START_METHODS
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Error = Private_Error(*New, *CacheA\Status, *CacheB\Status)
If *Error <> #Null
*Error\b = Error
EndIf
Else
If *CacheA\Sign <> *CacheB\Sign
*CacheB\Sign = *CacheA\Sign
Private_Add(*New, *CacheA, *CacheB)
Else
Private_Sub(*New, *CacheA, *CacheB)
EndIf
ZapLeadZeroes(*This)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn *New
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Add operator : T = T + A <<<<<
Procedure Add(*This.Private_Members, *Other.Private_Members)
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
Reset(*This)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Error = Private_Error(*This, *CacheA\Status, *CacheB\Status)
Else
If *CacheA\Sign <> *CacheB\Sign
*CacheB\Sign = *CacheA\Sign
Private_Sub(*This, *CacheA, *CacheB)
Else
Private_Add(*This, *CacheA, *CacheB)
EndIf
ZapLeadZeroes(*This)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn Error
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Substract operator : T = T - A <<<<<
Procedure Substract(*This.Private_Members, *Other.Private_Members)
Protected s.q
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
Reset(*This)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Error = Private_Error(*This, *CacheA\Status, *CacheB\Status)
Else
If *CacheA\Sign <> *CacheB\Sign
*CacheB\Sign = *CacheA\Sign
Private_Add(*This, *CacheA, *CacheB)
Else
Private_Sub(*This, *CacheA, *CacheB)
EndIf
ZapLeadZeroes(*This)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn Error
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Product operator : N = T * A <<<<<
Procedure.i Product(*This.Private_Members, *Other.Private_Members)
Protected s.q
*New.Private_Members = AllocateStructure(Private_Members)
*New\VirtualTable = ?START_METHODS
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Private_Error(*New, *CacheA\Status, *CacheB\Status)
Else
*This\Sign = (*CacheA\Sign + *CacheB\Sign) & 1
For Index = 0 To (ListSize(*CacheA\Limbs()) + ListSize(*CacheB\Limbs())) - 1
AddElement(*New\Limbs())
*New\Limbs() = 0
Next
ForEach *CacheA\Limbs()
ForEach *CacheB\Limbs()
C_Index = ListIndex(*CacheA\Limbs()) + ListIndex(*CacheB\Limbs())
SelectElement(*New\Limbs(), C_Index)
s = *CacheA\Limbs() * *CacheB\Limbs() + *New\Limbs()
*New\Limbs() = s % #RADIX
SelectElement(*New\Limbs(), C_Index + 1)
*New\Limbs() = *New\Limbs() + s / #RADIX
Next
Next
ZapLeadZeroes(*New)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn *New
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Multiply operator : T = T * A <<<<<
Procedure Multiply(*This.Private_Members, *Other.Private_Members)
Protected s.q
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = Copy(*Other)
Reset(*This)
If *CacheA\Status < #CORRECT Or *CacheB\Status < #CORRECT
Error = Private_Error(*This, *CacheA\Status, *CacheB\Status)
Else
*This\Sign = (*CacheA\Sign + *CacheB\Sign) & 1
For Index = 0 To (ListSize(*CacheA\Limbs()) + ListSize(*CacheB\Limbs())) - 1
AddElement(*This\Limbs())
*This\Limbs() = 0
Next
ForEach *CacheA\Limbs()
ForEach *CacheB\Limbs()
C_Index = ListIndex(*CacheA\Limbs()) + ListIndex(*CacheB\Limbs())
SelectElement(*This\Limbs(), C_Index)
s = *CacheA\Limbs() * *CacheB\Limbs() + *This\Limbs()
*This\Limbs() = s % #RADIX
SelectElement(*This\Limbs(), C_Index + 1)
*This\Limbs() = *This\Limbs() + s / #RADIX
Next
Next
ZapLeadZeroes(*This)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn Error
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Halve operator <<<<<
Procedure Halve(*This.Private_Members, *Residue.Private_Members = #Null)
LastElement(*This\Limbs())
While ListIndex(*This\Limbs()) > 0
If *This\Limbs() & 1 = 1
PushListPosition(*This\Limbs())
SelectElement(*This\Limbs(), ListIndex(*This\Limbs()) - 1)
*This\Limbs() + #Radix
PopListPosition(*This\Limbs())
EndIf
*This\Limbs() = *This\Limbs() >> 1
PreviousElement(*This\Limbs())
Wend
FirstElement(*This\Limbs())
If *Residue <> #Null
If *This\Limbs() & 1 = 1
One(*Residue)
Else
Zero(*Residue)
EndIf
*Residue\Sign = *This\Sign
EndIf
*This\Limbs() = *This\Limbs() >> 1
ZapLeadZeroes(*This)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Double operator <<<<<
Procedure Double(*This.Private_Members)
ForEach *This\Limbs()
If *This\Limbs() > (#Radix >> 1) - 1
*This\Limbs() << 1 - #Radix + Carry
Carry = 1
Else
*This\Limbs() << 1 + Carry
Carry = 0
EndIf
Next
If Carry = 1
AddElement(*This\Limbs())
For Index = 0 To ListSize(*This\Limbs()) - 2
SelectElement(*This\Limbs(), Index)
Temp.q = *This\Limbs()
SelectElement(*This\Limbs(), Index+1)
*This\Limbs() = Temp
Next
LastElement(*This\Limbs())
*This\Limbs() = 1
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Increment operator <<<<<
Procedure Increment(*This.Private_Members)
*One.Private_Members = New("1")
Add(*This, *One)
FreeStructure(*One)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Decrement operator <<<<<
Procedure Decrement(*This.Private_Members)
*One.Private_Members = New("1")
SubStract(*This, *One)
FreeStructure(*One)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Square operator <<<<<
Procedure Square(*This.Private_Members)
If ListSize(*This\Limbs()) > 0
Error = Multiply(*This, *This)
EndIf
ProcedureReturn Error
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Power operator <<<<<
Procedure.i Power(*This.Private_Members, Exponent.l, *Error.Byte = #Null)
Protected z.q = 0, s.q
*New.Private_Members = AllocateStructure(Private_Members)
*New\VirtualTable = ?START_METHODS
If Exponent < 0
; a^b | b<0 not implemented for now...
Error = Private_Error(*New, #NOT_IMPLEMENTED, 0)
If *Error <> #Null
*Error\b = Error
EndIf
ElseIf ListSize(*This\Limbs()) >= 0
*CacheA.Private_Members = Copy(*This)
*CacheB.Private_Members = New("1")
If IsPositive(*This) = #False
Absolute(*CacheA)
If Exponent & 1
*CacheB\Sign = #NEGATIVE
EndIf
EndIf
While Exponent > 0
s = 1 << z
If Exponent & s
Multiply(*CacheB, *CacheA)
Exponent = Exponent - s
EndIf
If Exponent
Square(*CacheA)
z = z + 1
EndIf
Wend
Set(*New, *CacheB)
EndIf
FreeStructure(*CacheA)
FreeStructure(*CacheB)
ProcedureReturn *New
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Divide operator (Private) <<<<<
Procedure Private_Divide(*Answer.Private_Members, *Numerator.Private_Members, *Divisor.Private_Members, *Residue.Private_Members = #Null)
Protected Carry.q, Divisor.q, Dividend.q
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If *Numerator\Status < #CORRECT Or *Divisor\Status < #CORRECT
Private_Error(*Answer, *Numerator\Status, *Divisor\Status)
Else
;// First eliminate the simple case where the divisor is 1 limb
If ListSize(*Divisor\Limbs()) = 1
FirstElement(*Divisor\Limbs())
If *Divisor\Limbs() = 0
*Answer\Status = #DIVISION_BY_ZERO
ElseIf *Divisor\Limbs() = 1 ; Division by +/- 1
*Answer\Status = *Numerator\Status
If *Divisor\Sign = *Numerator\Sign
*Answer\Sign = #POSITIVE
Else
*Answer\Sign = #NEGATIVE
EndIf
CopyList(*Numerator\Limbs(), *Answer\Limbs())
Else
ClearList(*Answer\Limbs())
If *Divisor\Sign = *Numerator\Sign
*Answer\Sign = #POSITIVE
Else
*Answer\Sign = #NEGATIVE
EndIf
*Answer\Status = #CORRECT
LastElement(*Numerator\Limbs())
Repeat
Dividend = Carry * #Radix + *Numerator\Limbs()
If Dividend < *Divisor\Limbs()
InsertElement(*Answer\Limbs())
*Answer\Limbs() = 0
Carry = Dividend
Else
InsertElement(*Answer\Limbs())
*Answer\Limbs() = Dividend / *Divisor\Limbs()
Carry = Dividend - *Answer\Limbs() * *Divisor\Limbs()
;// This is almost free compared to the use of % (Mod)
EndIf
Until PreviousElement(*Numerator\Limbs()) = #Null
If *Residue <> #Null
Reset(*Residue)
AddElement(*Residue\Limbs())
*Residue\Limbs() = Carry
*Residue\Sign = *Numerator\Sign
*Residue\Status = #CORRECT
EndIf
EndIf
EndIf
EndIf
If *Residue <> #Null
ZapLeadZeroes(*Residue)
EndIf
ZapLeadZeroes(*Answer)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Divide operator : N = T / A <<<<<
Procedure.i Divide(*This.Private_Members, *Divisor.Private_Members, *Residue.Private_Members)
*Answer.Private_Members = AllocateStructure(Private_Members)
*Answer\VirtualTable = ?START_METHODS
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If *This\Status < #CORRECT Or *Divisor\Status < #CORRECT
Private_Error(*Answer, *This\Status, *Divisor\Status)
Else
If ListSize(*Divisor\Limbs()) = 1
FirstElement(*Divisor\Limbs())
If *Divisor\Limbs() = 0
*Answer\Status = #DIVISION_BY_ZERO
Zero(*Residue)
ProcedureReturn *Answer
EndIf
EndIf
ZapLeadZeroes(*Divisor)
*One.Private_Members = New("1")
StringDivisor.s = RemoveString(To_String(*Divisor, 0), "-")
M.q = Len(StringDivisor) - 1
*QuickDivisor.Private_Members = New(Left(StringDivisor, 1))
StringNumerator.s = RemoveString(To_String(*This, 0), "-")
*QuotientCandidate.Private_Members = New()
*CutedNumerator.Private_Members = New(Left(StringNumerator, Len(StringNumerator) - M))
Private_Divide(*QuotientCandidate, *CutedNumerator, *QuickDivisor)
FreeStructure(*CutedNumerator)
*Numerator.Private_Members = Copy(*This)
Absolute(*Numerator)
*ABSDivisor.Private_Members = Copy(*Divisor)
Absolute(*ABSDivisor)
*R_Over_A.Private_Members = New()
*Remainder.Private_Members = Plus(*ABSDivisor, *One)
While Exit_Condition = #False
*ABSRemainder.Private_Members = Copy(*Remainder)
Absolute(*ABSRemainder)
If IsGreaterThan(*ABSRemainder, *ABSDivisor, #True) = #False
Exit_Condition = #True
Else
*QxD.Private_Members = Product(*QuotientCandidate, *ABSDivisor)
Zero(*Remainder)
Add(*Remainder, *Numerator)
Substract(*Remainder, *QxD)
StringNumerator.s = RemoveString(To_String(*Remainder, 0), "-")
*CutedNumerator.Private_Members = New(Left(StringNumerator, Len(StringNumerator) - M))
*CutedNumerator\Sign = *Remainder\Sign
Private_Divide(*R_Over_A, *CutedNumerator, *QuickDivisor)
*Qn.Private_Members = Plus(*QuotientCandidate, *R_Over_A)
*QnQ.Private_Members = Plus(*QuotientCandidate, *Qn)
Zero(*QuotientCandidate)
Add(*QuotientCandidate, *QnQ)
Halve(*QuotientCandidate)
FreeStructure(*CutedNumerator)
FreeStructure(*QxD)
FreeStructure(*QnQ)
FreeStructure(*Qn)
EndIf
FreeStructure(*ABSRemainder)
Wend
*QxD.Private_Members = Product(*QuotientCandidate, *ABSDivisor)
Zero(*Remainder)
Add(*Remainder, *Numerator)
Substract(*Remainder, *QxD)
If IsPositive(*Remainder) = #False
Decrement(*QuotientCandidate)
Add(*Remainder, *ABSDivisor)
EndIf
Set(*Answer, *QuotientCandidate)
Set(*Residue, *Remainder)
If *Divisor\Sign = *This\Sign
*Answer\Sign = #POSITIVE
Else
*Answer\Sign = #NEGATIVE
EndIf
*Residue\Sign = *This\Sign
FreeStructure(*QxD)
FreeStructure(*Numerator)
FreeStructure(*ABSDivisor)
FreeStructure(*QuotientCandidate)
FreeStructure(*Remainder)
FreeStructure(*QuickDivisor)
FreeStructure(*One)
FreeStructure(*R_Over_A)
EndIf
ZapLeadZeroes(*Residue)
ZapLeadZeroes(*Answer)
ProcedureReturn *Answer
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Factorial calculator <<<<<
Procedure Factorial(*This.Private_Members, Value.l)
*CacheA.Private_Members = New("1")
*CacheB.Private_Members = New()
For Index = 2 To Value
From_String(*CacheB, Str(Index))
Multiply(*CacheA, *CacheB)
Next
Set(*This, *CacheA)
FreeStructure(*CacheA)
FreeStructure(*CacheB)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Fibonacci calculator <<<<<
Procedure Fibonacci(*This.Private_Members, Value.l)
*V_u.Private_Members = New("0")
*V_v.Private_Members = New("1")
For Index = 2 To Value
*V_t.Private_Members = Plus(*V_u, *V_v)
Set(*V_u, *V_v)
Set(*V_v, *V_t)
FreeStructure(*V_t)
Next
Set(*This, *V_v)
FreeStructure(*V_u)
FreeStructure(*V_v)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Randomize operator <<<<<
Procedure Randomize(*This.Private_Members, MaximumDigitCount.l, MinimumDigitCount.l = 0)
Max = Random(MaximumDigitCount, MinimumDigitCount)
For Index = 0 To Max - 1
RandomNumber.s = RandomNumber + Str(Random(9))
Next
From_String(*This, RandomNumber)
ZapLeadZeroes(*This)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Read in Binary file <<<<<
Procedure ReadVogelsNumberFormat(*This.Private_Members, FileID.i)
*This\Status = ReadWord(FileID)
*This\Sign = ReadWord(FileID)
Num_Max.l = ReadLong(FileID) - 1
For NumID = 0 To Num_Max
AddElement(*This\Limbs())
*This\Limbs() = ReadLong(FileID)
Next
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Write in Binary file <<<<<
Procedure WriteVogelsNumberFormat(*This.Private_Members, FileID.i)
WriteWord(FileID, *This\Status)
WriteWord(FileID, *This\Sign)
WriteLong(FileID, ListSize(*This\Limbs()))
ForEach *This\Limbs()
WriteLong(FileID, *This\Limbs())
Next
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<
Procedure Free(*This.Private_Members)
FreeStructure(*This)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<
Procedure.i New(P_String.s = "0")
*This.Private_Members = AllocateStructure(Private_Members)
*This\VirtualTable = ?START_METHODS
From_String(*This, P_String)
ProcedureReturn *This
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Virtual Table Entries <<<<<
DataSection
START_METHODS:
Data.i @GetStatus()
Data.i @Set()
Data.i @Reset()
Data.i @Copy()
Data.i @Swapping()
Data.i @To_String()
Data.i @From_String()
Data.i @ZapLeadZeroes()
Data.i @Zero()
Data.i @One()
Data.i @Absolute()
Data.i @IsEqual()
Data.i @IsGreaterThan()
Data.i @IsPositive()
Data.i @Positive()
Data.i @Negative()
Data.i @Plus()
Data.i @Minus()
Data.i @Add()
Data.i @Substract()
Data.i @Product()
Data.i @Multiply()
Data.i @Halve()
Data.i @Double()
Data.i @Increment()
Data.i @Decrement()
Data.i @Square()
Data.i @Power()
Data.i @Divide()
Data.i @Factorial()
Data.i @Fibonacci()
Data.i @Randomize()
Data.i @ReadVogelsNumberFormat()
Data.i @WriteVogelsNumberFormat()
Data.i @Free()
END_METHODS:
EndDataSection
EndModule
CompilerIf #PB_Compiler_IsMainFile
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test ZapLeadZeroes"
Debug ""
NumA.VogelsNumberFormat::VNF = VogelsNumberFormat::New("000000000123456789987654321123456789987654321")
Debug NumA\To_String(3)
NumA\ZapLeadZeroes()
Debug NumA\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Swapping"
Debug ""
NumA\Zero()
Debug "A = " + NumA\To_String(3)
NumB.VogelsNumberFormat::VNF = VogelsNumberFormat::New("123456789")
Debug "B = " + NumB\To_String(3)
Debug ""
NumA\Swapping(NumB)
Debug "A = " + NumA\To_String(3)
Debug "B = " + NumB\To_String(3)
Debug ""
Debug "Swapping pointers"
Swap NumA, NumB
Debug ""
Debug "A = " + NumA\To_String(3)
Debug "B = " + NumB\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Plus / Minus"
Debug ""
One.VogelsNumberFormat::VNF = VogelsNumberFormat::New("1")
Two.VogelsNumberFormat::VNF = VogelsNumberFormat::New("2")
X.VogelsNumberFormat::VNF = VogelsNumberFormat::New("12345678987654321")
Y.VogelsNumberFormat::VNF = VogelsNumberFormat::New("4321")
X_Plus_Y.VogelsNumberFormat::VNF = X\Plus(Y)
Debug X_Plus_Y\To_String(3) + " = " + X\To_String(3) + " + " + Y\To_String(3)
X_Minus_Y.VogelsNumberFormat::VNF = X\Minus(Y)
Debug X_Minus_Y\To_String(3) + " = " + X\To_String(3) + " - " + Y\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Add / Substract"
Debug ""
Z.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
MZ.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
Z\Add(X)
Z\Add(Y)
Debug "0 + " + X\To_String(3) + " + " + Y\To_String(3) + " = " + Z\To_String(3)
MZ\Add(X)
MZ\Substract(Y)
Debug "0 + " + X\To_String(3) + " - " + Y\To_String(3) + " = " + MZ\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Product"
Debug ""
X_Two.VogelsNumberFormat::VNF = X\Product(Two)
Two_X.VogelsNumberFormat::VNF = Two\Product(X)
Debug X_Two\To_String(3)
Debug Two_X\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Multiply"
Debug ""
X\Multiply(Two)
Debug X\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Square"
Debug ""
Six.VogelsNumberFormat::VNF = VogelsNumberFormat::New("6")
Six\Square()
Debug "6^2 = " + Six\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Power"
Debug ""
Five.VogelsNumberFormat::VNF = VogelsNumberFormat::New("5")
FivePowerFive.VogelsNumberFormat::VNF = Five\Power(5)
Debug "5^5 = " + FivePowerFive\To_String(3)
TwoPower256.VogelsNumberFormat::VNF = Two\Power(256)
TwoPower256\Substract(One)
Debug "2^256 - 1 = " + TwoPower256\To_String(6)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Factorial"
Debug ""
Factorial.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
For FactorialID = 5 To 50
Factorial\Factorial(FactorialID)
Debug Str(FactorialID) + "! = " + Factorial\To_String(3)
Next
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Fibonacci"
Debug ""
Fibonacci.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
For FibonacciID = 1 To 50
Fibonacci\Fibonacci(FibonacciID)
Debug Str(FibonacciID) + " -> " + Fibonacci\To_String(3)
Next
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Randomize"
Debug ""
Random.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
Random\Randomize(15, 4)
Debug Random\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Halve"
Debug ""
NumZ.VogelsNumberFormat::VNF = VogelsNumberFormat::New("1000000001")
Residue2.VogelsNumberFormat::VNF = VogelsNumberFormat::New()
Debug "NumZ -> " + NumZ\To_String(3)
NumZ\Halve(Residue2)
Debug "NumZ -> " + NumZ\To_String(3)
Debug "Residue -> " + Residue2\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Double"
Debug ""
NumZ\Double()
Debug "NumZ -> " + NumZ\To_String(3)
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Decrement / Increment"
Debug ""
NumZZ.VogelsNumberFormat::VNF = VogelsNumberFormat::New("0")
Debug NumZZ\To_String(0)
For Index = 0 To 4
NumZZ\Decrement()
Debug NumZZ\To_String(0)
Next
For Index = 0 To 4
NumZZ\Increment()
Debug NumZZ\To_String(0)
Next
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Divide"
Debug ""
Var00.q = 987654321
Var01.q = 12345
NumA.VogelsNumberFormat::VNF = VogelsNumberFormat::New(Str(Var00))
NumB.VogelsNumberFormat::VNF = VogelsNumberFormat::New(Str(Var01))
Residue.VogelsNumberFormat::VNF = VogelsNumberFormat::New("")
Answer.VogelsNumberFormat::VNF = NumA\Divide(NumB, Residue)
Debug Answer\To_String(0) + " -> " + Str(Var00 / Var01)
Debug Residue\To_String(0) + " -> " + Str(Var00 % Var01)
CompilerEndIf
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<