站長出個題目給大家寫寫:無限位數的加減乘除 |
|
hahalin
版主 發表:295 回覆:1698 積分:823 註冊:2002-04-14 發送簡訊給我 |
小弟才疏學淺獻醜就是,但對於樓上老兄的評語也有幾點小小的感受: 1.作技術的人的通病,由於與機器打交道的時間多於與人互動,往往也較有陵有角,越有才華往往個人色彩也越濃厚,討論區,顧名思義是一個聚集人氣,分享交流的一個在網路上的虛擬場合,在這裡我們可以發表意見,同時也可以看到來自大陸香港台灣等四面八方的同好發表的文章,雖然在政治上的統一短時間無法取得共識,至少,在類似像這個討論區的網站上,我們看見了網路無國界,統不統一,倒也不是那麼沉重。 2.衷心覺得能在這裡與前輩們討論交流實在是一件很不錯的事,若能以建議代替批評,在字裡行間不讓人感覺那麼嚴苛,會比較好些,領航天使提這個主題小弟覺得立意實在是不錯,很類似大學教授的做法,不告訴你怎麼做,要你去想,去try,也因此會有各種不同版本的出現,更因為這些版本讓我們可在其中獲益良多,好的做法見賢思齊,不妥的做法也可想想為何要這麼做,換做自己是否也會重蹈覆轍。 3.不是每個人一生下來就會If then,就知道演算法,就知道資料結構,也不是一定要讀過資工資管科系才能寫程式,這個領域很有意思,他既枯燥也有樂趣,既呆板也能發揮創意,悠遊其中卻也是一番風景,雖然很多時候是孤獨的。如此沉重的評論,是否會扼殺掉不少對寫程式有著熱情的同伴們,我,不敢肯定,至少,在心中仍然單純的想著,互相漏氣求進步,臉皮厚一點吧,
|
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 小弟才疏學淺獻醜就是,但對於樓上老兄的評語也有幾點小小的感受: 1.作技術的人的通病,由於與機器打交道的時間多於與人互動,往往也較有陵有角,越有才華往往個人色彩也越濃厚,討論區,顧名思義是一個聚集人氣,分享交流的一個在網路上的虛擬場合,在這裡我們可以發表意見,同時也可以看到來自大陸香港台灣等四面八方的同好發表的文章,雖然在政治上的統一短時間無法取得共識,至少,在類似像這個討論區的網站上,我們看見了網路無國界,統不統一,倒也不是那麼沉重。 2.衷心覺得能在這裡與前輩們討論交流實在是一件很不錯的事,若能以建議代替批評,在字裡行間不讓人感覺那麼嚴苛,會比較好些,領航天使提這個主題小弟覺得立意實在是不錯,很類似大學教授的做法,不告訴你怎麼做,要你去想,去try,也因此會有各種不同版本的出現,更因為這些版本讓我們可在其中獲益良多,好的做法見賢思齊,不妥的做法也可想想為何要這麼做,換做自己是否也會重蹈覆轍。 3.不是每個人一生下來就會If then,就知道演算法,就知道資料結構,也不是一定要讀過資工資管科系才能寫程式,這個領域很有意思,他既枯燥也有樂趣,既呆板也能發揮創意,悠遊其中卻也是一番風景,雖然很多時候是孤獨的。如此沉重的評論,是否會扼殺掉不少對寫程式有著熱情的同伴們,我,不敢肯定,至少,在心中仍然單純的想著,互相漏氣求進步,臉皮厚一點吧, >>< face="Verdana, Arial, Helvetica"> 想不到hahalin林Sir也是性情中人, 站長臨睡前也來湊上一段! 人生因有夢想而偉大, 許多從前我認為是夢想的事, 當它一一實現之後, 卻又認為那是理所當然, 然後又有更高的夢想等著我們去實現, 這就是人生精彩的地方! 沒有人是天生的寫程式好手的, 寫程式是需要經驗的累積的, 從前人的程式中去吸取經驗, 這就是本站成立的意義! 站長也在此呼籲, 有志學程式設計的人, 不要灰心不要氣餒, 一開始寫程式時:見山是山,見水是水 等到學到一定程度時:見山不是山,見水不是水 到了後來才發現,原來:見山又是山,見水又是水 學習的過程本來就是一種波浪循環, 有高潮也有低潮, 只要自己曾經努力過, 曾經為了程式設計癡狂過, 那您的一生就會無怨無悔了! 加油吧,所有的軟體工作者! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
syntax
尊榮會員 發表:26 回覆:1139 積分:1258 註冊:2002-04-23 發送簡訊給我 |
對不起囉 ! 如果讓各位有任何沉重的感覺或是受批評的感受 !!
小弟只是將想法說出,沒有任何批評的意思
因為不習慣用打字的討論程式寫法
總覺得字打的都不順,只能表達想法的一小部分
小弟還是習慣用說的方式溝通程式技巧 ^_^""
看來小弟應該再去上上國文課了
不過我可是很認真的將程式看完並思考,才將想法寫出
因為想要簡潔的說出要點,所以言語難免生硬
同時當然也希望能學到更好的方法
所以對於討論能提供一點心得
看到兩位先進的感嘆,實在...不是我期望的
其實只是希望提供意見與討論,不是故意要讓兩位先進產生如此感嘆..實在抱歉 ! 不知道我有沒有會錯意 ?
|
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
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
//除(整數運算) 將字串轉換為 二進制 用右旋移位法運算
推敲看看...
------
==取之於斯,用之於斯== |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
看大家對這個主題還是這麼有興趣,
站長突然想來測看看大家寫的執行速度如何,
結果跌破站長的眼鏡! 五位會員的加法部份
測一萬次的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討論區站長~~~ |
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
速度改良版 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;
有誰歡迎加入競技...
------
==取之於斯,用之於斯== |
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
再加速...
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
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
補述
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
------
==取之於斯,用之於斯== |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 再加速... 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 CPUshpeng,不錯喔! 改良版測試結果 1.63秒 再加速版測試結果 1.61秒 這是目前最快的速度喔! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
加速2版
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
------
==取之於斯,用之於斯== |
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
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位數
------
==取之於斯,用之於斯== |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 加速2版這個版本的速度為 0.23秒, 哇!一萬次的50位數加法只要0.23秒(用C-466的CPU) 不錯喔! 還有人要挑戰嗎? PS.shpeng 的減法測試結果也是0.24秒左右! ~~~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
------
~~~Delphi K.Top討論區站長~~~ |
Emulator
一般會員 發表:1 回覆:18 積分:8 註冊:2002-10-17 發送簡訊給我 |
引言: 補述= Delphi - Emulator = 發表人 - Emulator 於 2002/12/29 18:01:52p := (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 = |
bruce0211
版主 發表:157 回覆:668 積分:279 註冊:2002-06-13 發送簡訊給我 |
各位長官
累了是否可以換個主題??
小弟目前遇到類似的問題
我想現實程式中除了科學計算
應該沒有商用程式會用到無限位數的加減乘除
但倒是會常用求無限位數除以某一數字的餘數
例如小弟接觸的領域-POS 系統
現在超商都可代收瓦斯費,水電費,罰款費
目前共有 8 種類別的檢查條碼公式
有幾個公式是將三段代收條碼相加(將近20位數)然後除以7,檢查碼就是該餘數
用一個長整數變數當然不能帶入這 20 位數
所以小弟目前是用山不轉路轉的方式帶入浮點數
在小心翼翼的利用 MOD (BCB 用 %)求餘數(中間當然有避掉 BUG 的機制)
但這應不是聰明的方法
想過利用字串一個一個去除(就像自己拿白紙用手算的方法)
應該也就是各位長官所指的算盤式方法
所以在此想利用各位長官敦馬桶的時間
來幫小弟寫一個無限位數的求餘數公式
我想這類計算條碼檢查碼的應用應該會更常被使用到
在此先謝啦 ....
|
cutedune
一般會員 發表:0 回覆:5 積分:1 註冊:2004-01-20 發送簡訊給我 |
|
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
|
cutedune
一般會員 發表:0 回覆:5 積分:1 註冊:2004-01-20 發送簡訊給我 |
|
cutedune
一般會員 發表:0 回覆:5 積分:1 註冊:2004-01-20 發送簡訊給我 |
貼上我用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
|
cutedune
一般會員 發表:0 回覆:5 積分:1 註冊:2004-01-20 發送簡訊給我 |
|
cutedune
一般會員 發表:0 回覆:5 積分:1 註冊:2004-01-20 發送簡訊給我 |
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 |
eagle.guo
一般會員 發表:0 回覆:2 積分:0 註冊:2003-12-05 發送簡訊給我 |
小弟有另外一個想法供個參考,不知道對不對
我們可以模仿計算機處理二進制的方法處理無限位數的加,減,乘,除, 而且可以推廣到任意進制 去.
思路 : 首先確定原子算法. 然後把加法 轉化為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 |
eagle.guo
一般會員 發表:0 回覆:2 積分:0 註冊:2003-12-05 發送簡訊給我 |
小弟有另外一個想法供個參考,不知道對不對
我們可以模仿計算機處理二進制的方法處理無限位數的加,減,乘,除, 而且可以推廣到任意進制 去.
思路 : 首先確定原子算法. 然後把加法 轉化為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 |
worldone
一般會員 發表:3 回覆:5 積分:1 註冊:2003-11-21 發送簡訊給我 |
各位前輩們好...
小弟剛剛發現這裡有個問題
就是假如:
小弟用 7533967、9876543210 兩數呼叫乘法 function 去計算出一個 74409550618214070 值後
然後再用 74409550618214070、9876543210 兩數呼叫除法 function 卻算不回來原本的 7533967 值,而出現錯誤訊息
這是 BUG 嗎? 恕 小弟才疏學潛...能請各位前輩們幫忙解答嗎?
謝謝..
引言: 站長整理最後解答如下:(範例程式碼)發表人 - worldone 於 2004/05/20 14:30:11unit 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
一般會員 發表:3 回覆:5 積分:1 註冊:2003-11-21 發送簡訊給我 |
^_^" 首先謝謝大大的辛勞...
小弟發現 BUG 所在 就是 當我使用 2 + 3 = 5 這是正確的
但是 200 + 300 竟然還是等於 5
於是我測試了其他數字...發現加速2版把 0 都省略掉了...
只有算數字 1 ~ 9 的加法
@@"
接著想請問大大不知道您是否有寫過 求餘數的 function 呢?
因為數字太大,超過12個位數的數字,不能直接做 mod 運算所以都出現錯誤
可否請大大教教我...
下週二趕著教程式作業...的小傢伙留 PS: 若是大大太忙碌也沒關係,小弟我只好慢慢啃書了...希望還能來得及
謝謝囉...
引言:引言: 加速2版這個版本的速度為 0.23秒, 哇!一萬次的50位數加法只要0.23秒(用C-466的CPU) 不錯喔! 還有人要挑戰嗎? PS.shpeng 的減法測試結果也是0.24秒左右! ~~~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 |
peipei36
一般會員 發表:8 回覆:51 積分:16 註冊:2002-03-13 發送簡訊給我 |
自己用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 len1 |
peipei36
一般會員 發表:8 回覆:51 積分:16 註冊:2002-03-13 發送簡訊給我 |
糟糕~ 認真測下去才發現自己程式那麼不嚴謹
連加法都有錯..漏洞百出.. 要加油了~
後來再改的.. 不知對不對.. < 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 len1
|
shpeng
初階會員 發表:6 回覆:67 積分:49 註冊:2002-12-21 發送簡訊給我 |
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;==取之於斯,用之於斯==
------
==取之於斯,用之於斯== |
qalin
一般會員 發表:20 回覆:45 積分:13 註冊:2003-07-18 發送簡訊給我 |
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;==取之於斯,用之於斯== |
qalin
一般會員 發表:20 回覆:45 積分:13 註冊:2003-07-18 發送簡訊給我 |
除法有 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
|
SmallBee
一般會員 發表:0 回覆:1 積分:0 註冊:2004-05-16 發送簡訊給我 |
各位好
看了諸位的程式碼想問一下
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 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |