Excel VBAでBigIntを作ってみた

Sub Test()
  Dim calc As New BICalculator
  Dim num1 As String: num1 = "123,456,789,012,345,678,901,234,567,890,123"
  Dim num2 As String: num2 = "9,876,543,210,987"
  Dim BI As BigInt
  Dim QR As BIDivResult
  
  '足し算
  Set BI = calc.Add(num1, num2, True)
  Debug.Print BI.ValueFmt
  '123,456,789,012,345,678,911,111,111,101,110

  '引き算
  Set BI = calc.Subtract(num1, num2, True)
  Debug.Print BI.ValueFmt
  '123,456,789,012,345,678,891,358,024,679,136

  '掛け算
  Set BI = calc.Multiply(num1, num2, True)
  Debug.Print BI.ValueFmt
  '1,219,326,311,370,137,171,880,013,717,187,996,860,222,381,401

  '割り算
  Set BI = calc.Divide(num1, num2, True)
  Debug.Print BI.ValueFmt
  '12,499,999,886,094,578,126

  '剰余算
  Set BI = calc.Modulo(num1, num2, True)
  Debug.Print BI.ValueFmt
  '5,499,394,819,761

  '商と剰余
  Set QR = calc.DivAndMod(num1, num2)
  Debug.Print QR.Quotient.ValueFmt  '商
  '12,499,999,886,094,578,126
  Debug.Print QR.Remainder.ValueFmt  '剰余
  '5,499,394,819,761
  '検算
  Set BI = calc.Multiply(QR.Quotient, num2, True)
  Set BI = calc.Add(BI, QR.Remainder, True)
  Debug.Print BI.ValueFmt
  '123,456,789,012,345,678,901,234,567,890,123

  '冪乗
  Set BI = calc.Power(256, 256, True)
  Debug.Print BI.ValueFmt
  '32,317,006,071,311,007,300,714,876,688,669,951,960,444,102,669,715,484,032,130,345,427,524,655,138,867,890,893,197,201,411,522,913,463,688,717,960,921,898,019,494,119,559,150,490,921,095,088,152,386,448,283,120,630,877,367,300,996,091,750,197,750,389,652,106,796,057,638,384,067,568,276,792,218,642,619,756,161,838,094,338,476,170,470,581,645,852,036,305,042,887,575,891,541,065,808,607,552,399,123,930,385,521,914,333,389,668,342,420,684,974,786,564,569,494,856,176,035,326,322,058,077,805,659,331,026,192,708,460,314,150,258,592,864,177,116,725,943,603,718,461,857,357,598,351,152,301,645,904,403,697,613,233,287,231,227,125,684,710,820,209,725,157,101,726,931,323,469,678,542,580,656,697,935,045,997,268,352,998,638,215,525,166,389,437,335,543,602,135,433,229,604,645,318,478,604,952,148,193,555,853,611,059,596,230,656
  
  '冪根
  Set BI = calc.Root(num1, 2, True)
  Debug.Print BI.ValueFmt
  '11,111,111,061,111,110
  
  
  '10進数から他の進数へ変換
  Set BI = calc.ToBase(256, 2, True)
  Debug.Print BI.ValueFmt(4, " ", True)
  '0001 0000 0000
  
  '==============================================================
  '注１
  'DivAndMod以外の各メソッドの第3引数(True)を省略すると、String型
  'の値を返すので変数で受けなくてもそのまま使える。
  '例）
  ''引き算
  'Debug.Print calc.Subtract(num1, num2)
  '
  '注２
  'BI.Value => 桁区切り無しの符号付きの値
  'BI.ValueAbs => 桁区切り無しの絶対値
  'BI.ValueFmt => 桁区切り有りの符号付きの値
  '==============================================================
End Sub

Option Explicit

'==========================
'===== Private Fields =====
'==========================
'数値の絶対値を格納するフィールド
Private value_ As String
'数値の符号がマイナスか否かを格納するフィールド
Private negative_ As Boolean

'iterationをする際に数値を分割して格納する配列のフィールド
Private digits_() As LongPtr
'iterationのカウンター変数
Private counter_ As LongPtr
'iterationのカウントの完了値を格納する定数
Private Const COUNT_FINISHED As LongPtr = -1

'LongPtr型の変数に格納可能な桁数の列挙型
Private Enum DigitLength
#If VBA7 And Win64 Then
  'Trueならば64bit処理が可能なのでLongptr⇒LongLong型
  HALF = 9 '２乗しても格納可能な最大桁数
  FULL = 18 '全ての桁に９を格納可能な最大桁数
#Else
  'Falseならば32bit処理になるのでLongptr⇒Long型
  HALF = 4 '２乗しても格納可能な最大桁数
  FULL = 9 '全ての桁に９を格納可能な最大桁数
#End If
End Enum
'digits_の各要素に格納可能な最大桁数を格納するフィールド
Private digitLength_ As Byte


'=======================
'===== Constructor =====
'=======================
Private Sub Class_Initialize()
  value_ = "0"
  negative_ = False
  counter_ = COUNT_FINISHED
End Sub

'======================
'===== Properties =====
'======================
'数値の桁数を取得するプロパティ
Public Property Get Length() As LongPtr
  If value_ = "0" Then
    Length = 0
    Exit Property
  End If
  Length = Len(value_)
End Property

'符号付きの数値を取得するプロパティ
Public Property Get Value() As String
  Value = PutSign(value_)
End Property

'数値の絶対値を取得するプロパティ
Public Property Get ValueAbs() As String
  ValueAbs = value_
End Property

'体裁を調えた数値を取得するプロパティ
'[digits] 区切る桁数を指定する。省略した場合は３桁区切り
'[delimiter] 区切り文字を指定する。省略した場合はカンマ
'[digits] 引数[digits]で指定した桁数に数値が足りない場合0で埋めるか否かを指定する。省略した場合はfalse
Public Property Get ValueFmt( _
  Optional ByVal digits As Integer = 3, _
  Optional ByVal delimiter As String = ",", _
  Optional ByVal fill0s As Boolean = False _
) As String
  
  ValueFmt = ""
  Me.PrepareIteration (digits)
  ValueFmt = CStr(Me.DigitLeft())
  If fill0s Then ValueFmt = Me.To1DigitLength(CLngPtr(ValueFmt))
  Do Until Me.Finished
    ValueFmt = ValueFmt & delimiter & Me.To1DigitLength(Me.DigitLeft())
  Loop
  ValueFmt = PutSign(ValueFmt)
End Property

'１Digit当たりの格納可能最大桁数を取得するプロパティ
Friend Property Get DLFull() As Long
  DLFull = DigitLength.FULL
End Property

'DigitLeftまたはDigitRightメソッドのiterationが終了したか否かを返すプロパティ
Friend Property Get Finished() As Boolean
  Finished = (counter_ = COUNT_FINISHED)
End Property

'==========================
'===== Friend Methods =====
'==========================
'数値をインスタンスに格納するメソッド（一度設定した値は変更不能）
'[strNum] 数値をString型で指定する
Public Sub Init(ByVal strNum As String)
  Static hasValueBeenSet As Boolean
  If hasValueBeenSet Then
    Call Err.Raise(vbObjectError + 387, , _
      "[BigInt.Init]" & vbCrLf & _
      "The value of this instance has been set." & vbCrLf & _
      "This method can only be called once in same instance.")
  End If
  
  If strNum = "" Then Exit Sub
  strNum = Replace(strNum, ",", "") '桁区切りのカンマを除去する
  If InStr(1, strNum, ".") <> 0 Then '小数の場合小数点以下を除去する
    strNum = Split(strNum, ".")(0)
  End If
  If Left(strNum, 1) = "+" Then '+符号が付いている場合除去する
    strNum = Replace(strNum, "+", "")
  End If
  If strNum <> "0" And Left(strNum, 1) = "0" Then '0始まりの数値の場合先頭の0を除去する
    strNum = RemoveLeading0s(strNum)
  End If
  If strNum = "-0" Then strNum = "0"
  If Not IsInteger(strNum) Then '整数として識別可能か判別する
    Call Err.Raise(vbObjectError + 5, , _
      "[BigInt.Init]" & vbCrLf & _
      "Value(" & strNum & ") could not be evaluated as an integer.")
    Exit Sub
  End If
  
  If Left(strNum, 1) = "-" Then '負数の場合-記号を除去し、negative_ = Trueとする
    negative_ = True
    strNum = Replace(strNum, "-", "")
  End If
  value_ = LTrim(RTrim(strNum)) '絶対値化した数値をvalue_に格納する
  
  hasValueBeenSet = True '今後数値の変更を不可とする
  
End Sub

'インスタンスのクローンを作成し返すメソッド
Friend Function Clone() As BigInt
  Set Clone = New BigInt
  Call Clone.Init(Me.Value)
  If Me.IsNegative Then Clone.ToNegative
End Function

'DigitLeftまたはDigitRightメソッドのiterationの準備メソッド
'[Full_Half] digits_の各要素に格納する数値の桁数を指定する
Friend Sub PrepareIteration(ByVal Full_Half As String)
  Dim strNum As String: strNum = value_
  Dim start As Long: start = Len(strNum) + 1 'Mid()の引数Startの値を格納
  Dim lenUnits As Long, i As Long
  
  Select Case Full_Half
    Case "Full": digitLength_ = DigitLength.FULL
    Case "Half": digitLength_ = DigitLength.HALF
    Case Else
      If IsInteger(Full_Half) Then digitLength_ = CLngPtr(Full_Half)
  End Select
  lenUnits = CLng(Int(Len(strNum) / digitLength_))
  If Len(strNum) Mod digitLength_ = 0 Then lenUnits = lenUnits - 1
  ReDim digits_(lenUnits)
  '数値の右端から順にdigitLength_毎に区切った数値をdigits_に移す
  For i = lenUnits To 0 Step -1
    start = start - digitLength_
    If start < 1 Then start = 1
    digits_(i) = CLngPtr(Mid(strNum, start))
    Mid(strNum, start, digitLength_) = String(digitLength_, " ")
    strNum = RTrim(strNum)
  Next i
  GoTo Last:

Last:
  InitializeCounter
End Sub

'digits_の各要素を左側（全体の位が大きい側）から返すメソッド
'[alternative] カウント終了後に呼ばれた場合に返す値を指定する
Friend Function DigitLeft(Optional alternative As Variant = Null) As LongPtr
  '返すdigits_がなくなった⇒以降alternativeを返す
  If counter_ = COUNT_FINISHED Then
    DigitLeft = alternative
    Exit Function
  End If
  'digits_から返す要素を選択・代入
  DigitLeft = digits_(UBound(digits_) - counter_)
  'カウンター変数のデクリメント
  counter_ = counter_ - 1
End Function

'digits_の各要素右側（全体の位が小さい側）から返すメソッド
'[alternative] カウント終了後に呼ばれた場合に返す値を指定する
Friend Function DigitRight(Optional alternative As Variant = Null) As LongPtr
  '返すdigits_がなくなった⇒以降alternativeを返す
  If counter_ = COUNT_FINISHED Then
    DigitRight = alternative
    Exit Function
  End If
  'digits_から返す要素を選択・代入
  DigitRight = digits_(counter_)
  'カウンター変数のデクリメント
  counter_ = counter_ - 1
End Function

'digits_のカウンター変数counter_を初期化するメソッド
Friend Sub InitializeCounter()
  counter_ = UBound(digits_)
End Sub

'１Digitのサイズに０埋めで桁数を揃えるメソッド
'[lptNum] 数値をLongPtr型で指定する
Friend Function To1DigitLength(ByVal lptNum As LongPtr) As String
  To1DigitLength = Format(CStr(lptNum), String(digitLength_, "0"))
End Function

'１Digit相当の10進数の値を返すメソッド
Friend Function DecOf1Digit() As Variant
  DecOf1Digit = 10 ^ digitLength_
End Function

'iteration中の現在のdigits_の桁数に相当する10進数に調えるメソッド
'[strNum] 数値をString型で指定する
Friend Function AdjustMagnitude(ByVal strNum As String) As String
  Dim len0s As Long: len0s = (UBound(digits_) - (counter_ + 1)) * digitLength_
  AdjustMagnitude = strNum & String(len0s, "0")
End Function

'除算に使用する概算の除数を生成するメソッド
Friend Function GenApproxDivisor() As BigInt
  Set GenApproxDivisor = New BigInt
  If Me.IsLessThan1DLen() Then
    Call GenApproxDivisor.Init(value_)
    Exit Function
  End If
  
  Dim lptDvsrApr As LongPtr, lptLetfDLFull As LongPtr
  lptLetfDLFull = CLngPtr(Left(value_, DigitLength.FULL))
  lptDvsrApr = WorksheetFunction.Ceiling(lptLetfDLFull / 10, 1)
  If lptDvsrApr = CLngPtr(Left(value_, DigitLength.FULL - 1)) Then
    lptDvsrApr = lptDvsrApr + 1
  End If
  Dim len0s As LongPtr: len0s = Me.Length - Len(CStr(lptDvsrApr))
  Dim strDvsrApr As String: strDvsrApr = CStr(lptDvsrApr) & String(len0s, "0")
  Call GenApproxDivisor.Init(strDvsrApr)
End Function

'１Digit相当の桁数よりもインスタンスの数値の桁数が短い否かを判別するメソッド
Friend Function IsLessThan1DLen() As Boolean
  IsLessThan1DLen = Me.Length < DigitLength.FULL
End Function

'数値が正の数であるか否かを返すメソッド
Friend Function IsPositive() As Boolean
  IsPositive = Not negative_
End Function
'数値が負の数であるか否かを返すメソッド
Friend Function IsNegative() As Boolean
  IsNegative = negative_
End Function

'数値の符号をプラスに変更するメソッド
Friend Sub ToPositive()
  negative_ = False
End Sub
'数値の符号をマイナスに変更するメソッド
Friend Sub ToNegative()
  negative_ = True
End Sub
'数値の符号を反転するメソッド
Friend Sub InvertSign()
  negative_ = Not negative_
End Sub

'数値が奇数であるか否かを返すメソッド
Friend Function IsOdd() As Boolean
  IsOdd = CInt(Right(value_, 1)) Mod 2 = 1
End Function

'本インスタンスの数値と引数otherの数値の大小を比較するメソッド
'本インスタンスの数値 > 引数otherの数値 ⇒ 1を返す
'本インスタンスの数値 = 引数otherの数値 ⇒ 0を返す
'本インスタンスの数値 < 引数otherの数値 ⇒ -1を返す
'[other] 比較対象のBigiInt型の値を指定する
Friend Function CompareAbs(ByVal other As BigInt) As Long
  '絶対値の桁数で大小比較する
  Select Case Me.Length
    Case Is > other.Length: CompareAbs = 1: Exit Function
    Case Is < other.Length: CompareAbs = -1: Exit Function
    Case Is = other.Length
      '絶対値の桁数が等しいので先頭から順に大小比較する
      Dim cMe As BigInt: Set cMe = Me.Clone
      Dim cOt As BigInt: Set cOt = other.Clone
      Call cMe.PrepareIteration("Full")
      Call cOt.PrepareIteration("Full")
      Dim valMe As LongPtr, valOt As LongPtr
      Do
        valMe = cMe.DigitLeft(-1)
        valOt = cOt.DigitLeft(-1)
        Select Case valMe
          Case Is > valOt: CompareAbs = 1: Exit Function
          Case Is < valOt: CompareAbs = -1: Exit Function
        End Select
      Loop Until cMe.Finished And cOt.Finished
      '大小比較の結果も等しいので同値
      CompareAbs = 0
  End Select
  
End Function


'===========================
'===== Support Methods =====
'===========================
'引数で指定した文字列型の値が整数として認識可能かを判別するメソッド
'[strValue] 文字列型の値を指定する
Private Function IsInteger(ByVal strValue As String) As Boolean
  Dim regex As New RegExp
  'RegExp: メニュー⇒参照設定⇒Microsoft VBScript Regular Expressions 5.5 にチェック
  regex.Pattern = "^(0|\-?[1-9][0-9]*)$"
  regex.Global = True
  
  IsInteger = regex.Test(strValue)
End Function

'先頭が0始まりの数値の場合先頭の0を除去する（複数個ある場合はすべて除去）
'[strNum] 数値をString型で指定する
Private Function RemoveLeading0s(ByVal strNum As String) As String
  Dim i As Long
  '先頭から順に検索し0以外の数値以降の数値返す
  For i = 1 To Len(strNum)
    If Mid(strNum, i, 1) <> "0" Then
      RemoveLeading0s = Mid(strNum, i)
      Exit Function
    End If
  Next i
  '全て0の場合は"0"を返す
  RemoveLeading0s = "0"
End Function

'文字列型の数値に符号を付けて返すメソッド
'[strNum] 数値をString型で指定する
Private Function PutSign(ByVal strNum As String) As String
  If negative_ Then
    PutSign = "-" & strNum
    Exit Function
  End If
  
  PutSign = strNum
End Function

Option Explicit

'=====================================
'===== Public Arithmetic Methods =====
'=====================================

'足し算の和を返すメソッド
'[num1] 数値1をString型等で指定する
'[num2] 数値2をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
' falseを指定した場合はString型で返す
Public Function Add( _
  ByVal num1 As Variant, _
  ByVal num2 As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(num1)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(num2)
  Dim ans As BigInt
  
  Select Case True
    Case bi1.Value = "0": Set ans = bi2 '0 + num2 = num2
    Case bi2.Value = "0": Set ans = bi1 'num1 + 0 = num1
    Case bi1.IsPositive And bi2.IsPositive
      Set ans = CalcSum(bi1, bi2)
    Case bi1.IsPositive And bi2.IsNegative
      Select Case bi1.CompareAbs(bi2)
        Case 1: Set ans = CalcDifference(bi1, bi2)
        Case -1: Set ans = CalcDifference(bi2, bi1): Call ans.ToNegative
        Case 0: Set ans = New BigInt
      End Select
    Case bi1.IsNegative And bi2.IsPositive
      Select Case bi1.CompareAbs(bi2)
        Case 1: Set ans = CalcDifference(bi2, bi1)
        Case -1: Set ans = CalcDifference(bi1, bi2): Call ans.ToNegative
        Case 0: Set ans = New BigInt
      End Select
    Case bi1.IsNegative And bi2.IsNegative
      Set ans = CalcSum(bi1, bi2): Call ans.ToNegative
  End Select
    
  If returnBigInt Then
    Set Add = ans
    Exit Function
  End If
  Add = ans.Value
  
End Function

'引き算の差を返すメソッド
'[num1] 数値1をString型等で指定する
'[num2] 数値2をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する。
' falseを指定した場合はString型で返す
Public Function Subtract( _
  ByVal num1 As Variant, _
  ByVal num2 As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(num1)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(num2)
  Dim ans As BigInt
  
  Select Case True
    Case bi1.Value = "0": Set ans = bi2: Call ans.InvertSign
    Case bi2.Value = "0": Set ans = bi1
    Case bi1.IsPositive And bi2.IsPositive
      Select Case bi1.CompareAbs(bi2)
        Case 1: Set ans = CalcDifference(bi1, bi2)
        Case -1: Set ans = CalcDifference(bi2, bi1): Call ans.ToNegative
        Case 0: Set ans = New BigInt
      End Select
    Case bi1.IsPositive And bi2.IsNegative
      Set ans = CalcSum(bi1, bi2)
    Case bi1.IsNegative And bi2.IsPositive
      Set ans = CalcSum(bi1, bi2): Call ans.ToNegative
    Case bi1.IsNegative And bi2.IsNegative
      Select Case bi1.CompareAbs(bi2)
        Case 1: Set ans = CalcDifference(bi1, bi2): Call ans.ToNegative
        Case -1: Set ans = CalcDifference(bi2, bi1)
        Case 0: Set ans = New BigInt
      End Select
  End Select
  
  If returnBigInt Then
    Set Subtract = ans
    Exit Function
  End If
  Subtract = ans.Value
  
End Function

'掛け算の積を返すメソッド
'[num1] 数値1をString型等で指定する
'[num2] 数値2をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
' falseを指定した場合はString型で返す
Public Function Multiply( _
  ByVal num1 As Variant, _
  ByVal num2 As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(num1)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(num2)
  Dim ans As BigInt
  
  If bi1.Value = "0" Or bi2.Value = "0" Then
    Set ans = New BigInt
    GoTo Last:
  End If
  
  Dim isMinus As Boolean: isMinus = bi1.IsPositive Eqv bi2.IsNegative
  Set ans = CalcProduct(bi1, bi2)
  If isMinus Then Call ans.ToNegative
  
Last:
  If returnBigInt Then
    Set Multiply = ans
    Exit Function
  End If
  Multiply = ans.Value
  
End Function

'割り算の商を返すメソッド
'[dividend] 被除数をString型等で指定する
'[divisor] 除数をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
' falseを指定した場合はString型で返す
Public Function Divide( _
  ByVal dividend As Variant, _
  ByVal divisor As Variant, _
  Optional returnBigInt = False _
) As Variant
  
  Dim ans As BIDivResult
  
Try: On Error GoTo Catch:
  Set ans = DivAndMod(dividend, divisor)
  GoTo Finally:
  
Catch:
  If Err.number = 11 Then
    Call Err.Raise(vbObjectError + 11, , _
      "[BICalculator.Divide]" & vbCrLf & _
      "Tried to divide by 0." & vbCrLf & _
      "Divisor must be a non-zero integer.")
  End If
  
Finally:
  If returnBigInt Then
    Set Divide = ans.Quotient
    Exit Function
  End If
  Divide = ans.Quotient.Value
  
End Function

'割り算の剰余を返すメソッド
'[dividend] 被除数をString型等で指定する
'[divisor] 除数をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
' falseを指定した場合はString型で返す
Public Function Modulo( _
  ByVal dividend As Variant, _
  ByVal divisor As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim ans As BIDivResult
  
Try: On Error GoTo Catch:
  Set ans = DivAndMod(dividend, divisor)
  GoTo Finally:
  
Catch:
  If Err.number = 11 Then
    Call Err.Raise(vbObjectError + 11, , _
      "[BICalculator.Modulo]" & vbCrLf & _
      "Tried to divide by 0." & vbCrLf & _
      "Divisor must be a non-zero integer.")
  End If
  
Finally:
  If returnBigInt Then
    Set Modulo = ans.Remainder
    Exit Function
  End If
  Modulo = ans.Remainder.Value
  
End Function

'割り算の商と剰余を返すメソッド
'[dividend] 被除数をString型等で指定する
'[divisor] 除数をString型等で指定する
Public Function DivAndMod( _
  ByVal dividend As Variant, _
  ByVal divisor As Variant _
) As BIDivResult
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(dividend)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(divisor)
  Dim ans As New BIDivResult
  
  If bi1.Value = "0" Then
    Call ans.SetValues("0", "0")
    GoTo Last:
  End If
  
  If bi2.Value = "0" Then
    Call Err.Raise(vbObjectError + 11, , _
      "[BICalculator.DivAndMod]" & vbCrLf & _
      "Tried to divide by 0." & vbCrLf & _
      "Divisor must be a non-zero integer.")
  End If
  
  Select Case bi1.CompareAbs(bi2)
    Case -1: Call ans.SetValues("0", bi1.Value)
    Case 0: Call ans.SetValues("1", "0")
    Case 1: Set ans = CalcQtntAndRmdr(bi1, bi2)
  End Select

  If bi1.IsPositive Eqv bi2.IsNegative Then ans.Quotient.ToNegative
  If bi1.IsNegative Then ans.Remainder.ToNegative
  
Last:
  Set DivAndMod = ans
  
End Function

'冪を返すメソッド
'[base] 基数をString型等で指定する
'[exponent] 指数をString型等で指定する(分数表記可 ”3/2”等)
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
Public Function Power( _
  ByVal base As Variant, _
  ByVal exponent As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(base)
  Dim bi2 As BigInt
  Dim ans As BigInt
  Dim splited As Variant
  
  If InStr(1, exponent, "/") <> 0 Then
    splited = Split(exponent, "/")
    Set bi2 = ToBigInt(splited(0))
  Else
    Set bi2 = ToBigInt(exponent)
  End If
  
  If bi1.Value = "1" Or bi2.Value = "0" Then
    Set ans = New BigInt
    Call ans.Init("1")
    GoTo Last:
  End If
  
  If bi2.IsNegative Then
    Call Err.Raise(vbObjectError + 5, , _
      "[BICalculator.Power]" & vbCrLf & _
      "Parameter ""exponent"" must be a positive integer.")
  End If
  
  Set ans = CalcPower(bi1, bi2)
  If IsArray(splited) Then
    Set ans = CalcRoot(ans, ToBigInt(splited(1)))
  End If
  If bi1.IsNegative And bi2.IsOdd Then ans.ToNegative
  
Last:
  If returnBigInt Then
    Set Power = ans
    Exit Function
  End If
  Power = ans.Value
  
End Function

'冪根を返すメソッド
'[radicand] 被開数をString型等で指定する
'[index] 指数をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
Public Function Root( _
  ByVal radicand As Variant, _
  ByVal index As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(radicand)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(index)
  Dim ans As BigInt
  
  Select Case True
    Case bi1.IsNegative
      Call Err.Raise(vbObjectError + 5, , _
        "[BICalculator.Root]" & vbCrLf & _
        "Parameter ""radicand"" must be a positive integer.")
    Case bi1.Value = "0"
      Set ans = ToBigInt("0"): GoTo Last:
    Case bi1.Value = "1"
      Set ans = ToBigInt("1"): GoTo Last:
  End Select
  
  Select Case True
    Case bi2.IsNegative, bi2.Value = "0"
      Call Err.Raise(vbObjectError + 5, , _
        "[BICalculator.Root]" & vbCrLf & _
        "Parameter ""index"" must be a positive integer.")
    Case bi2.Value = "1"
      Set ans = bi1: GoTo Last:
  End Select
  
  Set ans = CalcRoot(bi1, bi2)
  
Last:
  If returnBigInt Then
    Set Root = ans
    Exit Function
  End If
  Root = ans.Value
  
End Function

'指定した基数の値に変換するメソッド
'[num] 10進数の値をString型等で指定する
'[Base] 基数をString型等で指定する
'[returnBigInt] 戻り値をBigInt型で返すか否かを指定する
Public Function ToBase( _
  ByVal number As Variant, _
  ByVal base As Variant, _
  Optional returnBigInt As Boolean = False _
) As Variant
  
  Dim bi1 As BigInt: Set bi1 = ToBigInt(number)
  Dim bi2 As BigInt: Set bi2 = ToBigInt(base)
  Dim ans As BigInt
  
  If bi2.Value = "0" Then
    Call Err.Raise(vbObjectError + 5, , _
      "[BICalculator.ToBase]" & vbCrLf & _
      "The parameter ""base"" must be an integer greater than or equal to 2.")
  End If
  
  Set ans = CalcBase(bi1, bi2)
  If bi1.IsNegative Then ans.ToPositive
    
Last:
  If returnBigInt Then
    Set ToBase = ans
    Exit Function
  End If
  ToBase = ans.Value
  
End Function


'=======================================
'===== Private Arithmetic Methods =====
'=======================================
'絶対値の加法メソッド
'[num1] 数値1をBigiInt型で指定する
'[num2] 数値2をBigiInt型で指定する
Private Function CalcSum( _
  ByVal num1 As BigInt, _
  ByVal num2 As BigInt _
) As BigInt
  
  Dim strSum As String '各Digit単位の合計値を連結した総合計を格納
  
Try:   On Error GoTo Catch
  strSum = CStr(CDec(num1.ValueAbs) + CDec(num2.ValueAbs))
  GoTo Finally:
  
Catch:
  '================================================================
  '計算方針：筆算と同様のアルゴリズムで計算する。
  'ただし、LongPtrに格納可能な最大桁数を１Digitのサイズとし、
  '各Digit毎に計算した値をString型で連結して算出する｡
  'Long型     ⇒ ９桁格納可能 ⇒ １Digit＝10億進数
  'LongLong型 ⇒ 18桁格納可能 ⇒ １Digit＝10＾18進数
  '================================================================
  Dim lptSum As LongPtr: lptSum = 0 '各Digit単位の合計値を格納
  Dim lptCrry As LongPtr: lptCrry = 0 '繰り上がりの数値を格納
  
  Call num1.PrepareIteration("Full")
  Call num2.PrepareIteration("Full")
  Do
    lptSum = num1.DigitRight(0) + num2.DigitRight(0) + lptCrry
    If lptSum >= num1.DecOf1Digit() Then
      lptCrry = 1
      lptSum = lptSum - num1.DecOf1Digit()
    Else
      lptCrry = 0
    End If
    strSum = num1.To1DigitLength(lptSum) & strSum
  Loop Until num1.Finished And num2.Finished
  If lptCrry > 0 Then strSum = CStr(lptCrry) & strSum
  
Finally:
  Set CalcSum = ToBigInt(strSum)
  
End Function

'絶対値の減法メソッド
'[numLrg] numSmlより大きい数値をBigiInt型で指定する
'[numSml] numLrgより小さい数値をBigiInt型で指定する
Private Function CalcDifference( _
  ByVal numLrg As BigInt, _
  ByVal numSml As BigInt _
) As BigInt
  
  Dim strDiff As String
  
Try: On Error GoTo Catch
  strDiff = CStr(CDec(numLrg.ValueAbs) - CDec(numSml.ValueAbs))
  GoTo Finally:
  
Catch:
  '================================================================
  '計算方針：CalcSumと同じ
  'Long型     ⇒ ９桁格納可能 ⇒ １Digit＝10億進数
  'LongLong型 ⇒ 18桁格納可能 ⇒ １Digit＝10＾18進数
  '================================================================
  Dim lptDiff As LongPtr: lptDiff = 0
  Dim lptBrrw As LongPtr: lptBrrw = 0
  
  Call numLrg.PrepareIteration("Full")
  Call numSml.PrepareIteration("Full")
  Do
    lptDiff = numLrg.DigitRight(0) - numSml.DigitRight(0) - lptBrrw
    If lptDiff < 0 Then
      lptBrrw = 1
      lptDiff = lptDiff + numLrg.DecOf1Digit()
    Else
      lptBrrw = 0
    End If
    strDiff = numLrg.To1DigitLength(lptDiff) & strDiff
  Loop Until numLrg.Finished And numSml.Finished
  
Finally:
  Set CalcDifference = ToBigInt(strDiff)
  
End Function

'絶対値の乗法メソッド
'[num1] 数値1をBigiInt型で指定する
'[num2] 数値2をBigiInt型で指定する
Private Function CalcProduct( _
  ByVal num1 As BigInt, _
  ByVal num2 As BigInt _
) As BigInt
  
  Dim ans As New BigInt
  
Try: On Error GoTo Catch
  Set ans = ToBigInt(CDec(num1.ValueAbs) * CDec(num2.ValueAbs))
  GoTo Finally:
  
Catch:
  '================================================================
  '計算方針：筆算と同様のアルゴリズムで計算する。
  'ただし、LongPtrに格納可能な最大桁数を１Digitのサイズとし、
  '各Digit同士を掛け合わせ合算してString型で連結して算出する｡
  'Long型     ⇒ ４桁格納可能 ⇒ １Digit＝１万進数
  'LongLong型 ⇒ ９桁格納可能 ⇒ １Digit＝10億進数
  '================================================================
  Dim strProd As String
  Dim lptUnit2 As LongPtr
  Dim lptProd As LongPtr, lptRmdr As LongPtr, lptCrry As LongPtr
  Dim strSum As String
  
  Call ans.Init("0")
  Call num1.PrepareIteration("Half")
  Call num2.PrepareIteration("Half")
  Do
    lptCrry = 0
    strSum = ""
    lptUnit2 = num2.DigitRight(0)
    Call num1.InitializeCounter
    Do
      lptProd = num1.DigitRight(0) * lptUnit2 + lptCrry
      lptRmdr = lptProd Mod num1.DecOf1Digit
      lptCrry = (lptProd - lptRmdr) / num1.DecOf1Digit
      strSum = num1.To1DigitLength(lptRmdr) & strSum
    Loop Until num1.Finished
    If lptCrry > 0 Then strSum = CStr(lptCrry) & strSum
    strSum = num2.AdjustMagnitude(strSum)
    Set ans = Add(ans, strSum, True)
  Loop Until num2.Finished
  
Finally:
  Set CalcProduct = ans
  
End Function

'絶対値の除法と剰余算メソッド
'[numDvdd] 被除数をBigiInt型で指定する
'[numDvsr] 除数をBigiInt型で指定する
Private Function CalcQtntAndRmdr( _
  ByVal numDvdd As BigInt, _
  ByVal numDvsr As BigInt _
) As BIDivResult
  
  Dim ans As New BIDivResult
  
Try: On Error GoTo Catch:
  Dim ansDiv As Variant
  Dim ansMod As Variant
  ansDiv = CDec(numDvdd.ValueAbs) \ CDec(numDvsr.ValueAbs)
  ansMod = CDec(numDvdd.ValueAbs) Mod CDec(numDvsr.ValueAbs)
  Call ans.SetValues(CStr(ansDiv), CStr(ansMod))
  GoTo Finally:
  
Catch:
  '====================================================================
  '基本方針：除法の原理（整除法）を利用して求める。
  'ただし、除数が１Digitのサイズ以上の場合は有効数字[１Digitのサイズ‐１
  ']桁に切り上げた除数の近似値(d)で漸近的に求め、必要であれば減法で精算
  'する。
  '
  '  N = Q * D + R （N:被除数, Q:商, D:除数, R:剰余）
  '
  '1-1).Dの桁数 < １Digitのサイズ
  '  ⇒d = D
  '1-2).Dの桁数 >= １Digitのサイズ
  '  ⇒d = Dを有効数字[１Digitのサイズ - 1]桁に切り上げた値
  '    (例.D=123456789012 ⇒ d=123456790000 (１Digitのサイズ＝９の時))
  '
  '2).筆算（長除法）のアルゴリズムによる計算を、Rn+1 < dを満たすまで繰
  'り返す。この際、d >= D なので Qn+1 <= Q となり Rn+1 >= Rとなる。
  'またループ処理の各回終了時点で、N = Qn+1 * D + Rn+1 は常に成り立つ。
  '（以下、添え字付きのQとRは計算途中での商と剰余を、添え字無しは計算
  '終了後の商と剰余を表す。）
  '  Q0 = 0, R0 = N
  '  Do
  '   Qn+1 = Qn + Rn \ d  ("\":整数部のみを返す除算)
  '   Rn+1 = Rn - (Qn+1 * D)
  '  Loop Until Rn+1 < d
  '  Q = Qn+1, R = Rn+1
  '
  '3).D <= Rn+1 < d の時は2)の方法ではそれ以上近似させることは出来ないの
  'で減法により精算する
  '  R0 = R
  '  Do Until Rn+1 < D
  '   Rn+1 = Rn - D
  '   q = q + 1
  '  Loop
  '  Q = Q + q, R = Rn+1
  '====================================================================
  '1) DArp = d
  Dim DApr As BigInt: Set DApr = numDvsr.GenApproxDivisor()
  '2)
  Dim QnP1 As BigInt, RnP1 As BigInt, Rn As BigInt, DByQnP1 As BigInt
  
  Set Rn = numDvdd
  Do
    Set QnP1 = CalcQtntApprox(Rn, DApr)
    Set DByQnP1 = CalcProduct(QnP1, numDvsr)
    Set RnP1 = CalcDifference(Rn, DByQnP1)
    Set ans.Quotient = CalcSum(ans.Quotient, QnP1)
    Set Rn = RnP1
  Loop Until RnP1.Length <= DApr.Length
  Set ans.Remainder = RnP1
  If numDvsr.IsLessThan1DLen() Then GoTo Finally:
  '3)
  Call CalcQAndRBySubtraction(ans, numDvsr)
  
Finally:
  Set CalcQtntAndRmdr = ans
  
End Function

'絶対値の累乗数を求めるメソッド
'[numBs] 底をBigiInt型で指定する
'[numEx] 指数をBigiInt型で指定する
Private Function CalcPower( _
  ByVal numBs As BigInt, _
  ByVal numEx As BigInt _
) As BigInt

  Dim ans As New BigInt
  
Try: On Error GoTo Catch:
  Set ans = ToBigInt(CDec(numBs.ValueAbs) ^ CDec(numEx.ValueAbs))
  GoTo Finally:
  
Catch:
  Dim binExp As BigInt: Set binExp = CalcBase(numEx, ToBigInt("2"))
  Dim i As Long
  
  Call ans.Init("1")
  Call binExp.PrepareIteration("1")
  Do
    Set ans = CalcProduct(ans, ans.Clone)
    If binExp.DigitLeft = 1 Then
      Set ans = CalcProduct(ans, numBs)
    End If
  Loop Until binExp.Finished
  
Finally:
  Set CalcPower = ans
  
End Function

'絶対値の累乗根を求めるメソッド
'[numRdcd] 被開平数をBigiInt型で指定する
'[numRdcd] 指数をBigiInt型で指定する
Private Function CalcRoot( _
  ByVal numRdcd As BigInt, _
  ByVal numIndx As BigInt _
) As BigInt

  Dim XnP1 As BigInt
  
Try: On Error GoTo Catch:
  Set XnP1 = ToBigInt(CDec(numRdcd.ValueAbs) ^ (1 / CDec(numIndx.ValueAbs)))
  GoTo Finally:
  
Catch:
  Dim Xn As BigInt, expnt As BigInt, expntM1 As BigInt
  Dim cmpr As Long, cmprBfr As Long
  Dim cnt As Integer
  
  Set Xn = GetApproxX0(numRdcd, numIndx)
  Set expnt = numIndx
  Set expntM1 = CalcDifference(numIndx, ToBigInt("1"))
  Do
    Set XnP1 = NewtonsMethod(Xn, numRdcd, expnt, expntM1)
    cmpr = XnP1.CompareAbs(Xn)
    If cmpr = 0 Then Exit Do
    cmprBfr = cmpr
    Set Xn = XnP1
    cnt = cnt + 1
  Loop While cnt < numRdcd.Length
  '大きい値から近似された場合、求める値＋１の値が算出されるので１を引く。
  If cmprBfr = -1 Then Set XnP1 = CalcDifference(XnP1, ToBigInt("1"))
  
Finally:
  Set CalcRoot = XnP1
  
End Function

'10進数から別の進数値を求めるメソッド
'[num] 10進数の値をBigiInt型で指定する
'[numBs] 基数をBigiInt型で指定する
Private Function CalcBase( _
  ByVal num As BigInt, _
  numBs As BigInt _
) As BigInt
  
  Dim strBNum As String
  
Try: On Error GoTo Catch:
  strBNum = WorksheetFunction.base(CDbl(num.ValueAbs), CDbl(numBs.Value))
  GoTo Finally:
  
Catch:
  Dim divBase As New BIDivResult
  
  Set divBase.Quotient = num
  Do Until divBase.Quotient.Value = "0"
    Set divBase = DivAndMod(divBase.Quotient, numBs)
    strBNum = divBase.Remainder.ValueAbs & strBNum
  Loop
  
Finally:
  Set CalcBase = ToBigInt(strBNum)
  
End Function


'============================
'===== Support Methods ======
'============================

'文字列型等の値からBigInt型のインスタンスを生成するメソッド
'[num] BigInt型に変換する値を指定する
Private Function ToBigInt(ByVal num As Variant) As BigInt
  If TypeName(num) = "BigInt" Then
    Set ToBigInt = num
    Exit Function
  End If
  
  If CStr(num) Like "*E+*" Then
    Call Err.Raise(vbObjectError + 6)
  End If
  
  Set ToBigInt = New BigInt
  Call ToBigInt.Init(CStr(num))
End Function

'絶対値の被除数と丸めたの除数から商を概算的に求めるメソッド
'[numDvdd] 被除数をBigiInt型で指定する
'[numDvsr] 概算の除数をBigiInt型で指定する
Private Function CalcQtntApprox( _
  ByVal numDvdd As BigInt, _
  ByVal numDvsr As BigInt _
) As BigInt
  '================================================================
  '計算方針：除数が１Digitよりも大きい場合、除数を１Digit未満に丸め
  'その丸めた除数で概算の商を求める。
  '================================================================
  Dim lptDvdd As LongPtr, lptDvsr As LongPtr, lptQtnt As LongPtr, lptRmdr As LongPtr
  Dim strDvdd As String: strDvdd = numDvdd.ValueAbs
  Dim strQtnt As String, strRmdr As String
  Dim str0s As String
  Dim d As LongPtr
  
  lptDvsr = CLngPtr(Mid(numDvsr.ValueAbs, 1, numDvsr.DLFull - 1))
  str0s = String(Len(CStr(lptDvsr)) - 1, "0")
  For d = 1 To Len(strDvdd)
    lptDvdd = lptDvdd * 10 + Mid(strDvdd, d, 1)
    lptRmdr = lptDvdd Mod lptDvsr
    lptQtnt = lptDvdd \ lptDvsr
    strQtnt = strQtnt & CStr(lptQtnt): If strQtnt = "0" Then strQtnt = ""
    strRmdr = Format(CStr(lptRmdr), str0s) & Mid(strDvdd, d + 1)
    If Len(strRmdr) < numDvsr.Length Then Exit For
    If Len(strRmdr) = numDvsr.Length Then
      If ToBigInt(strRmdr).CompareAbs(numDvsr) = -1 Then Exit For
    End If
    lptDvdd = lptRmdr
  Next d
  
  Set CalcQtntApprox = ToBigInt(strQtnt)

End Function

'絶対値の商と剰余を減法的に求めるメソッド
'[numQR] 概算の商と剰余をBIDivResult型で指定する
'[numDvsr] 除数をBigiInt型で指定する
Private Sub CalcQAndRBySubtraction( _
  ByRef numQR As BIDivResult, _
  ByVal numDvsr As BigInt _
)
  '=================================================================
  '計算方針：numQRの剰余から除数を引き続け、剰余が除数未満になるまで
  '繰り返す。
  '=================================================================
  Dim cntQtnt As LongPtr: cntQtnt = 0
  
  Do Until numQR.Remainder.CompareAbs(numDvsr) = -1
    Set numQR.Remainder = CalcDifference(numQR.Remainder, numDvsr)
    cntQtnt = cntQtnt + 1
  Loop
  If cntQtnt > 0 Then
    Set numQR.Quotient = CalcSum(numQR.Quotient, ToBigInt(cntQtnt))
  End If
End Sub

'ニュートン法により冪根を求めるメソッド
'[Xn] 前回値をBigiInt型で指定する
'[numRdcd] 被開平数をBigiInt型で指定する
'[expnt] 指数をBigiInt型で指定する
'[expntM1] 指数‐１の値をBigiInt型で指定する
Private Function NewtonsMethod( _
  Xn As BigInt, _
  numRdcd As BigInt, _
  expnt As BigInt, _
  expntM1 As BigInt _
) As BigInt

  '================================================================
  '      Xn+1 = Xn - (Xn ^ expnt - numRdcd) / expnt * Xn ^ expntM1
  ' Calc Order:    6     1       2          5       4    3
  '================================================================
  
  Dim calc1 As BigInt: Set calc1 = CalcPower(Xn, expnt)
  Dim calc2 As BigInt: Set calc2 = Subtract(calc1, numRdcd, True)
  Dim calc3 As BigInt: Set calc3 = CalcPower(Xn, expntM1)
  Dim calc4 As BigInt: Set calc4 = CalcProduct(expnt, calc3)
  Dim calc5 As BigInt: Set calc5 = Divide(calc2, calc4, True)
  Dim calc6 As BigInt: Set calc6 = Subtract(Xn, calc5, True)
  
  Set NewtonsMethod = calc6
  
End Function

'NewtonsMethodの初期値(X0)を求めるメソッド
'[numRdcd] 被開平数をBigiInt型で指定する
'[numIndx] 指数をBigiInt型で指定する
Private Function GetApproxX0( _
  ByVal numRdcd As BigInt, _
  ByVal numIndx As BigInt _
) As BigInt
  
  Dim strApproxX0 As String
  Const lenDcmlMax As Integer = 28
  
  '冪根の桁数を求める
  Dim lenX0 As LongPtr
  lenX0 = WorksheetFunction.Ceiling(numRdcd.Length / numIndx.Value, 1)
  strApproxX0 = String(lenX0, "0")
  If numIndx.ValueAbs < lenDcmlMax Then
    '冪指数がDouble型の有効桁数未満の場合は概算の冪根を求める
    Dim strAprroxRdcd As String
    Dim strX0Head As String
    Call numRdcd.PrepareIteration(numIndx.ValueAbs)
    Do
      strAprroxRdcd = strAprroxRdcd & numRdcd.To1DigitLength(numRdcd.DigitLeft(0))
      If Len(strAprroxRdcd) + numIndx.ValueAbs > lenDcmlMax Then Exit Do
    Loop Until numRdcd.Finished
    strX0Head = CStr(Int(CDec(strAprroxRdcd) ^ (1 / numIndx.ValueAbs)))
    Mid(strApproxX0, 1, Len(strX0Head)) = strX0Head
  Else
    '冪指数がDouble型の有効桁数以上の場合は先頭の値を５にした値を求める
    '先頭を５にする理由：求める冪根の値が不明なため、桁数内で下限上限どちらからも等距離にするため
    Mid(strApproxX0, 1, 1) = "5"
  End If
  
  Set GetApproxX0 = ToBigInt(strApproxX0)

End Function

Option Explicit

'==========================
'===== Private Fields =====
'==========================
'商の値を格納するフィールド
Private quotient_ As BigInt
'剰余の値を格納するフィールド
Private remainder_ As BigInt

'=======================
'===== Constructor =====
'=======================
Private Sub Class_Initialize()
  Set quotient_ = New BigInt
  Set remainder_ = New BigInt
End Sub

'======================
'===== Properties =====
'======================
'商の値を取得するプロパティ
Public Property Get Quotient() As BigInt
  Set Quotient = quotient_
End Property
'商の値を設定するプロパティ
Public Property Set Quotient(biQuotient As BigInt)
  Set quotient_ = biQuotient
End Property

'剰余の値を取得するプロパティ
Public Property Get Remainder() As BigInt
  Set Remainder = remainder_
End Property
'剰余の値を設定するプロパティ
Public Property Set Remainder(biRemainder As BigInt)
  Set remainder_ = biRemainder
End Property

'==========================
'===== Friend Methods =====
'==========================
'文字列型の商と剰余の値を一括で設定するメソッド
'[strQuotient] 商の値を文字列型で指定する
'[strRemainder] 剰余の値を文字列型で指定する
Friend Sub SetValues(strQuotient As String, strRemainder As String)
  Call quotient_.Init(strQuotient)
  Call remainder_.Init(strRemainder)
End Sub