محاسبات عددی با دقت بسیار زیاد روی اعداد خیلی بزرگ

[IamOverlord]

سلام دوستان.
تو یکی از برنامه هام که یه سری محاسبات روی ماتریس ها انجام می ده، می خوام دقت کار خیلی بالا بره و همچنین روی اعداد خیلی بزرگ هم بشه محاسبات رو انجام داد. یه چیزی بهتر از Decimal یا Currency لازم دارم.
تا حالا ماژولی، کتابخونه ای، چیزی در این رابطه نوشته شده؟ یا فکر می کنید باید خودمون بنویسیم؟

[arenaw]

سلام
میتونید از روشهای قدیمی که تو دبستان یاد گرفتیم استفاده کنید
مثلا فعلا براتون این رو برای جمع 2 تا عدد صحیح نوشتم که ورودیهاش استرینگه و محدودیتی از نظر بزرگی عددامون نداره:

Function Jam(val1 As String, val2 As String) As String
Dim Adad1$, Adad2$, unBala$, i&, Pr$
unBala = 0
If Len(val1) > Len(val2) Then
Adad1 = val1
Adad2 = val2
Else
Adad1 = val2
Adad2 = val1
End If
Do While Len(Adad2) < Len(Adad1): Adad2 = "0" & Adad2: Loop
For i = Len(Adad1) To 1 Step -1
Pr = Val(Mid(Adad1, i, 1)) + Val(Mid(Adad2, i, 1)) + Val(unBala)
If Len(Pr) > 1 Then
unBala = "1"
Pr = Mid(Pr, 2, 1)
Else
unBala = "0"
End If
Jam = Pr & Jam
Next i
If unBala = 1 Then Jam = "1" & Jam
Do While Mid(Jam, 1, 1) = "0": Jam = Mid(Jam, 2): Loop
If Jam = "" Then Jam = "0"
End Function


مثلا:

Dim J As String
J = Jam("345345334534545192391239239453959343549535", "99439593459812931282765756719389182392183")
MsgBox J 'Return 444784927994358123674004996173348525941718

[m.4.r.m]

اره من ماژولشو تو یکی از همین پست ها گذاشتم جمع و تفریق و ضرب و توان و تقسیم با اعداد بسیار بزرگ حتی تا 100.000.000.000 هم محاسبه می کنه

[IamOverlord]

سلام...
ببینید من در مورد چهار عمل اصلی روی اعداد غیر اعشاری مشکلی ندارم. اما مسئله در مورد محاسبات با ارقام اعشاری خیلی زیاد هست. قبلا یه ماژولی سعی کردم بنویسم ولی بهینه و درست-حسابی نشد. تو این فکرم که اون رو بذارم و اگه قراره رو چیزی کار کنیم رو همون کار کنیم.






'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''
'' MODULE NAME : BIG NUMBERS ''
'' PROGRAMMER : OVERLORD.SANDKING ( MASOOD LAPECHI) ''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''


Public Function ToBigNumber(ByVal Number) As String
If Number = 0 Then
res = "0.0"
Else
If Number > 0 Then
res = Trim(Str(Number))
If Mid(res, 1, 1) = "." Then res = "0" + res
res = "+" + res
For i = 1 To Len(res)
If Mid(res, i, 1) = "." Then f = 1
Next i
If f <> 1 Then res = res + ".0"
Else
res = Trim(Str(Number))
For i = 1 To Len(res)
If Mid(res, i, 1) = "." Then f = 1
Next i
If f <> 1 Then res = res + ".0"
End If
End If
ToBigNumber = res
End Function


Public Function Compare(ByVal strNumber1 As String, ByVal strNumber2 As String)
n1 = strNumber1
n2 = strNumber2
If Mid(n1, 1, 1) = Mid(n2, 1, 1) Then
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then n1dpp = i
Next i
For i = 1 To Len(n2)
If Mid(n2, i, 1) = "." Then n2dpp = i
Next i
n1adpc = Len(n1) - n1dpp - 1
n1bdpc = n1dpp - 1
n2adpc = Len(n2) - n2dpp - 1
n2bdpc = n2dpp - 1
If n1adpc < n2adpc Then
n1 = n1 + String(n2adpc - n1adpc, "0")
Else
n2 = n2 + String(n1adpc - n2adpc, "0")
End If
If n1bdpc < n2bdpc Then
n1 = Mid(n1, 1, 1) + String(n2bdpc - n1bdpc, "0") + Mid(n1, 2, Len(n1) - 1)
Else
n2 = Mid(n2, 1, 1) + String(n1bdpc - n2bdpc, "0") + Mid(n2, 2, Len(n2) - 1)
End If
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then dpp = i
Next i
n1wdp = Mid(n1, 1, dpp - 1) + Mid(n1, dpp + 1, Len(n1) - dpp)
n2wdp = Mid(n2, 1, dpp - 1) + Mid(n2, dpp + 1, Len(n2) - dpp)
res = 0
For i = Len(n1wdp) To 2 Step -1
If Val(Mid(n1wdp, i, 1)) < Val(Mid(n2wdp, i, 1)) Then res = 1
If Val(Mid(n1wdp, i, 1)) > Val(Mid(n2wdp, i, 1)) Then res = 2
Next i
Else
If Mid(n1, 1, 1) = "+" Then
res = 2
Else
If Mid(n2, 1, 1) = "+" Then
res = 1
Else
If Mid(n1, 1, 1) = "0" Then
res = 2
Else
res = 1
End If
End If
End If
End If
Compare = res
End Function

Public Function Sum(ByVal strNumber1 As String, ByVal strNumber2 As String) As String
n1 = strNumber1
n2 = strNumber2
If Mid(n1, 1, 1) = "+" And Mid(n2, 1, 1) = "+" Then
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then n1dpp = i
Next i
For i = 1 To Len(n2)
If Mid(n2, i, 1) = "." Then n2dpp = i
Next i
n1adpc = Len(n1) - n1dpp - 1
n1bdpc = n1dpp - 1
n2adpc = Len(n2) - n2dpp - 1
n2bdpc = n2dpp - 1
If n1adpc < n2adpc Then
n1 = n1 + String(n2adpc - n1adpc, "0")
Else
n2 = n2 + String(n1adpc - n2adpc, "0")
End If
If n1bdpc < n2bdpc Then
n1 = Mid(n1, 1, 1) + String(n2bdpc - n1bdpc, "0") + Mid(n1, 2, Len(n1) - 1)
Else
n2 = Mid(n2, 1, 1) + String(n1bdpc - n2bdpc, "0") + Mid(n2, 2, Len(n2) - 1)
End If
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then dpp = i
Next i
n1wdp = Mid(n1, 1, dpp - 1) + Mid(n1, dpp + 1, Len(n1) - dpp)
n2wdp = Mid(n2, 1, dpp - 1) + Mid(n2, dpp + 1, Len(n2) - dpp)
For i = Len(n1wdp) To 2 Step -1
n3wdp = Trim(Str((Val(Mid(n1wdp, i, 1)) + Val(Mid(n2wdp, i, 1)) + r) Mod 10)) + n3wdp
r = (Val(Mid(n1wdp, i, 1)) + Val(Mid(n2wdp, i, 1)) + r) \ 10
Next i
If r <> 0 Then n3wdp = Trim(Str(r)) + n3wdp
n3wdp = "+" + n3wdp
If r <> 0 Then
n3 = Mid(n3wdp, 1, dpp) + "." + Mid(n3wdp, dpp + 1, Len(n3wdp) - dpp)
Else
n3 = Mid(n3wdp, 1, dpp - 1) + "." + Mid(n3wdp, dpp, Len(n3wdp) - dpp + 1)
End If
While Mid(n3, Len(n3), 1) = "0" And Mid(n3, Len(n3) - 1, 1) <> "."
n3 = Mid(n3, 1, Len(n3) - 1)
Wend
Sum = n3
Exit Function
End If
If Mid(n1, 1, 1) = "-" And Mid(n2, 1, 1) = "-" Then
n3 = Sum("+" + Mid(n1, 2, Len(n1) - 1), "+" + Mid(n2, 2, Len(n2) - 1))
Sum = "-" + Mid(n3, 2, Len(n3) - 1)
Exit Function
End If
If Mid(n1, 1, 1) = "+" And Mid(n2, 1, 1) = "-" Then
n3 = Subtract(n1, "+" + Mid(n2, 2, Len(n2) - 1))
Sum = n3
Exit Function
End If
If Mid(n1, 1, 1) = "-" And Mid(n2, 1, 1) = "+" Then
n3 = Subtract(n2, "+" + Mid(n1, 2, Len(n1) - 1))
Sum = n3
Exit Function
End If
If Mid(n1, 1, 1) = "0" Then Sum = n2 Else Sum = n1
End Function

Public Function Subtract(ByVal strNumber1 As String, ByVal strNumber2 As String) As String
n1 = strNumber1
n2 = strNumber2
If Mid(n1, 1, 1) = "+" And Mid(n2, 1, 1) = "+" Then
If Compare(n1, n2) <> 1 Then
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then n1dpp = i
Next i
For i = 1 To Len(n2)
If Mid(n2, i, 1) = "." Then n2dpp = i
Next i
n1adpc = Len(n1) - n1dpp - 1
n1bdpc = n1dpp - 1
n2adpc = Len(n2) - n2dpp - 1
n2bdpc = n2dpp - 1
If n1adpc < n2adpc Then
n1 = n1 + String(n2adpc - n1adpc, "0")
Else
n2 = n2 + String(n1adpc - n2adpc, "0")
End If
If n1bdpc < n2bdpc Then
n1 = Mid(n1, 1, 1) + String(n2bdpc - n1bdpc, "0") + Mid(n1, 2, Len(n1) - 1)
Else
n2 = Mid(n2, 1, 1) + String(n1bdpc - n2bdpc, "0") + Mid(n2, 2, Len(n2) - 1)
End If
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then dpp = i
Next i
n1wdp = Mid(n1, 1, dpp - 1) + Mid(n1, dpp + 1, Len(n1) - dpp)
n2wdp = Mid(n2, 1, dpp - 1) + Mid(n2, dpp + 1, Len(n2) - dpp)
For i = Len(n1wdp) To 2 Step -1
If Val(Mid(n1wdp, i, 1)) < Val(Mid(n2wdp, i, 1)) + r Then
n3wdp = Trim(Str(Val(Mid(n1wdp, i, 1)) + 10 - (Val(Mid(n2wdp, i, 1)) + r))) + n3wdp
r = 1
Else
n3wdp = Trim(Str(Val(Mid(n1wdp, i, 1)) - (Val(Mid(n2wdp, i, 1)) + r))) + n3wdp
r = 0
End If
Next i
If r <> 0 Then n3wdp = "9" + n3wdp
n3wdp = "+" + n3wdp
If r <> 0 Then
n3 = Mid(n3wdp, 1, dpp) + "." + Mid(n3wdp, dpp + 1, Len(n3wdp) - dpp)
Else
n3 = Mid(n3wdp, 1, dpp - 1) + "." + Mid(n3wdp, dpp, Len(n3wdp) - dpp + 1)
End If
Else
n3 = Subtract(n2, n1)
If Mid(n3, 1, 1) = "+" Then n3 = "-" + Mid(n3, 2, Len(n3) + 1)
End If
While Mid(n3, 2, 1) = "0" And Mid(n3, 3, 1) <> "."
n3 = Mid(n3, 1, 1) + Mid(n3, 3, Len(n3) - 2)
Wend
While Mid(n3, Len(n3), 1) = "0" And Mid(n3, Len(n3) - 1, 1) <> "."
n3 = Mid(n3, 1, Len(n3) - 1)
Wend
For i = 1 To Len(n3)
If Mid(n3, i, 1) <> "+" And Mid(n3, i, 1) <> "-" And Mid(n3, i, 1) <> "." And Mid(n3, i, 1) <> "0" Then f = 1
Next i
If f = 0 Then n3 = "0.0"
Subtract = n3
Exit Function
End If
If Mid(n1, 1, 1) = "-" And Mid(n2, 1, 1) = "-" Then
n3 = Subtract("+" + Mid(n2, 2, Len(n2) - 1), "+" + Mid(n1, 2, Len(n1) - 1))
Subtract = n3
Exit Function
End If
If Mid(n1, 1, 1) = "+" And Mid(n2, 1, 1) = "-" Then
n3 = Sum(n1, "+" + Mid(n2, 2, Len(n2) - 1))
Subtract = n3
Exit Function
End If
If Mid(n1, 1, 1) = "-" And Mid(n2, 1, 1) = "+" Then
n3 = Sum(n1, "-" + Mid(n2, 2, Len(n2) - 1))
Subtract = n3
Exit Function
End If
If Mid(n2, 1, 1) = "0" Then
Subtract = n1
Else
If Mid(n2, 1, 1) = "+" Then
Subtract = "-" + Mid(n2, 2, Len(n2) - 1)
Else
Subtract = "+" + Mid(n2, 2, Len(n2) - 1)
End If
End If
End Function

Public Function Multiply(ByVal strNumber1 As String, ByVal strNumber2 As String) As String
Dim N() As String
n1 = strNumber1
n2 = strNumber2
If n1 = "0.0" Or n2 = "0.0" Then
Multiply = "0.0"
Exit Function
End If
For i = 1 To Len(n1)
If Mid(n1, i, 1) = "." Then n1dpp = i
Next i
For i = 1 To Len(n2)
If Mid(n2, i, 1) = "." Then n2dpp = i
Next i
n1adpc = Len(n1) - n1dpp
n2adpc = Len(n2) - n2dpp
n1wdp = Mid(n1, 1, n1dpp - 1) + Mid(n1, n1dpp + 1, Len(n1) - n1dpp)
n2wdp = Mid(n2, 1, n2dpp - 1) + Mid(n2, n2dpp + 1, Len(n2) - n2dpp)
ReDim N(Len(n2wdp) - 2) As String
For i = 2 To Len(n2wdp)
r = 0
For j = Len(n1wdp) To 2 Step -1
N(i - 2) = Trim(Str((Val(Mid(n2wdp, Len(n2wdp) + 2 - i, 1)) * Val(Mid(n1wdp, j, 1)) + r) Mod 10)) + N(i - 2)
r = (Val(Mid(n2wdp, Len(n2wdp) + 2 - i, 1)) * Val(Mid(n1wdp, j, 1)) + r) \ 10
Next j
If r <> 0 Then N(i - 2) = Trim(Str(r)) + N(i - 2)
f = 0
For j = 1 To Len(N(i - 2))
If Mid(N(i - 2), j, 1) <> "0" Then f = 1
Next j
If f = 0 Then
N(i - 2) = "0.0"
Else
N(i - 2) = "+" + N(i - 2) + String(i - 2, "0") + ".0"
End If
Next i
n3 = "0.0"
For i = 1 To Len(n2wdp) - 1
n3 = Sum(n3, N(i - 1))
'Form1.List1.AddItem n3
Next i
n3adpc = n1adpc + n2adpc
n3 = Mid(n3, 1, Len(n3) - 2)
'n3 = Mid(n3, 2, Len(n3) - 1)
If n3adpc > Len(n3) Then n3 = String(n3adpc - Len(n3) + 2, "0") + Mid(n3, 2, Len(n3) - 1)
n3 = Mid(n3, 1, Len(n3) - n3adpc) + "." + Mid(n3, Len(n3) - n3adpc + 1, n3adpc)
If Mid(n3, 2, 1) = "." Then
n3 = Mid(n3, 1, 1) + "0." + Mid(n3, 3, Len(n3) - 3 + 1)
End If
If Mid(n1, 1, 1) = Mid(n2, 1, 1) Then
n3 = "+" + Mid(n3, 2, Len(n3) - 1)
Else
n3 = "-" + Mid(n3, 2, Len(n3) - 1)
End If
While Mid(n3, 2, 1) = "0" And Mid(n3, 3, 1) <> "."
n3 = Mid(n3, 1, 1) + Mid(n3, 3, Len(n3) - 2)
Wend
While Mid(n3, Len(n3), 1) = "0" And Mid(n3, Len(n3) - 1, 1) <> "."
n3 = Mid(n3, 1, Len(n3) - 1)
Wend
Multiply = n3
End Function

Public Function Divide(ByVal strNumber1 As String, ByVal strNumber2 As String) As String
res = OneDiv(strNumber2)
MsgBox strNumber1
MsgBox res
res = Multiply(strNumber1, res)
Divide = res
End Function

Public Function OneDiv(ByVal strNumber As String) As String
divisor = strNumber
If divisor = "+1.0" Or divisor = "-1.0" Then
res = divisor
Else
If Mid(divisor, 1, 1) = "-" Then f = 1
divisor = "+" + Mid(divisor, 2, Len(divisor) - 1)
For i = 1 To Len(divisor)
If Mid(divisor, i, 1) = "." Then divisordpp = i
Next i
divisoradpc = Len(divisor) - divisordpp
If Right(divisor, 2) <> ".0" Then
divisor = Multiply(divisor, "+1" + String(divisoradpc, "0") + ".0")
g = 1
End If
divided = "+1.0"
For i = 1 To 50
divided = Multiply(divided, "+10.0")
If divided = "0.0" Then Exit For
For j = 1 To 10
If Compare(Multiply("+" + Trim(Str(Val(j))) + ".0", divisor), divided) = 2 Then
k = j - 1
Exit For
End If
Next j
res = res + Trim(Str(Val(k)))
divided = Subtract(divided, Multiply(divisor, "+" + Trim(Str(Val(k))) + ".0"))
Next i
res = "+0." + res
If g = 1 Then res = Multiply(res, "+1" + String(divisoradpc - 0, "0") + ".0")
If f = 1 Then res = "-" + Mid(divisor, 2, Len(divisor) - 1)
While Mid(res, 2, 1) = "0" And Mid(res, 3, 1) <> "."
res = Mid(res, 1, 1) + Mid(res, 3, Len(res) - 2)
Wend
End If
If res = "+0.0" Then res = "0.0"
OneDiv = res
End Function

Public Function Power(ByVal strNumber1 As String, ByVal strNumber2 As String) As String
res = "+1.0"
strI = "+1.0"
While Compare(strI, strNumber2) < 2
res = Multiply(res, strNumber1)
strI = Sum(strI, "+1.0")
Wend
' ...
Power = res
End Function

[Mr'Jamshidy]

به نظر من باید اول اعشار از صحیح جدا بشه بعد هر کدوم جدا محاسبه بشه

در آخر صفر های آخر اعشار حذف بشه و کنار هم گزاشته بشه

برای جدا کردن صحیح از اعشار هم میتونید از فرمان Split استفاده کنید

[IamOverlord]

خوب تو اون کد بالا که مشکلی با جمع و تفریق فکر نمی کنم باشه...
مشکل از تقسیم شروع می شه. روشی که اون جا استفاده شده اینه که یه تابع بنویسیم که ۱ رو بر A تقسیم کنه، بعد وقتی می خوایم B رو تقسیم بر C کنیم، اول ۱ رو تقسیم بر C کنیم بعد ضرب در B کنیم. اما می خوام ببینم روش بهتری هست؟ می شه کار رو تمیز تر از اون بالا انجام داد؟‍! ضمنا فکر می کنم اون کد بالا نیاز به دیباگ کردن یا بازنویسی داشت...
اگه می شه اون کد بالا رو در مورد ۴ عمل اصلیش یه بررسی بکنید. می مونه مسئله ی به توان رسوندن که اگه این حل بشه رادیکال هم حل می شه و بعد می ریم سراغ بقیه ی توابع...
شکل اعداد هم به این صورت هست:

0.0
+0.4435
-0.235
+1.454
-89.344433
+2323.0
-435.0
...

[IamOverlord]

سلام دوستان.
یه ماژول پیدا کردم برای چهار عمل اصلی روی Integer های خیلی بزرگ. بر اساس اون یه ماژول نوشتم برای اعداد اعشاری مثبت یا نامثبت که شامل چهار عمل اصلی و چند تا تابع دیگه می شه.
امیدوارم با کمک هم بهینش کنیم و گسترشش بدیم...

[vbhamed]

سلام

خب اگر ضرب كار مي‌كنه ديگه تو نوشتن توان مشكلي نيست، چون عدد رو با استفاده از تابع ضرب خودتون چند بار در خودش ضرب مي‌كنيد

[IamOverlord]

اما در مورد توان اعشاری چی؟
فکر می کنم باید از بسط تیلور استفاده کنیم...
اما یه مسائلی در مورد سرعت کار هست و این که اصولا این کار چه طور باید انجام بشه.
en.wikipedia.org/wiki/Taylor_series (http://en.wikipedia.org/wiki/Taylor_series)
شایدم بشه برای قسمت صحیح توان این کارو کرد و برای قسمت اعشاری از بسط تیلور استفاده کرد.
ضمنا یه مسئله ی دیگه ای هم پیش اومده... این که در مورد گرد کردن اعداد اعشاری باید چی کار کرد؟ فکر می کنم یه همچین کارایی باید برای تمیزی محاسبات انجام بشه تو تقسیم کردن...

[IamOverlord]

سلام دوستان.
شروع کردم به نوشتن تابع ریشه ی دوم اعداد...
روش کار، استفاده از متد نیوتن (http://en.wikipedia.org/wiki/Newton%27s_method#Square_root_of_a_number) برای حل معادلات هست، که باهاش معادله ی x^2-a=0 رو حل می کنیم که جواباش مثبت و منفی ریشه ی دوم a هستن و ما به جواب مثبتش می رسیم...

Public Function FSqr(ByVal Num As String) As String
x10 = 101
Dim strRes As String
strRes = Num
For i = 1 To x10
strRes = FSubtract(strRes, FDivide(FSubtract(FMultiply(strRes, strRes), Num), FMultiply("2.0", strRes)))
Next i
FSqr = strRes
End Function