線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:17760
推到 Plurk!
推到 Facebook!
[<<] [1] [2] [3] [>>]

站長出個題目給大家寫寫:無限位數的加減乘除

 
mayday741130
一般會員


發表:11
回覆:8
積分:3
註冊:2006-07-22

發送簡訊給我
#62 引用回覆 回覆 發表時間:2006-10-23 00:53:41 IP:220.140.xxx.xxx 訂閱
n:=n OPAdd(Result,n-n1-n2 i j,(ord(s2[i])-48) * (ord(s1[j])-48))
這行出現Error, 「Missing operator or semicolon」
是什麼原因呢???
------
小LO
mayday741130
一般會員


發表:11
回覆:8
積分:3
註冊:2006-07-22

發送簡訊給我
#63 引用回覆 回覆 發表時間:2006-10-23 01:18:01 IP:220.140.xxx.xxx 訂閱

===================引 用 文 章===================
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

發送簡訊給我
#64 引用回覆 回覆 發表時間:2006-11-24 23:20:38 IP:61.225.xxx.xxx 訂閱
乘的部份 若有負數 答案就會是錯誤的
------
努力不懈
kobemagic2001
一般會員


發表:10
回覆:6
積分:3
註冊:2006-07-24

發送簡訊給我
#65 引用回覆 回覆 發表時間:2006-11-24 23:36:06 IP:61.225.xxx.xxx 訂閱
此乘法 測試之後 發現 若加上負數 結果會是錯誤的
------
努力不懈
roviury
一般會員


發表:3
回覆:49
積分:15
註冊:2008-08-28

發送簡訊給我
#66 引用回覆 回覆 發表時間:2009-01-23 19:35:40 IP:203.186.xxx.xxx 訂閱
不論有沒有人再理會這篇文章,我也希望寫出來給大家參考,因為我用了這套算法很久,都沒有任何出錯,這次要令找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; //afunction 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

發送簡訊給我
#67 引用回覆 回覆 發表時間:2009-01-24 20:44:23 IP:203.186.xxx.xxx 訂閱
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 //then begin
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(a,b);
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

發送簡訊給我
#68 引用回覆 回覆 發表時間:2009-01-30 00:34:38 IP:203.186.xxx.xxx 訂閱

[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 result:=s1;
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 result:='0';
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)end;
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] [>>]
系統時間:2024-04-26 11:06:42
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!