小弟才疏學淺獻醜就是,但對於樓上老兄的評語也有幾點小小的感受:    1.作技術的人的通病,由於與機器打交道的時間多於與人互動,往往也較有陵有角,越有才華往往個人色彩也越濃厚,討論區,顧名思義是一個聚集人氣,分享交流的一個在網路上的虛擬場合,在這裡我們可以發表意見,同時也可以看到來自大陸香港台灣等四面八方的同好發表的文章,雖然在政治上的統一短時間無法取得共識,至少,在類似像這個討論區的網站上,我們看見了網路無國界,統不統一,倒也不是那麼沉重。    2.衷心覺得能在這裡與前輩們討論交流實在是一件很不錯的事，若能以建議代替批評，在字裡行間不讓人感覺那麼嚴苛，會比較好些，領航天使提這個主題小弟覺得立意實在是不錯，很類似大學教授的做法，不告訴你怎麼做，要你去想，去try，也因此會有各種不同版本的出現，更因為這些版本讓我們可在其中獲益良多，好的做法見賢思齊，不妥的做法也可想想為何要這麼做，換做自己是否也會重蹈覆轍。    3.不是每個人一生下來就會If then，就知道演算法，就知道資料結構，也不是一定要讀過資工資管科系才能寫程式，這個領域很有意思，他既枯燥也有樂趣，既呆板也能發揮創意，悠遊其中卻也是一番風景，雖然很多時候是孤獨的。如此沉重的評論，是否會扼殺掉不少對寫程式有著熱情的同伴們，我，不敢肯定，至少，在心中仍然單純的想著，互相漏氣求進步，臉皮厚一點吧，    

引言: 小弟才疏學淺獻醜就是,但對於樓上老兄的評語也有幾點小小的感受: 1.作技術的人的通病,由於與機器打交道的時間多於與人互動,往往也較有陵有角,越有才華往往個人色彩也越濃厚,討論區,顧名思義是一個聚集人氣,分享交流的一個在網路上的虛擬場合,在這裡我們可以發表意見,同時也可以看到來自大陸香港台灣等四面八方的同好發表的文章,雖然在政治上的統一短時間無法取得共識,至少,在類似像這個討論區的網站上,我們看見了網路無國界,統不統一,倒也不是那麼沉重。 2.衷心覺得能在這裡與前輩們討論交流實在是一件很不錯的事，若能以建議代替批評，在字裡行間不讓人感覺那麼嚴苛，會比較好些，領航天使提這個主題小弟覺得立意實在是不錯，很類似大學教授的做法，不告訴你怎麼做，要你去想，去try，也因此會有各種不同版本的出現，更因為這些版本讓我們可在其中獲益良多，好的做法見賢思齊，不妥的做法也可想想為何要這麼做，換做自己是否也會重蹈覆轍。 3.不是每個人一生下來就會If then，就知道演算法，就知道資料結構，也不是一定要讀過資工資管科系才能寫程式，這個領域很有意思，他既枯燥也有樂趣，既呆板也能發揮創意，悠遊其中卻也是一番風景，雖然很多時候是孤獨的。如此沉重的評論，是否會扼殺掉不少對寫程式有著熱情的同伴們，我，不敢肯定，至少，在心中仍然單純的想著，互相漏氣求進步，臉皮厚一點吧， >< face="Verdana, Arial, Helvetica"> 想不到hahalin林Sir也是性情中人, 站長臨睡前也來湊上一段! 人生因有夢想而偉大, 許多從前我認為是夢想的事, 當它一一實現之後, 卻又認為那是理所當然, 然後又有更高的夢想等著我們去實現, 這就是人生精彩的地方! 沒有人是天生的寫程式好手的, 寫程式是需要經驗的累積的, 從前人的程式中去吸取經驗, 這就是本站成立的意義! 站長也在此呼籲, 有志學程式設計的人, 不要灰心不要氣餒, 一開始寫程式時:見山是山,見水是水 等到學到一定程度時:見山不是山,見水不是水 到了後來才發現,原來:見山又是山,見水又是水 學習的過程本來就是一種波浪循環, 有高潮也有低潮, 只要自己曾經努力過, 曾經為了程式設計癡狂過, 那您的一生就會無怨無悔了! 加油吧,所有的軟體工作者! ～～～Delphi K.Top討論區站長～～～

對不起囉 ! 如果讓各位有任何沉重的感覺或是受批評的感受 !! 小弟只是將想法說出，沒有任何批評的意思 因為不習慣用打字的討論程式寫法 總覺得字打的都不順，只能表達想法的一小部分 小弟還是習慣用說的方式溝通程式技巧 ^_^"" 看來小弟應該再去上上國文課了 不過我可是很認真的將程式看完並思考，才將想法寫出 因為想要簡潔的說出要點，所以言語難免生硬 同時當然也希望能學到更好的方法 所以對於討論能提供一點心得 看到兩位先進的感嘆，實在...不是我期望的 其實只是希望提供意見與討論，不是故意要讓兩位先進產生如此感嘆..實在抱歉 ！ 不知道我有沒有會錯意 ?

function tform1.InfinitAdd(a,b:string):string; var i,j,x,y,c,p:integer; begin c := 0; i := length(a); j := length(b); while 0 <= i j do begin if i > 0 then x := Strtoint(a[i]) else x := 0; if j > 0 then y := Strtoint(b[j]) else y := 0; if x y c > 0 then begin p := (x y c) mod 10; c := (x y c) div 10; result := inttostr(p) result; end; dec(i); dec(j); end; end; //乘(整數運算) 將字串轉換為 二進制 用左旋移位法運算 //cpu 電路的算法 若 32 Bit * 32 Bit 需 32 機械週期 P4(2GHz)=1/2GHz=0.5ns*32 1100 =12 *1100 =12 ------ 0000 0000 1100 1100 --------- 10010000 = 144 //除(整數運算) 將字串轉換為 二進制 用右旋移位法運算 推敲看看...

------
==取之於斯,用之於斯==

看大家對這個主題還是這麼有興趣, 站長突然想來測看看大家寫的執行速度如何, 結果跌破站長的眼鏡! 五位會員的加法部份 測一萬次的50位數加法 用C-466的CPU 結果 john 3.23秒 cjf 4.25秒 hahalin 169.90秒 ccchen 16.5秒 shpeng 239.80秒 這個結果驗證了syntax的說法,遞迴的確會讓程式變得很慢, 也否定了站長先前的說法,採用MUL DIV速度會很慢, 結果用了MUL與DIV的john的執行速度居然第一! 大家再來討論看看! ～～～Delphi K.Top討論區站長～～～

------
～～～Delphi K.Top討論區站長～～～

速度改良版 P3-1G 5秒/10萬次=0.5秒/1萬次 請版主 再測速度.. function tform1.InfinitAdd1(a,b:string):string; var i,j,x,y,c,p:integer;s:String; begin c := 0; i := length(a); j := length(b); while 0 <= i j do begin if i > 0 then x := ord(a[i])-$30 else x := 0; if j > 0 then y := ord(b[j])-$30 else y := 0; if x y c > 0 then begin p := (x y c) mod 10; c := (x y c) div 10; s := chr(p $30) s; end; dec(i); dec(j); end; result := s; end; 有誰歡迎加入競技...

------
==取之於斯,用之於斯==

再加速... function tform1.InfinitAdd(a,b:string):string; var i,j,x,y,c,p:integer;s:String; begin c := 0; i := length(a); j := length(b); while 0 <= i j do begin if i > 0 then x := ord(a[i]) and $0F else x := 0; if j > 0 then y := ord(b[j]) and $0F else y := 0; if x y c > 0 then begin p := (x y c) mod 10; //餘-->dax asm mov c,eax; //商-->eax end; s := chr(p $30) s; end; dec(i); dec(j); end; result := s; end; //測試結果 若將 x,y,c,p 等變數改為 byte 效能更差 //因不最適用於 32Bit CPU

------
==取之於斯,用之於斯==

補述

p := (x y c) mod 10;
MOD 只用了6個 組合命令 比想像中快
00441E8B 8D040F           lea eax,[edi ecx] <--y
00441E8E 0345FC           add eax,[ebp-$04] <--c
00441E91 B90A000000       mov ecx,$0000000a <--10
00441E96 99               cdq 
00441E97 F7F9             idiv ecx
00441E99 8BFA             mov edi,edx  edx<--餘數                                  mov c,eax;   eax<--商

若要在強化速度可以去查 每個命令使用幾個機械週期,再調整, PS 機械週期準則不適用於 xeon cpu 發轟了...別再追根究底了 發表人 - shpeng 於 2002/12/23 12:51:34

------
==取之於斯,用之於斯==

引言: 再加速... function tform1.InfinitAdd(a,b:string):string; var i,j,x,y,c,p:integer;s:String; begin c := 0; i := length(a); j := length(b); while 0 <= i j do begin if i > 0 then x := ord(a[i]) and $0F else x := 0; if j > 0 then y := ord(b[j]) and $0F else y := 0; if x y c > 0 then begin p := (x y c) mod 10; //餘-->dax asm mov c,eax; //商-->eax end; s := chr(p $30) s; end; dec(i); dec(j); end; result := s; end; //測試結果 若將 x,y,c,p 等變數改為 byte 效能更差 //因不最適用於 32Bit CPU

shpeng,不錯喔! 改良版測試結果 1.63秒 再加速版測試結果 1.61秒 這是目前最快的速度喔! ～～～Delphi K.Top討論區站長～～～

加速２版

function tform1.InfinitAdd(a,b:string):string;
var s:String;i,j,n,x,y,c,p:integer;
begin
c := 0;
i := length(a);
j := length(b);
if i-j >= 0        then n := i 1
                else n := j 1;
s := StringOfChar(#$20,n);    while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and $0F
                else x := 0;
        if j >0 then y := ord(b[j]) and $0F
                else y := 0;
        if x y c > 0 then
        begin
                p := (x y c) mod 10;
                asm
                        mov c,eax
                end;
                s[n] := chr(p or $30);
                dec(n);
        end;
        dec(i);
        dec(j);
end;
result := trim(s);
end;

PIII-1.0GHz 6.15秒/100萬次= 0.0615/1萬次 162K次/秒 => 1000000KHz/162K =>6172機械週期/每次 發表人 - shpeng 於 2002/12/23 09:58:07

------
==取之於斯,用之於斯==

function tform1.InfinitSub(a,b:string):string;
var s,f:String;i,j,n,m,x,y,c,p,k:integer;
const Bit0Mark=$0000000001;Byte0Mark=$00000000FF;scale=10;
begin
c := 0;
//調整成 A值 > B值
i := length(a);
j := length(b);
if (j>i) or ((j=i) and (b>a)) then
begin
        s := a;
        a := b;
        b := s;
        f := '-';
        asm
                mov     eax,i
                xchg    eax,j
                mov     i,eax
        end;
end;
//ProcessSegment
if i-j >= 0        then n := i 1
                else n := j 1;
s := StringOfChar(#$20,n);
m := n;
while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and Byte0Mark
                else x := 0;
        if j >0 then y := ord(b[j]) and Byte0Mark
                else y := 0;
        k := (x-y-c);
        if k>=0 then
        begin
                p := (k mod scale);
                c := 0;
        end else begin
                p := (scale k mod scale) ;
                c := 1;
        end;
        s[n] := chr(p or $30);
        dec(n);            dec(i);
        dec(j);
end;
//Clear '0' & space
i := 1;
while (i < m) and ((s[i] = #$20) or (s[i] = #$30)) do
begin
        s[i] := #$20;
        inc(i);
end;
result := f trim(s);
end;

測試效能C-1000 5.4秒/100萬次 50位數

------
==取之於斯,用之於斯==

引言: 加速２版

function tform1.InfinitAdd(a,b:string):string;
var s:String;i,j,n,x,y,c,p:integer;
begin
c := 0;
i := length(a);
j := length(b);
if i-j >= 0        then n := i 1
                else n := j 1;
s := StringOfChar(#$20,n);    while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and $0F
                else x := 0;
        if j >0 then y := ord(b[j]) and $0F
                else y := 0;
        if x y c > 0 then
        begin
                p := (x y c) mod 10;
                asm
                        mov c,eax
                end;
                s[n] := chr(p or $30);
                dec(n);
        end;
        dec(i);
        dec(j);
end;
result := trim(s);
end;

PIII-1.0GHz 6.15秒/100萬次= 0.0615/1萬次 162K次/秒 => 1000000KHz/162K =>6172機械週期/每次 發表人 - shpeng 於 2002/12/23 09:58:07

這個版本的速度為 0.23秒, 哇!一萬次的50位數加法只要0.23秒(用C-466的CPU) 不錯喔! 還有人要挑戰嗎? PS.shpeng 的減法測試結果也是0.24秒左右! ～～～Delphi K.Top討論區站長～～～

引言: 補述

p := (x y c) mod 10;
MOD 只用了6個 組合命令 比想像中快
00441E8B 8D040F           lea eax,[edi ecx] <--y
00441E8E 0345FC           add eax,[ebp-$04] <--c
00441E91 B90A000000       mov ecx,$0000000a <--10
00441E96 99               cdq 
00441E97 F7F9             idiv ecx
00441E99 8BFA             mov edi,edx  edx<--餘數                                  mov c,eax;   eax<--商

若要在強化速度可以去查 每個命令使用幾個機械週期,再調整, PS 機械週期準則不適用於 xeon cpu ^^^^^^^^<=有沒有想要試試看？我是PIII Xeon 512K 550 X2 ..XD 發轟了...別再追根究底了 發表人 - shpeng 於 2002/12/23 12:51:34

= Delphi - Emulator = 發表人 - Emulator 於 2002/12/29 18:01:52

各位長官 累了是否可以換個主題?? 小弟目前遇到類似的問題 我想現實程式中除了科學計算 應該沒有商用程式會用到無限位數的加減乘除 但倒是會常用求無限位數除以某一數字的餘數 例如小弟接觸的領域-POS 系統 現在超商都可代收瓦斯費,水電費,罰款費 目前共有 8 種類別的檢查條碼公式 有幾個公式是將三段代收條碼相加(將近20位數)然後除以7,檢查碼就是該餘數 用一個長整數變數當然不能帶入這 20 位數 所以小弟目前是用山不轉路轉的方式帶入浮點數 在小心翼翼的利用 MOD (BCB 用 %)求餘數(中間當然有避掉 BUG 的機制) 但這應不是聰明的方法 想過利用字串一個一個去除(就像自己拿白紙用手算的方法) 應該也就是各位長官所指的算盤式方法 所以在此想利用各位長官敦馬桶的時間 來幫小弟寫一個無限位數的求餘數公式 我想這類計算條碼檢查碼的應用應該會更常被使用到 在此先謝啦 ....

各位大大的研究精神真是令人佩服 小弟是從VB領域跳到delphi領域的新手 當我以VB的方法去嘗試的時候 發現題目是 "無限位數"的加減乘除 那麼程式中，將A、B字串長度轉換為變數時， 用INT是否會有問題？

引言: 各位大大的研究精神真是令人佩服 小弟是從VB領域跳到delphi領域的新手 當我以VB的方法去嘗試的時候 發現題目是 "無限位數"的加減乘除 那麼程式中，將A、B字串長度轉換為變數時， 用INT是否會有問題？

若您採用VB的轉換函式將字串轉為數字當然會有位數的問題 所以要以字串對字串的處理方式來運算 ～～～Delphi K.Top討論區站長～～～

抱歉 上次發表的不完整 因為我有看到 用變數(int型態)將第一(及第二)個字串的長度存取 假設無限位數 那麼就不應該限定其長度在int範圍內 還是說之後的程式沒有這麼做? 因為我只看了前面幾個^^

貼上我用vba寫的程式碼^^ Public Function test_add(lk_a As String, lk_b As String) As String Dim a As String Dim b As String Dim c As Integer Dim result As String Dim iften As Boolean Dim inta As Integer Dim intb As Integer a = lk_a b = lk_b iften = False result = "" Do If a <> "" Then inta = Val(Right(a, 1)) Else inta = 0 End If If b <> "" Then intb = Val(Right(b, 1)) Else intb = 0 End If If iften = True Then c = 1 Else c = 0 End If c = inta intb If c > 10 Then iften = True c = c - 10 Else iften = False End If result = Trim(Str(c)) & result If a <> "" Then a = Left(a, Len(a) - 1) If b <> "" Then b = Left(b, Len(b) - 1) Loop Until a = "" And b = "" test_add = result End Function

抱歉 修正一下上述的程式碼 if c > 10 改為 if c > 9 

To Bruce大大 無限位數求餘數程式(用VBA寫的)

Public Function test_divide(lk_a As String) As String
    Dim a As String
    Dim i As Integer
    Dim result As Integer
    Dim inta As Integer        
    a = lk_a
    inta = 0
    
    Do
        
        If inta <> 0 Then
            a = Trim(Str(inta)) & a
        End If
        
        If Int(Left(a, 1)) >= 7 Then
            i = 1
            inta = Int(Left(a, 1))
        Else
            If Len(a) >= 2 Then
                i = 2
                inta = Int(Left(a, 2))
            Else
                i = 1
                inta = Int(a)
            End If
            
        End If
        
        a = Right(a, Len(a) - i)
        
        Do While inta >= 7
            inta = inta - 7
        Loop
        
    Loop Until a = ""
    
    result = inta
    test_divide = Str(result)
End Function

小弟有另外一個想法供個參考,不知道對不對 我們可以模仿計算機處理二進制的方法處理無限位數的加,減,乘,除, 而且可以推廣到任意進制 去.    思路 : 首先確定原子算法. 然後把加法 轉化為N個原子算法 , 然後把減法 轉化為加法(取反,求余),然後把乘法轉化為加法(要使用遞推算法).       即將計算機對Byte位的操作 轉化為程式對Array 元素的操作;       將2進制按位加法轉化成 10進制按位加法           對於 加法 :      原子算法 :         A  ------被加數          exp:   6        +B  -------加數                 +7        +C  -------進位                 +0      ______                          ______        DE    D---進位   E  進位         13        Procedure  AtomAdd(A,B,C,E,D) ;     begin       根據A,B,C 修改E,D     end;       對於加法       m位+ n位 = x位           if m> n then      申請Array       A[m+1] ------存被加數 第一位為0       B[m+1]  -------存加數  第一位為0       C[m+1]  --------存進位 初始值位00000..... //m+1個0       D[m+1]  --------存結果 初始值位00000..... //m+1個0;     加法分解成AtomAdd 的過程入下 :        Function Add(A,B,C ,D) :string;     begin       for i:= 1 to m  do       begin         AtomAdd(A[i],B[i],C[i],C[i+1],D[i]) ;       end;      整理Array D 返回結果         end;       對於減法 (轉化為加法):        舉個例子就清楚了        45621256                 45621256        -32564897     取補---->  +67435103       ------------      <===>  ------------                                113056359      轉換 113056359  對與頭兩位 1X=X  0X=-X       SO  113056359 <==>13056359      對於乘法 :       思路 :轉化為加法 ;     舉例如下 :        546789465556  *43673           計算過程     0+ 4次546789465556  = a0 ;     a右補0 + 3次546789465556 = a1 ;     a1補0  + 6次546789465556 =a2 ;     a2補0  + 7次546789465556 =a3;     a3補0  + 3次546789465556 =結果 ;     除法 由於算法記不清楚了 ,待以後補充 . 小弟提出的只是一種思路 由於沒有時間去實現 還請各位大大見諒 .                                                                                                                                                 Good Day

------
Good Day

小弟有另外一個想法供個參考,不知道對不對 我們可以模仿計算機處理二進制的方法處理無限位數的加,減,乘,除, 而且可以推廣到任意進制 去. 思路 : 首先確定原子算法. 然後把加法 轉化為N個原子算法 , 然後把減法 轉化為加法(取反,求余),然後把乘法轉化為加法(要使用遞推算法). 即將計算機對Byte位的操作 轉化為程式對Array 元素的操作; 將2進制按位加法轉化成 10進制按位加法 對於 加法 : 原子算法 : A ------被加數 B -------加數 C -------進位 ______ DE D---進位 E 進位 exp : 6 7 0 ---- 13 Procedure AtomAdd(A,B,C,E,D) ; begin 根據A,B,C 修改E,D end; 對於加法 m位 n位 = x位 if m> n then 申請Array A[m 1] ------存被加數 第一位為0 B[m 1] -------存加數 第一位為0 C[m 1] --------存進位 初始值位00000..... //m 1個0 D[m 1] --------存結果 初始值位00000..... //m 1個0; 加法分解成AtomAdd 的過程入下 : Function Add(A,B,C ,D) :string; begin for i:= 1 to m do begin AtomAdd(A[i],B[i],C[i],C[i 1],D[i]) ; end; 整理Array D 返回結果 end; 對於減法 (轉化為加法): 舉個例子就清楚了 45621256 45621256 -32564897 取補----> 67435103 ------------ <===> ------------ 113056359 轉換 113056359 對與頭兩位 1X=X 0X=-X SO 113056359 <==>13056359 對於乘法 : 思路 :轉化為加法 ; 舉例如下 : 546789465556 *43673 計算過程 0 4次546789465556 = a0 ; a右補0 3次546789465556 = a1 ; a1補0 6次546789465556 =a2 ; a2補0 7次546789465556 =a3; a3補0 3次546789465556 =結果 ; 除法 由於算法記不清楚了 ,待以後補充 . 小弟提出的只是一種思路 由於沒有時間去實現 還請各位大大見諒 . Good Day

------
Good Day

各位前輩們好... 小弟剛剛發現這裡有個問題 就是假如： 小弟用 7533967、9876543210 兩數呼叫乘法 function 去計算出一個 74409550618214070 值後 然後再用 74409550618214070、9876543210 兩數呼叫除法 function 卻算不回來原本的 7533967 值，而出現錯誤訊息 這是 BUG 嗎?    恕 小弟才疏學潛...能請各位前輩們幫忙解答嗎? 謝謝..    

引言: 站長整理最後解答如下:(範例程式碼)

unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;    type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;    var
  Form1: TForm1;    implementation    {$R *.DFM}
function OPAdd(var s:string;id,value:integer):integer;
var ss,sv:string;
begin
  Result:=0;
  if id<=0 then begin
    sv:=inttostr(value);
    s:=sv s;
    Result:=length(sv);
  end
  else begin
    ss:=intTostr(ord(s[id])-48 value);
    if length(ss) > 1 then begin
      s[id]:=ss[2];
      Result:=OPAdd(s, id-1, ord(ss[1])-48);
    end
    else
      s[id]:=ss[1];
  end;
end;    procedure OPSub(var s:string;id,value:integer);
var r:integer;
begin
  if id=0 then
    s:='-' s
  else begin
    r:=ord(s[id])-48-value;
    if r < 0 then begin
      r:=r 10;
      OPsub(s, id-1, 1);
    end;
    s[id]:=chr(r 48);
  end;
end;
function InfinitAdd(s1,s2:string):string;
var i,n1,n2:integer;
begin
  n1:=length(s1);
  n2:=length(s2);
  if n2 > n1 then
    Result:=InfinitAdd(s2,s1)
  else begin
    Result:=s1;
    for i:=1 to n2 do
      n1:=n1 OPadd(Result,n1-n2 i, ord(s2[i])-48);
  end;
end;    function InfinitSub(s1,s2:string):string;
var i,n1,n2:integer;
begin
  n1:=length(s1);
  n2:=length(s2);
  if ( (n2 > n1) or ((n2=n1) and (s1 < s2))) then
    Result:='-' InfinitSub(s2,s1)
  else begin
    Result:=s1;
    for i:=1 to n2 do
      OPSub(Result,n1-n2 i, ord(s2[i])-48);
  end;
end;    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;
procedure DeleteLD0(var s:string);
begin
  while (s[1]='0') and (length(s)>1) do delete(s,1,1);
end;    function _InfinitDiv(s1,s2:string;var res:string):string;
var n1,n2,n,r:integer;
  c:char;
  stemp:string;
begin
  n1:=length(s1);
  n2:=length(s2);
  if ( (n2 > n1) or ((n2=n1) and (s1< s2))) then begin
    Result:='';
    res:=s1;
  end
  else begin
    n := n1 - n2-1;
    if s2[1] <= s1[1] then
      inc(n);
    if s1[1] >= s2[1] then
      r:= (ord(s1[1])-48) div (ord(s2[1])-48)
    else
      r:=strToint(res[1] res[2]) div (ord(s2[1])-48);
    repeat
      if r=0 then begin
        dec(n);
        r:=9;
        Result:='0';
      end;
      c:= chr(r 48);
      stemp:=c StringofChar('0',n);
      res:= infinitsub(s1, infinitmul(s2,stemp));
      DeleteLD0(res);
      dec(r);
    until res[1] <> '-';
    Result:=Result infinitAdd(stemp,_infinitDiv(res, s2, res));
  end;
end;
function InfinitDiv(s1,s2:string):string;
var res:string;
begin
  result:=_InfinitDiv(s1,s2,res);
  if result='' then result:='0';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.caption:=InfinitAdd(edit1.text,edit2.text);
end;    procedure TForm1.Button2Click(Sender: TObject);
begin
  Label1.caption:=InfinitSub(edit1.text,edit2.text);    end;    procedure TForm1.Button3Click(Sender: TObject);
begin
  Label1.caption:=InfinitMul(edit1.text,edit2.text);    end;    procedure TForm1.Button4Click(Sender: TObject);
begin
  Label1.caption:=InfinitDiv(edit1.text,edit2.text);
end;    end.

P.S:若有網友認為您可以寫出更好的演算法,就再接力賽吧! ～～～Delphi K.Top討論區站長～～～

發表人 - worldone 於 2004/05/20 14:30:11

^_^" 首先謝謝大大的辛勞... 小弟發現 BUG 所在 就是 當我使用 2 + 3 = 5 這是正確的 但是 200 + 300 竟然還是等於 5 於是我測試了其他數字...發現加速2版把 0 都省略掉了... 只有算數字 1 ~ 9 的加法 @@" 接著想請問大大不知道您是否有寫過 求餘數的 function 呢? 因為數字太大，超過12個位數的數字，不能直接做 mod 運算所以都出現錯誤 可否請大大教教我... 下週二趕著教程式作業...的小傢伙留     PS: 若是大大太忙碌也沒關係，小弟我只好慢慢啃書了...希望還能來得及 謝謝囉...    

引言:

引言: 加速２版

function tform1.InfinitAdd(a,b:string):string;
var s:String;i,j,n,x,y,c,p:integer;
begin
c := 0;
i := length(a);
j := length(b);
if i-j >= 0        then n := i 1
                else n := j 1;
s := StringOfChar(#$20,n);    while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and $0F
                else x := 0;
        if j >0 then y := ord(b[j]) and $0F
                else y := 0;
        if x y c > 0 then
        begin
                p := (x y c) mod 10;
                asm
                        mov c,eax
                end;
                s[n] := chr(p or $30);
                dec(n);
        end;
        dec(i);
        dec(j);
end;
result := trim(s);
end;

PIII-1.0GHz 6.15秒/100萬次= 0.0615/1萬次 162K次/秒 => 1000000KHz/162K =>6172機械週期/每次 發表人 - shpeng 於 2002/12/23 09:58:07

這個版本的速度為 0.23秒, 哇!一萬次的50位數加法只要0.23秒(用C-466的CPU) 不錯喔! 還有人要挑戰嗎? PS.shpeng 的減法測試結果也是0.24秒左右! ～～～Delphi K.Top討論區站長～～～

自己用inttostr函數轉來轉去果然效能差很多.. 學習shpeng解法 發現加速最主要在於ord(x and $0F) 那技巧 跟著改成那樣後.. 加法速度就與加速二版差異不大 因看不懂asm @@" 不曉得asm那區塊是不是因硬體而差異很大 也不大清楚加速二版的問題在哪 不過確實在「兩數同一位數均為0」時會算錯    

function add_str(s1,s2:string):string;
  var tmp:string;
      i,n,len1,len2:integer;
begin
  if length(s1)>length(s2) then
  begin
    tmp:=s1;
    s1:=s2;
    s2:=tmp;
  end;      len1:=length(s1);
  len2:=length(s2);
  if len19 then
    begin
      //tmp[len2 1-i]:=chr(48 n mod 10);
      //tmp[len2-i]:= chr(48 n div 10);
      tmp[len2 1-i]:=chr($30 or (n mod 10));
      tmp[len2-i]:= chr($30 or (n div 10));
    end
    else
      //tmp[len2 1-i]:=chr(48 n);
      tmp[len2 1-i]:=chr($30 or n);
  end;
  if tmp[1]='0' then delete(tmp,1,1);
  result:=tmp;
end;

糟糕~ 認真測下去才發現自己程式那麼不嚴謹 連加法都有錯..漏洞百出.. 要加油了~ 後來再改的.. 不知對不對.. < class="code"> function add_str(s1,s2:string):string; var tmp:string; i,n,len1,len2:integer; iadd:integer; //進位數 begin if length(s1)>length(s2) then begin tmp:=s1; s1:=s2; s2:=tmp; end; len1:=length(s1); len2:=length(s2); if len19 then begin tmp[len2 1-i]:=chr($30 or (n mod 10)); iadd:=n div 10; end else tmp[len2 1-i]:=chr($30 or n); end; if tmp[1]='0' then delete(tmp,1,1); result:=tmp; end; function subt_str(s1,s2:string):string; var i,len1,len2,len:integer; begin (* 減法原理: 用9的補數 (變成加法) a - b = a b's 9補 if 進位 去掉並 1 else 還原9補並變負號(表示 小-大) ex: 123-34=89 -> 123 (965) -> 1088(進位了) -> 088 1=89 34-123=-89 -> 34 (876) -> 910(未進位) -> -089 *) s1:=ltrim_str(s1); s2:=ltrim_str(s2); if comparestr(s1,s2)=0 then begin result:='0'; exit; end; len1:=length(s1); len2:=length(s2); if len1len then //進位(大-小) begin delete(s1,1,1); //去除溢位 result:=add_str(s1,'1'); //加1 end else //小-大 begin for i:=1 to len do //還原9補數 s1[i]:=chr(9-(ord(s1[i]) and $0f) or $30); result:='-' s1; //加負號 end; end; function multi_str(s1,s2:string):string; var tmp1,sum:string; i,j,len2:integer; begin sum:='0'; len2:=length(s2); for i:=1 to len2 do begin tmp1:='0'; for j:=1 to (ord(s2[i]) and $0f) do //*** for 1 to 0 do nothing tmp1:=add_str(s1 stringofchar('0',len2-i),tmp1); sum:=add_str(sum,tmp1); end; result:=ltrim_str(sum); end; // 123456 / 124; 144/12; 124/123456 function div_str(s1,s2:string;out smod:string):string; var sdiv,tmp1:string; cnt:integer; begin s1:=ltrim_str(s1); s2:=ltrim_str(s2); if comp_str(s1,s2)>=0 then begin sdiv:=''; while(s1<>'')do begin while((comp_str(s2,tmp1)>0)) and (s1<>'')do begin tmp1:=tmp1 copy(s1,1,1); delete(s1,1,1); sdiv:=sdiv '0'; end; if (comp_str(tmp1, s2)>=0) then // '1234' / '124' begin cnt:=0; while(comp_str(tmp1,s2)>=0)do begin inc(cnt); tmp1:=subt_str(tmp1,s2); end; sdiv:=add_str(sdiv, chr($30 or cnt)); end; end; smod:=ltrim_str(tmp1); result:=ltrim_str(sdiv); end else begin smod:=s1; result:='0'; end; end; function ltrim_str(s1:string):string; var i:integer; begin if s1<>'' then begin if s1[1]='-' then s1:=s1[1] ltrim_str(copy(s1,2,length(s1)-1)); for i:=1 to length(s1) do if s1[i]='0' then s1[i]:=' ' else break; result:=trim(s1); end else result:=s1; if result='' then result:='0'; end; function comp_str(s1,s2:string):integer; var i:integer; nRtn:integer; begin s1:=ltrim_str(s1); s2:=ltrim_str(s2); if comparestr(s1,s2)=0 then nRtn:=0 else begin if length(s1)=length(s2) then begin for i:=1 to length(s1) do if s1[i]<>s2[i] then begin nRtn:=(ord(s1[i]) and $0f-ord(s2[i]) and $0f); break; end; end else nRtn:=length(s1)-length(s2); end; result:=nRtn; end; 發表人 - peipei36 於 2004/05/30 22:38:36

 
function tform1.InfinitAdd(a,b:string):string;
var s:String;i,j,n,x,y,c,p:integer;
begin
c := 0;
i := length(a);
j := length(b);
if i-j >= 0        then n := i 1
                else n := j 1;    s := StringOfChar(#$20,n);
while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and $0F
                else x := 0;
        if j >0 then y := ord(b[j]) and $0F
                else y := 0;
        if x y c i j > 0 then   //BUG 已修正,謝謝指教
        begin
                p := (x y c) mod 10;
                asm
                        mov c,eax
                end;
                s[n] := chr(p or $30);
                dec(n);
        end;
        dec(i);
        dec(j);
end;
result := trim(s);
end;

==取之於斯,用之於斯==

------
==取之於斯,用之於斯==

a new bug? 74409550618214070+9876543210=09560494757280??? <>< face="Verdana, Arial, Helvetica">引言:

 
function tform1.InfinitAdd(a,b:string):string;
var s:String;i,j,n,x,y,c,p:integer;
begin
c := 0;
i := length(a);
j := length(b);
if i-j >= 0        then n := i 1
                else n := j 1;    s := StringOfChar(#$20,n);
while 0 <= i j do
begin
        if i >0 then x := ord(a[i]) and $0F
                else x := 0;
        if j >0 then y := ord(b[j]) and $0F
                else y := 0;
        if x y c i j > 0 then   //BUG 已修正,謝謝指教
        begin
                p := (x y c) mod 10;
                asm
                        mov c,eax
                end;
                s[n] := chr(p or $30);
                dec(n);
        end;
        dec(i);
        dec(j);
end;
result := trim(s);
end;

==取之於斯,用之於斯==

除法有 BIG BUG < >< > <>< face="Verdana, Arial, Helvetica">引言: 各位前輩們好... 小弟剛剛發現這裡有個問題 就是假如： 小弟用 7533967、9876543210 兩數呼叫乘法 function 去計算出一個 74409550618214070 值後 然後再用 74409550618214070、9876543210 兩數呼叫除法 function 卻算不回來原本的 7533967 值，而出現錯誤訊息 這是 BUG 嗎? 恕 小弟才疏學潛...能請各位前輩們幫忙解答嗎? 謝謝.. [quote] 站長整理最後解答如下:(範例程式碼) [code] unit Unit1; ...... procedure DeleteLD0(var s:string); begin while (s[1]='0') and (length(s)>1) do delete(s,1,1); end; function _InfinitDiv(s1,s2:string;var res:string):string; var n1,n2,n,r:integer; c:char; stemp:string; begin n1:=length(s1); n2:=length(s2); if ( (n2 > n1) or ((n2=n1) and (s1< s2))) then begin Result:=''; res:=s1; end else begin n := n1 - n2-1; if s2[1] <= s1[1] then inc(n); if s1[1] >= s2[1] then r:= (ord(s1[1])-48) div (ord(s2[1])-48) else r:=strToint(res[1] res[2]) div (ord(s2[1])-48); repeat if r=0 then begin dec(n); r:=9; Result:='0'; end; c:= chr(r 48); stemp:=c StringofChar('0',n); res:= infinitsub(s1, infinitmul(s2,stemp)); DeleteLD0(res); dec(r); until res[1] <> '-'; Result:=Result infinitAdd(stemp,_infinitDiv(res, s2, res)); end; end; function InfinitDiv(s1,s2:string):string; var res:string; begin result:=_InfinitDiv(s1,s2,res); if result='' then result:='0'; end; ....... 發表人 - worldone 於 2004/05/20 14:30:11

各位好 看了諸位的程式碼想問一下 1.好像似乎都是一位一位數的在算？這樣比較好嗎？ 2.這邊的除法是不是還有問題？    其實我學的是VB，不過像這種東西在VB領域實在是找不到啊... 附上我自己的程式碼，是一個物件類別模組給VB6用的    加減乘都完成了，其中加法比cutedune前輩快了15% 其他不明

Private Type BigNum
   Number() As Long '數字陣列
   Digit As Long '陣列長度
   'Decimal As Long '小數位數
End Type
Private Type Number
   Num1 As BigNum
   Num2 As BigNum
   NumE As BigNum
End Type    Private Number As Number
Private TLngA As Long, TLngB As Long, TLngEnd As Long
'乘法部分最初參考自http://fjt.todayisp.com:7751/www.sijiqing.com/vbgood/forum/forum_posts.asp?TID=10668&PN=1    '檢查輸入數字為整數
Private Function CheckValue(ByVal Value As String, SLong As Long, RetBigNum As BigNum) As Boolean
   Value = Trim(Value)
   Do
      If Left(Value, 1) = "0" Then
         Value = Mid(Value, 2, Len(Value) - 1)
      Else
         Exit Do
      End If
   Loop
   If Value = "" Or Value = "." Then Value = "0"
   For TLngA = 1 To Len(Value)
      Select Case Mid(Value, TLngA, 1)
         Case "0" To "9"
         Case Else
            Exit Function
      End Select
   Next TLngA
   With RetBigNum
      .Digit = (Len(Value) - 1) \ SLong + 1
      ReDim .Number(.Digit) As Long
      For TLngA = 1 To .Digit
         .Number(TLngA) = Right(Value, SLong)
         If TLngA < .Digit Then Value = Left(Value, Len(Value) - SLong)
      Next TLngA
   End With
   CheckValue = True
End Function    '初始化兩個大數
'乘法取4位,加法9位
Private Function InitCalc(ByVal ValF As String, ByVal ValT As String, SLong As Long) As Boolean
   If CheckValue(ValF, SLong, Number.Num1) And CheckValue(ValT, SLong, Number.Num2) Then InitCalc = True
End Function    Private Function SetOut(NumE As BigNum, SLong As Long) As String
   Dim TStr0 As String
   TStr0 = String(SLong, "0")
   With NumE
      For TLngA = 1 To .Digit - 2
         SetOut = Format(.Number(TLngA), TStr0) & SetOut
      Next TLngA
      SetOut = CStr(.Number(.Digit) * (10 ^ SLong) + .Number(.Digit - 1)) & SetOut
   End With
   With Number
      .Num1.Digit = 0
      .Num2.Digit = 0
      .NumE.Digit = 0
      Erase .Num1.Number
      Erase .Num2.Number
      Erase .NumE.Number
   End With
End Function    Public Function Mul(ByVal Multiplicand As String, ByVal Multiplicator As String) As String
   '將兩個大數從後往前拆成以每4個數一組計算，這樣不會超出Long的類型範圍
   If Not InitCalc(Multiplicand, Multiplicator, 4) Then
      Mul = "0"
   Else
      With Number
         .NumE.Digit = .Num1.Digit + .Num2.Digit
         ReDim .NumE.Number(.NumE.Digit) As Long
         For TLngA = 1 To .Num1.Digit
             For TLngB = 1 To .Num2.Digit
                 TLngEnd = .Num2.Number(TLngB) * .Num1.Number(TLngA)
                 .NumE.Number(TLngA + TLngB - 1) = .NumE.Number(TLngA + TLngB - 1) + TLngEnd   '將乘積加在結果的相應位置
                 .NumE.Number(TLngA + TLngB) = .NumE.Number(TLngA + TLngB) + (.NumE.Number(TLngA + TLngB - 1) \ 10000) '進位
                 .NumE.Number(TLngA + TLngB - 1) = .NumE.Number(TLngA + TLngB - 1) Mod 10000 '每一個數組只保留後四位
             Next TLngB
         Next TLngA
         Mul = SetOut(.NumE, 4)
      End With
   End If
End Function    Public Function Add(ByVal Val1 As String, ByVal Val2 As String) As String
   If Not InitCalc(Val1, Val2, 9) Then
      Add = "0"
   Else
      With Number
         If .Num1.Digit > .Num2.Digit Then
            .NumE.Digit = .Num1.Digit + 1
            ReDim Preserve .Num2.Number(.Num1.Digit) As Long
         Else
            .NumE.Digit = .Num2.Digit + 1
            ReDim Preserve .Num1.Number(.Num2.Digit) As Long
         End If
         ReDim .NumE.Number(.NumE.Digit) As Long
         For TLngA = 1 To .NumE.Digit - 1
            .NumE.Number(TLngA) = .NumE.Number(TLngA) + .Num1.Number(TLngA) + .Num2.Number(TLngA)
            If .NumE.Number(TLngA) >= 1000000000 Then
               .NumE.Number(TLngA) = .NumE.Number(TLngA) - 1000000000
               .NumE.Number(TLngA + 1) = 1
            End If
         Next TLngA
         Add = SetOut(.NumE, 9)
      End With
   End If
End Function    Public Function Min(ByVal Val1 As String, ByVal Val2 As String) As String
   If Not InitCalc(Val1, Val2, 9) Then
      Min = "0"
   Else
      With Number
         If .Num1.Digit > .Num2.Digit Then
            .NumE.Digit = .Num1.Digit + 1
            ReDim Preserve .Num2.Number(.Num1.Digit) As Long
         Else
            .NumE.Digit = .Num2.Digit + 1
            ReDim Preserve .Num1.Number(.Num2.Digit) As Long
         End If
         ReDim .NumE.Number(.NumE.Digit) As Long
         For TLngA = 1 To .NumE.Digit - 1
            .NumE.Number(TLngA) = .NumE.Number(TLngA) + .Num1.Number(TLngA) - .Num2.Number(TLngA)
            If .NumE.Number(TLngA) < 0 Then
               .NumE.Number(TLngA) = .NumE.Number(TLngA) + 1000000000
               .NumE.Number(TLngA + 1) = -1
            End If
         Next TLngA
         Min = SetOut(.NumE, 9)
      End With
   End If
End Function