站長出個題目給大家寫寫:無限位數的加減乘除 |
|
mayday741130
一般會員 發表:11 回覆:8 積分:3 註冊:2006-07-22 發送簡訊給我 |
|
mayday741130
一般會員 發表:11 回覆:8 積分:3 註冊:2006-07-22 發送簡訊給我 |
===================引 用 文 章=================== function Infinitmul(s1,s2:string):string; var i,j,n1,n2,n:integer; begin n1:=length(s1); n2:=length(s2); if n2 > n1 then Result:=InfinitMul(s2,s1) else begin n:=n1; Result:=StringofChar('0',n1); for i:=1 to n2 do for j:=n1 downto 1 do n:=n OPAdd(Result,n-n1-n2 i j,(ord(s2[i])-48) * (ord(s1[j])-48)); end; end; 這行出現Error, 「Missing operator or semicolon」 是什麼原因呢???
------
小LO |
kobemagic2001
一般會員 發表:10 回覆:6 積分:3 註冊:2006-07-24 發送簡訊給我 |
|
kobemagic2001
一般會員 發表:10 回覆:6 積分:3 註冊:2006-07-24 發送簡訊給我 |
|
roviury
一般會員 發表:3 回覆:49 積分:15 註冊:2008-08-28 發送簡訊給我 |
不論有沒有人再理會這篇文章,我也希望寫出來給大家參考,因為我用了這套算法很久,都沒有任何出錯,這次要令找bug的朋友失望了
這篇文章改動了很多次,我精簡一點說重點吧 之前call來call去,的確會減慢速度(需要不斷改變eax,edx,ecx的值) 後來雖然有更快的算法,但也比較多bug 我決定以asm重寫,避免string存取過多的問題(不斷call uniquestring),也成功換取了更高性能的算法 加法全屬asm,減法插入少量delphi 乘法算法是我最滿意的,抓住單字一次性改值的特點,速度極高 除法算法我十分不滿,因為原始的長除法我認為太慢了,以次方級數上升來取值也不夠快,希望其他人想到更好的方法 餘數算法從除法中分離並加快,希望其他人想到更好的方法 注:這算法是針到超長的正整數運算,而負數可透過輔助函數AsmX實現 例如 -1 2: asmx('-1',' ','2') 如果是整數,用asmadd會更快 如果不肯定,最好使用asmx (只要核心算法快0.00001秒,開方,n!就能快很多) [code delphi] type //asmx的result type,m代表餘數 TStrAns=record value,m:string; end; procedure SwapByPtr(const a,b); //交換變數地址 function loseMinus(const s: String; var b: boolean):string; //=abs function checkPIntStr(const s: String): Boolean; //檢查是否為正整數字串 function AsmX(s1: String; const sD: Char; s2: String):TStrAns; //輔助函數,針到負數問題 function AsmAdd(const a, b: string): string; //加 function AsmSub(const a, b: string): string; //減 function AsmMul(const s1, s2: string): string; //乘 function AsmDiv (const s1, s2: string; var m: string): String; //除 function AsmMod(const s1, s2: String):String; //餘 function less(const a,b: String): boolean; //a=b" function great(const a,b:String):boolean; //a>b "not great"="a<=b" procedure FastMove(const Source, Dest; const count: Integer); //=move function absX(const s: String):string; //=loseMinus function SAdd(s:array of string):string; //a b c d function SSub(s:array of string):string; //a-b-c-d function SMul(s:array of string):string; //a*b*c*d function SAddByte(const a: String; b: Byte): String; //針對加一個小數目 function SSubByte(const a: String; b: Byte): String; //針對加一個小數目 procedure SIncByte(var a: String; b: Byte); //inc(a,b) procedure SDecByte(var a: String; b: Byte); //dec(a,b) function logS(const x:string):smallint; //log(x) base=10 function powerS(const x:string; n: string):string; //x^n function SqrS(const x:string):string; //開平方 function AsmMulBase(const x:string; n: byte):string; //乘的核心算法 function A_Mul_B_Mod(const a,b,md:string):string; //求"兩數的積"的餘 function A_Add_B_Mod(const a,b,md:string):string; //求"兩數的和"的餘 function AsmMod_(const s1, s2: String):String; //餘的核心算法 function n_factorial(const x:string):string; //n! [/code]
編輯記錄
roviury 重新編輯於 2009-01-23 19:40:30, 註解 無‧
roviury 重新編輯於 2009-01-23 19:56:04, 註解 無‧ roviury 重新編輯於 2009-01-23 20:26:46, 註解 無‧ roviury 重新編輯於 2009-01-23 20:27:52, 註解 無‧ roviury 重新編輯於 2009-01-23 20:30:41, 註解 無‧ roviury 重新編輯於 2009-01-23 20:31:43, 註解 無‧ roviury 重新編輯於 2009-01-23 20:33:09, 註解 怎麼改也會出現 =.=‧ roviury 重新編輯於 2009-01-23 20:34:40, 註解 到底要怎麼刪掉=.=‧ roviury 重新編輯於 2009-01-23 20:35:16, 註解 無‧ roviury 重新編輯於 2009-01-23 20:37:03, 註解 到底font那個要怎麼移除‧ roviury 重新編輯於 2009-01-23 20:47:59, 註解 內容修改‧ roviury 重新編輯於 2009-01-23 20:48:47, 註解 無‧ roviury 重新編輯於 2009-01-23 20:56:21, 註解 無‧ roviury 重新編輯於 2009-01-23 21:19:28, 註解 無‧ roviury 重新編輯於 2009-01-23 21:21:52, 註解 字眼修正‧ roviury 重新編輯於 2009-01-23 21:24:01, 註解 單位‧ roviury 重新編輯於 2009-01-23 21:26:54, 註解 內容更正‧ roviury 重新編輯於 2009-01-23 21:32:33, 註解 更正測試方法‧ roviury 重新編輯於 2009-01-23 23:20:51, 註解 修正‧ roviury 重新編輯於 2009-01-24 00:45:14, 註解 無‧ roviury 重新編輯於 2009-01-24 14:56:07, 註解 fix bug‧ roviury 重新編輯於 2009-01-24 14:56:34, 註解 無‧ roviury 重新編輯於 2009-01-24 21:30:30, 註解 打錯的‧ roviury 重新編輯於 2009-01-26 00:37:15, 註解 全新內容!!‧ roviury 重新編輯於 2009-01-26 00:40:56, 註解 無‧ roviury 重新編輯於 2009-01-26 00:41:36, 註解 錯字‧ roviury 重新編輯於 2009-01-26 00:42:27, 註解 文章顯示有問題‧ roviury 重新編輯於 2009-01-26 00:50:09, 註解 補充‧ roviury 重新編輯於 2009-01-26 00:53:12, 註解 無‧ roviury 重新編輯於 2009-01-27 16:57:39, 註解 無‧ roviury 重新編輯於 2009-01-27 22:37:18, 註解 無‧ roviury 重新編輯於 2009-01-29 16:39:14, 註解 重新整理內容‧ roviury 重新編輯於 2009-01-29 16:40:18, 註解 無‧ roviury 重新編輯於 2009-01-29 17:05:11, 註解 無‧ roviury 重新編輯於 2009-01-29 17:13:01, 註解 修正‧ roviury 重新編輯於 2009-01-29 18:03:55, 註解 無‧ roviury 重新編輯於 2009-01-29 20:58:03, 註解 無‧ roviury 重新編輯於 2009-01-29 21:08:32, 註解 無‧ roviury 重新編輯於 2009-01-29 23:26:55, 註解 無‧ roviury 重新編輯於 2009-01-29 23:43:35, 註解 追加Rvy_IMod‧ roviury 重新編輯於 2009-01-30 00:36:22, 註解 無‧ roviury 重新編輯於 2009-01-30 14:33:46, 註解 代碼補充‧ roviury 重新編輯於 2009-01-30 14:34:31, 註解 代碼補充‧ roviury 重新編輯於 2009-01-31 18:17:24, 註解 無‧ roviury 重新編輯於 2009-01-31 18:43:32, 註解 無‧ roviury 重新編輯於 2009-02-02 16:53:34, 註解 無‧ roviury 重新編輯於 2009-05-02 23:59:34, 註解 無‧ roviury 重新編輯於 2009-05-03 00:04:34, 註解 無‧ roviury 重新編輯於 2009-05-03 00:16:11, 註解 無‧ |
roviury
一般會員 發表:3 回覆:49 積分:15 註冊:2008-08-28 發送簡訊給我 |
function AsmAdd(const a, b: String): String;
//result=ecx //a=eax //b=edx var alen,blen:integer; asm //Protect push ebx push esi push eax push edx push ecx push edi //Save Length of a and b mov ebx,integer ptr [eax-$04] //movzx ebx,smallint ptr [a-$04] mov alen,ebx //length of a mov ebx,integer ptr [edx-$04] //movzx ebx,smallint ptr [b-$04] cmp alen,ebx jge @AgeB //if alen xchg alen,ebx //alen=blen , ebx=alen xchg eax,edx //exchange eax and edx (Address) //end @AgeB: mov blen,ebx //length of b push eax //Push a push edx //Push b mov edx,alen inc edx //edx=length of Result=alen 1 lea esi,[ecx] //esi=ecx (Address) //push eax push edx //push ecx lea eax,[esi] //input eax=esi (Address) //edx //input edx=alen 1 call System.@LStrSetLength //Setlength(result,alen 1) //pop ecx //edx,ecx has chage //pop edx //pop eax //push eax //push edx //push ecx lea eax,[esi] //input eax=esi (Address) call System.@UniqueStringA //ChangeToString, allow to set char lea edi,[eax] //edi=string esi ps.is edi //pop ecx //edx,ecx has chage pop edx //pop eax //mov ecx,edx //ecx=length(result) xor bh,bh //p=0 (進位) pop ecx //b pop eax //a add eax,edx //@a =length(a) add ecx,blen //@b =length(b) @loop: dec edx //loop dec eax //dec(@eax) dec ecx //dec(@edx) xor bl,bl //bl=0 add bl,byte ptr [eax-1] //bl =Byte((@eax-1)^) sub bl,$30 //bl-=48 ('0'=#48) dec blen jl @NoAddB //if blen>=0 //then begin add bl,byte ptr [ecx] //bl =Byte((@edx)^) sub bl,$30 //end @NoAddB: add bl,bh //p=1 OR 0 xor bh,bh //p=0 cmp bl,$0A jl @NoAddP //if bl>=10 inc bh//add bh,$01 //p =1 sub bl,$0A //bl-=10 @NoAddP: add bl,$30 //x in [0..9] -> chr(x 48) mov byte ptr [edi edx],bl //result[edi ecx 1]=bl ps.is edi cmp edx,$01 //repeat ... ja @loop //until ecx<=01 or bh,bh ja @P1 //if p=0 then begin //push eax //push edx //push ecx lea eax,[esi] mov edx,$01 mov ecx,$01 call System.@LStrDelete //Delete(esi,1,1) ps.is esi //pop ecx //pop edx //pop eax //end jmp @P2 @P1: mov byte ptr [edi],$31 //result[1]:='1' @P2: //lea ecx,[esi] //protected pop edi pop ecx pop edx pop eax pop esi pop ebx end; function AsmSub(const a, b: String): String; //result=ecx //a=eax //b=edx var alen,blen:integer; i:integer;//smallint; f:char; begin if a=b then begin result:='0'; exit; end; alen:=length(a); blen:=length(b); if (alen swapbyptr(alen,blen); f:='-'; end; asm push ebx push esi push edi //mov eax,a //mov edx,b mov ecx,result //push eax //push edx mov edx,alen lea esi,[ecx] push edx lea eax,[esi] //edx call System.@LStrSetLength //pop edx //push edx lea eax,[esi] call System.@UniqueStringA lea edi,[eax] //edi=string esi pop edx xor bh,bh mov ecx,b//pop ecx //b mov eax,a//pop eax //a add eax,edx add ecx,blen @loop: dec edx dec eax dec ecx xor bl,bl add bl,byte ptr [eax] sub bl,$30 dec blen jl @NoAddB sub bl,byte ptr [ecx] add bl,$30 @NoAddB: sub bl,bh xor bh,bh or bl,bl jge @NoAddP inc bh//add bh,$01 add bl,$0A @NoAddP: add bl,$30 mov byte ptr [edi edx],bl or edx,edx ja @loop pop edi pop esi pop ebx end; i:=0; while result[i 1]='0' do inc(i); delete(result,1,i); if f='-' then result:=f result; end; procedure SwapByPtr(const a,b); asm xchg ecx,[eax] xchg ecx,[edx] xchg ecx,[eax] end;
編輯記錄
roviury 重新編輯於 2009-01-24 20:45:21, 註解 無‧
roviury 重新編輯於 2009-01-24 20:46:46, 註解 無‧ roviury 重新編輯於 2009-01-24 20:51:25, 註解 無‧ roviury 重新編輯於 2009-01-24 21:31:04, 註解 打錯的‧ roviury 重新編輯於 2009-01-29 17:11:38, 註解 無‧ roviury 重新編輯於 2009-01-29 17:15:03, 註解 無‧ roviury 重新編輯於 2009-01-29 17:21:13, 註解 補充‧ roviury 重新編輯於 2009-01-29 18:21:02, 註解 無‧ roviury 重新編輯於 2009-01-30 14:38:28, 註解 代碼補充‧ roviury 重新編輯於 2009-01-30 15:17:59, 註解 修正代碼‧ roviury 重新編輯於 2009-01-31 17:02:39, 註解 無‧ roviury 重新編輯於 2009-01-31 17:33:50, 註解 無‧ roviury 重新編輯於 2009-02-02 17:35:27, 註解 無‧ roviury 重新編輯於 2009-02-02 17:40:27, 註解 無‧ roviury 重新編輯於 2009-02-02 17:43:17, 註解 無‧ roviury 重新編輯於 2009-02-02 17:47:54, 註解 無‧ roviury 重新編輯於 2009-02-02 17:49:18, 註解 無‧ roviury 重新編輯於 2009-02-02 17:51:18, 註解 無‧ roviury 重新編輯於 2009-05-03 00:09:51, 註解 無‧ roviury 重新編輯於 2009-05-03 00:11:12, 註解 無‧ roviury 重新編輯於 2009-05-03 00:13:43, 註解 無‧ roviury 重新編輯於 2009-05-03 00:16:54, 註解 無‧ roviury 重新編輯於 2009-05-03 00:18:05, 註解 無‧ |
roviury
一般會員 發表:3 回覆:49 積分:15 註冊:2008-08-28 發送簡訊給我 |
[code delphi] function A_Mul_B_Mod(const a,b,md:string):string; begin //(a * b) % c = ((a % c) * (b % c)) % c //(a b) % c = ((a % c) (b % c)) % c result:=AsmMod(AsmMul(AsmMod(a,md),AsmMod(b,md)),md) end; function A_Add_B_Mod(const a,b,md:string):string; begin //(a * b) % c = ((a % c) * (b % c)) % c //(a b) % c = ((a % c) (b % c)) % c result:=AsmMod(AsmAdd(AsmMod(a,md),AsmMod(b,md)),md) end; function AsmMod(const s1, s2: String):String; var s1l,s2l,i,j:integer; w,d,e:string; begin if s2='0' then begin result:='E'; exit; end; if s1[1]='-' then begin result:=AsmMod(absX(s1),s2); if result='0' then exit; result:=asmsub(s2,result); exit; end; s2l:=length(s2); d:=stringofchar('0',s2l); i:=length(s1)-1; result:='0'; w:='1'; while i>=0 do begin //if i-s2l 2<1 then s2l:=i 1; //result:=AsmAdd(result,AsmMul(AsmMod_(copy(s1,i-s2l 2,s2l),s2),AsmMod_(w,s2))); if i-s2l 2<1 then e:=copy(s1,1,i 1) else e:=copy(s1,i-s2l 2,s2l); //result:=AsmMod(AsmAdd(result,AsmMod(AsmMul(AsmMod_(e,s2),AsmMod_(w,s2)),s2)),s2); result:=AsmMod_(AsmAdd(result,AsmMod_(AsmMul(AsmMod_(e,s2),AsmMod_(w,s2)),s2)),s2); //result:=AsmAdd(result,AsmMul(AsmMod_(e,s2),AsmMod_(w,s2))); w:=w d; dec(i,s2l); end; //result:=AsmMod_(result,s2); end; function AsmMod_(const s1, s2: String):String; var s,q,c,d:string; i,s2l,ld,w,g:integer; begin g:=length(s1); s2l:=length(s2); if (g exit; end; //Init Begin s:=s1; w:=s2l; c:=copy(s,1,w); if s2>c then begin g:=g-s2l; inc(w); c:=copy(s,1,w); end else g:=g-s2l 1; repeat q:='0'; d:=AsmSub(c,s2); for i := 1 to 9 do begin q:=AsmAdd(q,s2); if less(d,q) then break; end; dec(g); if g=0 then begin result:=AsmSub(c,q); exit; end; d:=AsmSub(c,q); if c=q then begin ld:=0; delete(s,1,w); end else begin ld:=length(d); delete(s,1,w-ld); fastmove(d[1],s[1],ld); end; i:=0; while s[i 1]='0' do begin dec(g); if g=0 then begin result:='0';exit; end; inc(i); end; delete(s,1,i); w:=ld 1; c:=copy(s,1,w); while less(c,s2) do begin dec(g); if g=0 then begin result:=c; exit; end; inc(w); c:=copy(s,1,w); end; until false; end; function loseMinus(const s: String; var b: boolean):string; begin if s='' then exit; if s[1]='-' then begin b:=true; result:=copy(s,2,length(s)-1);//rcopy(pchar(s),1); end else begin b:=false; result:=s; end; end; function absX(const s: String):string; begin if s='' then exit; if s[1]='-' then result:=copy(s,2,length(s)-1) else result:=s; end; function checkPIntStr(const s: String): Boolean; begin result:=Not ((s>=#$40) or ((s<#$31) and (s<>#$30))); end; function AsmX(s1: String; const sD: Char; s2: String):TStrAns; var b1,b2:boolean; begin s1:=loseMinus(s1,b1); s2:=loseMinus(s2,b2); if (Not checkPIntStr(s1)) or (Not checkPIntStr(s2)) then begin result.value:='E'; exit; end; case sD of ' ': begin if b1 and b2 then result.value:='-' AsmAdd(s1,s2) else if b1 then result.value:=AsmSub(s2,s1) else if b2 then result.value:=AsmSub(s1,s2) else result.value:=AsmAdd(s1,s2); end; '-': begin if b1 and b2 then result.value:=AsmSub(s2,s1) else if b1 then result.value:='-' AsmAdd(s1,s2) else if b2 then result.value:=AsmAdd(s1,s2) else result.value:=AsmSub(s1,s2); end; '*': begin if b1 xor b2 then result.value:='-' AsmMul(s1,s2) else result.value:=AsmMul(s1,s2); end; '/': begin if b1 xor b2 then result.value:='-' AsmDiv(s1,s2,result.m) else result.value:=AsmDiv(s1,s2,result.m); //if result.m='-0' then result.m:='0'; end; end; if result.value='-0' then result.value:='0'; end; function AsmMulBase(const x:string; n: byte):string; var t1,e:string; t2,m:byte; begin Result:='0'; while n>1 do begin m:=1; e:=x; repeat t2:=m; m:=m*2; t1:=e; e:=AsmAdd(e,e); until m>=n; if m<>n then begin m:=t2; e:=t1; end; Result:=AsmAdd(Result,e); n:=n-m; end; if n=1 then Result :=AsmAdd(Result,x); end; function AsmMul(const s1, s2: String): String; var i,s2l,k:integer; m:integer;//byte s3:string; p:array[0..9] of string; begin if less(s1,s2) then swapbyptr(s1,s2); s3:='0'; s2l:=length(s2); setlength(result,s2l); k:=0; i:=s2l-1; while i>=0 do begin m:=ord(s2[i 1])-48; if p[m]='' then p[m]:=AsmMulBase(s1,m); s3:=AsmAdd(s3,p[m]); k:=length(s3)-1; result[i 1]:=s3[k 1]; if k=0 then s3[1]:='0' else setlength(s3,k); dec(i); end; if k>0 then result:=s3 result; end; function AsmDiv (const s1, s2: string; var m: string): String; label ea; var s,c,d:string; e,i,s2l,ld,w,g,low,high,mid:integer; p:array[0..9] of string; begin if s2='0' then begin // a div 0=error result:='E'; //error m:='E'; exit; end; e:=length(s1); //e:length of dividend s2l:=length(s2); //s2l:length of divisor被除數 if (e m:=s1; exit; end; //Init Begin s:=s1; //s:被除數 dividend w:=s2l; //w:length of the copy c:=copy(s,1,w); //從被除數中抽前數位 if s2>c then begin //eg.30/4=7 g:=e-s2l; //g:length of result inc(w); c:=copy(s,1,w); end else //eg.30/2=15 and 30/1=30 g:=e-s2l 1; setlength(result,g); e:=0; //e:決定處理result的第幾char p[0]:=s2; for i := 1 to 9 do p[i]:=AsmAdd(p[i-1],s2); repeat low:=1; high:=9; while high-low>1 do begin mid:=(low high)div 2; if great(p[mid],c) then begin high:=mid-1; end else if less(p[mid],c) then begin low:=mid 1; end else begin i:=mid 1; d:='0'; //d差/m餘=c-q goto ea; end; end; for i := low to high do if less(c,p[i]) then break; //c d:=AsmSub(c,p[i-1]); ea: result[e 1]:=chr(i $30); inc(e); if e=g then begin //e已經增至g,end m:=d; //餘=c-q exit; end; //d:=AsmSub(c,q); //d=c-q if d='0' then begin ld:=0; //除法中不會理會差為0 delete(s,1,w); //刪掉s中的c end else begin ld:=length(d); //d:length of d delete(s,1,w-ld); //把s中的copy取代為d(差) fastmove(d[1],s[1],ld); //(同上) end; i:=0; while s[i 1]='0' do begin result[e 1]:='0'; inc(e); if e=g then begin m:='0';exit; end; inc(i); end; delete(s,1,i); w:=ld 1; c:=copy(s,1,w); while less(c,s2) do begin result[e 1]:='0'; inc(e); if e=g then begin m:=c; exit; end; inc(w); c:=copy(s,1,w); end; until false; //m:=c; //if m='' then m:='0'; end; function less(const a,b:String):boolean; begin result:=(length(a) function great(const a,b:String):boolean; begin result:=(length(a)>length(b)) or ((length(a)=length(b)) and (a>b)); end; procedure FastMove (const Source, Dest; const count: Integer);//只是簡化了move var S, D: PChar; I: Integer; begin S := PChar(@Source); D := PChar(@Dest); if S = D then Exit; I:=count-1; while I>=0 do begin D[I] := S[I]; Dec(I); end; end; function SAdd(s:array of string):string; //a b c d var i:integer; begin result:=s[0]; for i := 1 to length(s)-1 do result:=AsmX(result,' ',s[i]).value; end; function SSub(s:array of string):string; //a-b-c-d var i:integer; begin result:=s[0]; for i := 1 to length(s)-1 do result:=AsmX(result,'-',s[i]).value; end; function SMul(s:array of string):string; //a*b*c*d var i:integer; begin result:=s[0]; for i := 1 to length(s)-1 do result:=AsmX(result,'*',s[i]).value; end; function SAddByte(const a: String; b: Byte): String; label k; var i:integer; begin result:=a; i:=length(result)-1; k: inc(Result[i 1],b); if Result[i 1]<#$3A then exit; dec(Result[i 1],10); if i=0 then Result:='1' Result else begin dec(i); b:=1; goto k; end; end; function SSubByte(const a: String; b: Byte): String; label k; var i:integer; begin result:=a; i:=length(result)-1; k: dec(Result[i 1],b); if Result[i 1]>#$30 then exit; if Result[i 1]=#$30 then begin if (i=0) and (a[2]<>#0) then delete(Result,1,1); exit; end; if i=0 then begin Result[1]:=chr(96-ord(Result[1])); Result:='-' Result; end else begin inc(Result[i 1],10); dec(i); b:=1; goto k; end; end; procedure SIncByte(var a: String; b: Byte); label k; var i:integer; begin i:=length(a)-1; k: inc(a[i 1],b); if a[i 1]<#$3A then exit; dec(a[i 1],10); if i=0 then a:='1' a else begin dec(i); b:=1; goto k; end; end; procedure SDecByte(var a: String; b: Byte); label k; var i:integer; begin i:=length(a)-1; k: dec(a[i 1],b); if a[i 1]>#$30 then exit; if a[i 1]=#$30 then begin if (i=0) and (a[2]<>#0) then delete(a,1,1); exit; end; if i=0 then begin a[1]:=chr($60-ord(a[1])); a:='-' a; end else begin inc(a[i 1],10); dec(i); b:=1; goto k; end; end; function logS(const x:string):smallint; begin result:=length(x)-1; end; function powerS(const x:string; n: string):string; var t1,t2,e,m:string; begin Result:='1'; while great(n,'1') do begin m:='1'; e:=x; repeat t2:=m; m:=AsmAdd(m,m); t1:=e; e:=AsmMul(e,e); until not less(m,n); if m<>n then begin m:=t2; e:=t1; end; Result:=AsmMul(Result,e); n:=AsmSub(n,m); end; if n='1' then Result :=AsmMul(Result,x); end; function n_factorial(const x:string):string; var a:String; begin if x='0' then result:='1' else begin a:=x; result:=x; while great(a,'2') do begin sdecbyte(a,1); result:=asmmul(result,a); end; end; end; function SqrS(const x:string):string; begin result:=AsmMul(x,x); end; [/code] 另外,補充開方函數sqrts //decimal是否有小數點,只要作修改,就能開方至小數點無限位,不過我目前沒這需要 [code delphi] function sqrtS(x:string;var decimal:boolean):string; var p,t1,t2,t3,m:string; i:integer; begin result:='0'; if x='0' then exit; p:='1'; while not great(p '00',x) do p:=p '00'; while great(p,'0') do begin result:=AsmMul(result,'10'); t1:=AsmDiv(x,p,m); t2:=AsmMul(result,'2'); i:=9; t3:=AsmAdd(AsmMul(t2,'9'),'81'); while great(t3,t1) do begin dec(i); t3:=SSub([t3,t2,inttostr(2*i 1)]); end; x:=AsmSub(x,AsmMul(t3,p));//x:=AsmSub(x,(t2 i)*i*p);//AsmSub(x,AsmMul(t3,p)); result[length(result)]:=chr(i $30); p:=AsmDiv(p,'100',m); end; decimal:=x<>'0'; end;[/code]
編輯記錄
roviury 重新編輯於 2009-01-30 10:30:16, 註解 無‧
roviury 重新編輯於 2009-01-30 15:08:13, 註解 無‧ roviury 重新編輯於 2009-01-31 17:08:11, 註解 無‧ roviury 重新編輯於 2009-01-31 17:21:45, 註解 無‧ roviury 重新編輯於 2009-02-02 17:53:57, 註解 無‧ roviury 重新編輯於 2009-02-03 22:00:47, 註解 無‧ roviury 重新編輯於 2009-02-03 22:02:02, 註解 無‧ roviury 重新編輯於 2009-05-03 00:12:58, 註解 無‧ roviury 重新編輯於 2009-05-03 00:14:16, 註解 無‧ roviury 重新編輯於 2009-05-03 11:15:36, 註解 無‧ |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |