VogelsNumberFormat - OOP
Posted: Sun Nov 15, 2020 6:22 am
Hello erevyone,
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
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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<