SET TALK OFF
SET SAFETY OFF
clea
text
大数快速四则计算,(除法很耗时,最好转化为乘法再计算)
ll_Add
: 加 +
ll_Sub
: 减 -
ll_Mult
: 乘 *
ll_Div
: 除 /
ll_Mod
: 模 %/Mod()
ll_Less
: 小于 >
ll_IntSqrt : 平方根 SQRT()
ll_power
: 乘幂 ^/**
ll_pl
: 排列
ll_zh
: 组合
调用方法
? ll_mult("4", "4")
&& 4x4
endtext
?
? "1000000位长度的 4 + 1000000位长度的 7 的运算结果:"
? "================================================"
m.a = Replicate("1244", 200)
m.b = Replicate("7457", 2)
m.sc = Seconds()
FOR i=1 TO 100
m.c = ll_add(m.a, m.b)
next
? "耗时 (秒)
:", Seconds() - m.sc
? "结果长度
:", Len(m.c)
? "左20位运算结果:", Left(m.c, 20)
?m.c
? "================================================"
*!* Function ll_add adds two integers, represented by strings m.s1 and m.s2
Function ll_add
Lparameter m.s1, m.s2
If Left(m.s1,1)="-"
Return ll_sub(m.s2, Substr(m.s1,2))
Endif
If Left(m.s2,1)="-"
Return ll_sub(m.s1, Substr(m.s2,2))
Endif
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* local m.ln1, m.ln2, m.ln3, m.s3
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
*!* if len(chrtran(m.s2, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s2"
*!* return ""
*!* endif
Local m.ln1, m.ln2, m.ln3, m.s3
m.ln1=Len(m.s1)
m.ln2=Len(m.s2)
m.ln3 = Max(m.ln1, m.ln2)+1
m.s1 = Padl(m.s1, m.ln3, "0")
m.s2 = Padl(m.s2, m.ln3, "0")
m.s3 = Repl("0", m.ln3)
Local m.hhnd, m.ptr, m.st2, m.rez
If !Pemstatus(_Screen,"ll_add",5) Or _Screen.ll_add=0
Declare Integer HeapCreate In Win32Api Integer, Integer, Integer
Declare Integer HeapAlloc In Win32Api Integer, Integer, Integer
Declare RtlMoveMemory In Win32API Integer, String, Integer Cnt
m.st2 = ;
chr(0x55)+Chr(0x89)+Chr(0xE5)+Chr(0x57)+Chr(0x56)+Chr(0x50)+Chr(0x53)+Chr(0x51)+ ;
chr(0x52)+Chr(0x8B)+Chr(0x75)+Chr(0x08)+Chr(0x8B)+Chr(0x5D)+Chr(0x0C)+Chr(0x8B)+ ;
chr(0x4D)+Chr(0x10)+Chr(0x8B)+Chr(0x7D)+Chr(0x14)+Chr(0x8A)+Chr(0x04)+Chr(0x0E)+ ;
chr(0x02)+Chr(0x04)+Chr(0x0B)+Chr(0x02)+Chr(0x04)+Chr(0x0F)+Chr(0x2C)+Chr(0x60)+ ;
chr(0x3C)+Chr(0x39)+Chr(0x7E)+Chr(0x06)+Chr(0x2C)+Chr(0x0A)+Chr(0xFE)+Chr(0x44)+ ;
chr(0x0F)+Chr(0xFF)+Chr(0x88)+Chr(0x04)+Chr(0x0F)+Chr(0x49)+Chr(0x75)+Chr(0xE5)+ ;
chr(0x5A)+Chr(0x59)+Chr(0x5B)+Chr(0x58)+Chr(0x5E)+Chr(0x5F)+Chr(0x89)+Chr(0xEC)+ ;
chr(0x5D)+Chr(0xC2)+Chr(0x10)+Chr(0x00)
m.hhnd=HeapCreate(0x40000,1024,1024)
m.ptr=HeapAlloc(m.hhnd,0,Len(m.st2)+16)
RtlMoveMemory(m.ptr,m.st2,Len(m.st2))
_Screen.AddProperty("ll_add",m.ptr)
Endif
Declare CallWindowProc In Win32API Integer, String, String, Integer, String @
CallWindowProc(_Screen.ll_add, m.s1, m.s2, m.ln3-1, @m.s3)
Return Chrtran(Ltrim(Chrtran(m.s3, "0", " ")), " ", "0")
*!* Function ll_sub substracts integer, represented by strings m.s2 from the
*!* integer, epresented by m.s1
Function ll_sub
Lparameter m.s1, m.s2
If Left(m.s2,1)="-"
Return ll_add(m.s1, Substr(m.s2,2))
Endif
If Left(m.s1,1)="-"
Return "-"+ll_add(Substr(m.s1,2), m.s2)
Endif
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* local m.ln1, m.ln2, m.ln3, m.s3
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
*!* if len(chrtran(m.s2, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s2"
*!* return ""
*!* endif
Local m.ln1, m.ln2, m.ln3, m.s3
m.ln1=Len(m.s1)
m.ln2=Len(m.s2)
m.ln3 = Max(m.ln1, m.ln2)+1
m.s1 = Padl(m.s1, m.ln3, "0")
m.s2 = Padl(m.s2, m.ln3, "0")
If m.s1 < m.s2
Return "-"+ll_sub(m.s2, m.s1)
Endif
m.s3 = Repl("0", m.ln3)
Local m.hhnd, m.ptr, m.st2, m.rez
If !Pemstatus(_Screen,"ll_sub",5) Or _Screen.ll_sub=0
Declare Integer HeapCreate In Win32Api Integer, Integer, Integer
Declare Integer HeapAlloc In Win32Api Integer, Integer, Integer
Declare RtlMoveMemory In Win32API Integer, String, Integer Cnt
m.st2 = ;
chr(0x55)+Chr(0x89)+Chr(0xE5)+Chr(0x57)+Chr(0x56)+Chr(0x50)+Chr(0x53)+Chr(0x51)+ ;
chr(0x52)+Chr(0x8B)+Chr(0x75)+Chr(0x08)+Chr(0x8B)+Chr(0x5D)+Chr(0x0C)+Chr(0x8B)+ ;
chr(0x4D)+Chr(0x10)+Chr(0x8B)+Chr(0x7D)+Chr(0x14)+Chr(0xBA)+Chr(0x00)+Chr(0x00)+ ;
chr(0x00)+Chr(0x00)+Chr(0x8A)+Chr(0x04)+Chr(0x0E)+Chr(0x00)+Chr(0x14)+Chr(0x0B)+ ;
chr(0x2A)+Chr(0x04)+Chr(0x0B)+Chr(0x7D)+Chr(0x06)+Chr(0xB2)+Chr(0x01)+Chr(0x04)+ ;
chr(0x0A)+Chr(0xEB)+Chr(0x02)+Chr(0xB2)+Chr(0x00)+Chr(0x04)+Chr(0x30)+Chr(0x88)+ ;
chr(0x04)+Chr(0x0F)+Chr(0x49)+Chr(0x75)+Chr(0xE5)+Chr(0x5A)+Chr(0x59)+Chr(0x5B)+ ;
chr(0x58)+Chr(0x5E)+Chr(0x5F)+Chr(0x89)+Chr(0xEC)+Chr(0x5D)+Chr(0xC2)+Chr(0x10)+ ;
chr(0x00)
m.hhnd=HeapCreate(0x40000,1024,1024)
m.ptr=HeapAlloc(m.hhnd,0,Len(m.st2)+16)
RtlMoveMemory(m.ptr,m.st2,Len(m.st2))
_Screen.AddProperty("ll_sub",m.ptr)
Endif
Declare CallWindowProc In Win32API Integer, String, String, Integer, String @
CallWindowProc(_Screen.ll_sub, m.s1, m.s2, m.ln3-1, @m.s3)
Return Chrtran(Ltrim(Chrtran(m.s3, "0", " ")), " ", "0")
*!* Function ll_mult multiplies two integers, represented by strings m.s1 and m.s2
Function ll_mult
Lparameter m.s1, m.s2
Do Case
Case Left(m.s1,1) = "-" And Left(m.s2,1) <> "-"
Return "-" + ll_mult(Substr(m.s1,2), m.s2)
Case Left(m.s1,1) <> "-" And Left(m.s2,1) = "-"
Return "-" + ll_mult(m.s1, Substr(m.s2,2))
Case Left(m.s1,1) = "-" And Left(m.s2,1) = "-"
Return ll_mult(Substr(m.s1,2), Substr(m.s2,2))
Endcase
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* local m.ln2, m.sm, m.i
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
*!* if len(chrtran(m.s2, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s2"
*!* return ""
*!* endif
Local m.ln2, m.sm, m.i
m.ln2 = Len(m.s2)
m.sm = "0"
For i = 1 To m.ln2
m.sm = ll_add(m.sm, ll_mult1(m.s1, Int(Val(Substr(m.s2, m.ln2-i+1, 1)))) + Repl("0", i-1))
Next
Return m.sm
*!* Function ll_mult1 multiplies integers, represented by strings m.s1 and one digit integer m.n2
*!* Is used by function ll_mult
Function ll_mult1
Lparameter m.s1, m.n2
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
Local m.ln1, m.s3
m.ln1 = Len(m.s1)+1
m.s1="0"+m.s1
m.s3 = Repl("0", m.ln1)
Local m.hhnd, m.ptr, m.st2, m.rez
If !Pemstatus(_Screen,"ll_mult1",5) Or _Screen.ll_mult1=0
Declare Integer HeapCreate In Win32Api Integer, Integer, Integer
Declare Integer HeapAlloc In Win32Api Integer, Integer, Integer
Declare RtlMoveMemory In Win32API Integer, String, Integer Cnt
m.st2 = ;
chr(0x55)+Chr(0x89)+Chr(0xE5)+Chr(0x57)+Chr(0x56)+Chr(0x50)+Chr(0x53)+Chr(0x51)+ ;
chr(0x52)+Chr(0x8B)+Chr(0x75)+Chr(0x08)+Chr(0x8B)+Chr(0x5D)+Chr(0x0C)+Chr(0x8B)+ ;
chr(0x4D)+Chr(0x10)+Chr(0x8B)+Chr(0x7D)+Chr(0x14)+Chr(0xBA)+Chr(0x0A)+Chr(0x00)+ ;
chr(0x00)+Chr(0x00)+Chr(0x8A)+Chr(0x04)+Chr(0x0E)+Chr(0x2C)+Chr(0x30)+Chr(0xF6)+ ;
chr(0xE3)+Chr(0xF6)+Chr(0xF2)+Chr(0x00)+Chr(0x24)+Chr(0x0F)+Chr(0x80)+Chr(0x3C)+ ;
chr(0x0F)+Chr(0x39)+Chr(0x7E)+Chr(0x08)+Chr(0xFE)+Chr(0x44)+Chr(0x0F)+Chr(0xFF)+ ;
chr(0x80)+Chr(0x2C)+Chr(0x0F)+Chr(0x0A)+Chr(0x00)+Chr(0x44)+Chr(0x0F)+Chr(0xFF)+ ;
chr(0x49)+Chr(0x75)+Chr(0xDF)+Chr(0x5A)+Chr(0x59)+Chr(0x5B)+Chr(0x58)+Chr(0x5E)+ ;
chr(0x5F)+Chr(0x89)+Chr(0xEC)+Chr(0x5D)+Chr(0xC2)+Chr(0x10)+Chr(0x00)
m.hhnd=HeapCreate(0x40000,1024,1024)
m.ptr=HeapAlloc(m.hhnd,0,Len(m.st2)+16)
RtlMoveMemory(m.ptr,m.st2,Len(m.st2))
_Screen.AddProperty("ll_mult1",m.ptr)
Endif
Declare CallWindowProc In Win32API Integer, String, Integer, Integer, String @
CallWindowProc(_Screen.ll_mult1, m.s1, m.n2, m.ln1-1, @m.s3)
Return Chrtran(Ltrim(Chrtran(m.s3, "0", " ")), " ", "0")
*!* Function ll_div divides integer, represented by strings m.s1 by the
*!* integer, epresented by m.s1. (int(m.s1/m.s2)). If parameter m.md is
*!* passed by reference, mod(m.s1,m.s2) is returned in m.md
Function ll_div
Lparameter m.s1, m.s2, m.md
Do Case
Case Left(m.s1,1) = "-" And Left(m.s2,1) <> "-"
Return "-" + ll_div(Substr(m.s1,2), m.s2)
Case Left(m.s1,1) <> "-" And Left(m.s2,1) = "-"
Return "-" + ll_div(m.s1, Substr(m.s2,2))
Case Left(m.s1,1) = "-" And Left(m.s2,1) = "-"
Return ll_div(Substr(m.s1,2), Substr(m.s2,2))
Endcase
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* local m.ln1, m.ln2, m.sm, m.i, m.ts1, m.ts1e,
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
*!* if len(chrtran(m.s2, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s2"
*!* return ""
*!* endif
If ll_less(m.s1, m.s2)
m.md = m.s1
Return "0"
Endif
Local m.ln1, m.ln2, m.sm, m.i, m.ts1, m.ts1e,
m.ln2 = Len(m.s2)
m.sm = ""
m.ts1 = Left(m.s1, m.ln2)
m.ts1e = Substr(m.s1, m.ln2 + 1)
m.ln1 = Len(m.ts1e)
For m.i = 1 To m.ln1 +1
= 0
Do While !ll_less(m.ts1, m.s2)
m.ts1 = ll_sub(m.ts1, m.s2)
= + 1
Enddo
m.sm = m.sm + Allt(Str())
m.ts1 = m.ts1 + Left(m.ts1e, 1)
m.ts1e = Substr(m.ts1e, 2)
Next
m.sm = tr0(m.sm)
m.md = m.ts1
Return m.sm
*!* Function ll_mod returns mod(m.s1, m.s2)
Function ll_mod
Lparameter m.s1, m.s2
Do Case
Case Left(m.s1,1) = "-" And Left(m.s2,1) <> "-"
Return ""
Case Left(m.s1,1) <> "-" And Left(m.s2,1) = "-"
Return ""
Case Left(m.s1,1) = "-" And Left(m.s2,1) = "-"
Return ""
Endcase
Local m.md
ll_div(m.s1, m.s2, @m.md)
Return m.md
*!* Function ll_less compare two integers, represented by m.s1 and m.s2.
*!* .t. is returned if m.s1 < m.s2
Function ll_less
Lparameter m.s1, m.s2
Do Case
Case Left(m.s1,1) = "-" And Left(m.s2,1) <> "-"
Return .T.
Case Left(m.s1,1) <> "-" And Left(m.s2,1) = "-"
Return .F.
Case Left(m.s1,1) = "-" And Left(m.s2,1) = "-"
Return ll_less(Substr(m.s2,2), Substr(m.s1,2))
Endcase
m.s1 = tr0(m.s1)
m.s2 = tr0(m.s2)
Return Len(m.s1) < Len(m.s2) Or (Len(m.s1) = Len(m.s2) And m.s1 < m.s2)
*!* Function tr0 is used by function ll_less
Function tr0
Lparameter m.s1
Do While Left(m.s1, 1) = "0" And Len(m.s1) > 1
m.s1 = Substr(m.s1, 2)
Enddo
Return m.s1
*!* Funnction ll_intsqrt returns mod(m.s1, m.s2)
Function ll_intsqrt
Lparameter m.s1
*!* Uncomment next rows if you want some additional data checking,
*!* but this may dramaticaly reduce performance on large strings
*!* if len(chrtran(m.s1, "0123456789", "")) > 0
*!* wait window "Long_ar: error in s1"
*!* return ""
*!* endif
Local m.ln, m.chet, m.tln, m.sq, m.i, m.j, m.tsq, m.tkv, m.tnkv
m.ln = Len(m.s1)
If m.ln <= 16
Return Allt(Str(Int(Sqrt(Val(m.s1)))))
Endif
m.chet = m.ln%2
m.tln = m.ln - 16 + m.chet
m.sq = Allt(Str(Int(Sqrt(Val(Left(m.s1, m.ln - m.tln))))))
For m.i = 1 To m.tln/2
m.tkv = Left(m.s1, m.ln - m.tln + m.i*2)
For m.j = 9 To 0 Step -1
m.tsq = m.sq+Allt(Str(m.j))
m.tnkv = ll_mult(m.tsq, m.tsq)
If ll_less(m.tnkv, m.tkv) Or m.tnkv == m.tkv
Exit
Endif
Next
m.sq = m.sq + Allt(Str(m.j))
Next
Return m.sq
Function ll_add_dec
Lparameter m.s1, m.s2, m.dec
Local m.pos1, m.pos2
m.pos1 = Rat(".", m.s1)
If m.pos1 = 0
m.s1 = m.s1 + Repl("0", m.dec)
Else
m.s1 = Left(m.s1, m.pos1 - 1) + Padr(Substr(m.s1, m.pos1 + 1), m.dec, "0")
Endif
m.pos2 = Rat(".", m.s2)
If m.pos2 = 0
m.s2 = m.s2 + Repl("0", m.dec)
Else
m.s2 = Left(m.s2, m.pos2 - 1) + Padr(Substr(m.s2, m.pos2 + 1), m.dec, "0")
Endif
m.res = ll_add(m.s1, m.s2)
If Len(m.res) > m.dec
Return Left(m.res, Len(m.res) - m.dec) + "." + Right(m.res, m.dec)
Else
Return "0."+Padl(m.res, m.dec, "0")
Endif
Function ll_power
Lparameter m.s1, m.s2
m.pow = m.s1
For I = 1 To Val(m.s2) - 1
m.pow = ll_Mult(m.pow, m.s1)
Endfor
Return m.pow
Function ll_pl
Lparameter m.s1, m.s2
m.pow = m.s1
For I = 1 To Val(m.s2) - 1
m.pow = ll_Mult(m.pow, LTRIM(STR(VAL(m.s1)-i)))
Endfor
Return m.pow
Function ll_zh
Lparameter m.s1, m.s2
Return ll_div(ll_pl(m.s1,m.s2),ll_pl(m.s2,m.s2))