站長出個題目給大家寫寫:無限位數的加減乘除 |
|
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
討論題目:無限位數的加減乘除
記得以前大學時,組合語言的老師出了一個題目:
無限位數的加減乘除
如:
111111111111111111111111111111111111111111111111111111111111+
222222222222222222222222222222222222222222222222222222222222=
333333333333333333333333333333333333333333333333333333333333 111111111111111111111111111111111111111111111111111111111111*
222222222222222222222222222222222222222222222222222222222222=
??? 就用String來設計以下這四個function:
1.function InfinitAdd(a,b:string):string; // 十進位的字串型態數字a 加 b
2.function InfinitSub(a,b:string):string; // 十進位的字串型態數字a 減 b
3.function InfinitMul(a,b:string):string; // 十進位的字串型態數字a 乘 b
4.function InfinitDiv(a,b:string):string; // 十進位的字串型態數字a 除 b
先假設a,b都是整數值(採用字串型態參數),但位數可能會有上百位數,
需傳回運算的結果(也採用字串型態). 以現有的Integer或Double都無法處理如此天文數字的計算,
大家來想想如何寫出這四個Function!
新手,高手,大家一起來解題吧!
~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
john
一般會員 發表:1 回覆:12 積分:2 註冊:2002-03-13 發送簡訊給我 |
先Post加法的~不曉得對不對~
function InfinitAdd(a,b:string):string; // 十進位的字串型態數字a 加 b var i,j,Temp,Tempa,Tempb,TempSum,TempPlus,acount,bcount:Integer; begin Result:=''; acount:=Length(a); bcount:=Length(b); if(acount<=bcount) then j:=acount else j:=bcount; TempSum:=0; TempPlus:=0; for i:=0 to j-1 do begin Tempa:=StrToInt(Copy(a,Length(a)-i,1)); Tempb:=StrToInt(Copy(b,Length(b)-i,1)); TempSum:=(Tempa Tempb) mod 10; Result:=IntToStr(TempSum TempPlus) Result; TempPlus:=(Tempa Tempb) div 10; end; if(acount=bcount) then begin if(TempPlus>0) then Result:=IntToStr(TempPlus) Result; end else begin if(j=acount) then begin Result:=IntToStr(StrToInt(Copy(b,bcount-acount,1)) TempPlus) Result; for i:=acount 1 to bcount-1 do begin Result:=Copy(b,bcount-i,1) Result; end end else begin Result:=IntToStr(StrToInt(Copy(a,acount-bcount,1)) TempPlus) Result; for i:=bcount 1 to acount-1 do begin Result:=Copy(a,acount-i,1) Result; end end; end; end; 引言: 討論題目:無限位數的加減乘除 記得以前大學時,組合語言的老師出了一個題目: 無限位數的加減乘除 如: 111111111111111111111111111111111111111111111111111111111111+ 222222222222222222222222222222222222222222222222222222222222= 333333333333333333333333333333333333333333333333333333333333 111111111111111111111111111111111111111111111111111111111111* 222222222222222222222222222222222222222222222222222222222222= ??? 就用String來設計以下這四個function: 1.function InfinitAdd(a,b:string):string; // 十進位的字串型態數字a 加 b 2.function InfinitSub(a,b:string):string; // 十進位的字串型態數字a 減 b 3.function InfinitMul(a,b:string):string; // 十進位的字串型態數字a 乘 b 4.function InfinitDiv(a,b:string):string; // 十進位的字串型態數字a 除 b 先假設a,b都是整數值(採用字串型態參數),但位數可能會有上百位數, 需傳回運算的結果(也採用字串型態). 以現有的Integer或Double都無法處理如此天文數字的計算, 大家來想想如何寫出這四個Function! 新手,高手,大家一起來解題吧! ~~~Delphi K.Top討論區站長~~~ |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 先Post加法的~不曉得對不對~ function InfinitAdd(a,b:string):string; // 十進位的字串型態數字a 加 b var i,j,Temp,Tempa,Tempb,TempSum,TempPlus,acount,bcount:Integer; begin Result:=''; acount:=Length(a); bcount:=Length(b); if(acount<=bcount) then j:=acount else j:=bcount; TempSum:=0; TempPlus:=0; for i:=0 to j-1 do begin Tempa:=StrToInt(Copy(a,Length(a)-i,1)); Tempb:=StrToInt(Copy(b,Length(b)-i,1)); TempSum:=(Tempa Tempb) mod 10; Result:=IntToStr(TempSum TempPlus) Result; TempPlus:=(Tempa Tempb) div 10; end; if(acount=bcount) then begin if(TempPlus>0) then Result:=IntToStr(TempPlus) Result; end else begin if(j=acount) then begin Result:=IntToStr(StrToInt(Copy(b,bcount-acount,1)) TempPlus) Result; for i:=acount 1 to bcount-1 do begin Result:=Copy(b,bcount-i,1) Result; end end else begin Result:=IntToStr(StrToInt(Copy(a,acount-bcount,1)) TempPlus) Result; for i:=bcount 1 to acount-1 do begin Result:=Copy(a,acount-i,1) Result; end end; end; end;john不錯喔,第一個寫出第一題解答的! 初步Test您的程式,應該沒有BUG,加法的結果是正確的, 也可以進行無限位數的加法! 但有兩個小小可以稍梢改進之處:(請見諒,只是討論討論啦) 1.您使用了 mod 10; div 10;這兩個指令的CPU Clock非常高, 比加法與減法多了近50倍的時間,所以若能不用,對整體速度會加快很多, 當天文數字愈大,計算的量愈多時,演算法的好壞就差很多了! 2.流程上稍梢嫌煩瑣了一點,應該還可以有很大精簡的空間! 有沒有網友想再來改寫成為更精簡的版本呢? 我給您打70分,不錯喔,加油! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
|
danny
版主 發表:100 回覆:522 積分:595 註冊:2002-03-11 發送簡訊給我 |
|
Jasonwong
版主 發表:49 回覆:931 積分:581 註冊:2006-10-27 發送簡訊給我 |
|
turboted
版主 發表:95 回覆:754 積分:452 註冊:2002-07-23 發送簡訊給我 |
|
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
|
CJF
一般會員 發表:5 回覆:14 積分:8 註冊:2002-10-25 發送簡訊給我 |
我也做了加法的練習...
不知道有沒有錯
< class="code">
function tform1.InfinitAdd(a,b:string):string;
var
i,j,l:integer;
x,y,plus:integer;
z,sum:string;
begin
result:='';
i:=length(a);
j:=length(b);
l:=length(a);
plus:=0;
sum:='';
z:='';
if l < length(b) then
l:=length(b);
while l>0 do
begin
if i=0 then
x:=0
else
x:=strtoint(a[i]);
if j=0 then
y:=0
else
y:=strtoint(b[j]);
if (i<>0) or (j<>0) then
begin
z:=inttostr(x y plus);
if length(z)=2 then
begin
plus:=strtoint(z[1]);
z:=z[2];
end
else
plus:=0;
sum:=z sum;
end;
dec(l);
if i>0 then
dec(i);
if j>0 then
dec(j);
end;
if plus<>0 then
result:=inttostr(plus) sum
else
result:=sum;
end;
發表人 - CJF 於 2002/12/13 16:55:25
|
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 我也做了加法的練習... 不知道有沒有錯 < class="code"> function tform1.InfinitAdd(a,b:string):string; var i,j,l:integer; x,y,plus:integer; z,sum:string; begin result:=''; i:=length(a); j:=length(b); l:=length(a); plus:=0; sum:=''; z:=''; if l < length(b) then l:=length(b); while l>0 do begin if i=0 then x:=0 else x:=strtoint(a[i]); if j=0 then y:=0 else y:=strtoint(b[j]); if (i<>0) or (j<>0) then begin z:=inttostr(x y plus); if length(z)=2 then begin plus:=strtoint(z[1]); z:=z[2]; end else plus:=0; sum:=z sum; end; dec(l); if i>0 then dec(i); if j>0 then dec(j); end; if plus<>0 then result:=inttostr(plus) sum else result:=sum; end; 發表人 - CJF 於 2002/12/13 16:55:25寫的很精簡也沒用到DIV MOD, 但是有BUG在x:=strtoint(a[i]); 請試123 123455555555555 就會出錯 給您70分! 加油喔! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
CJF
一般會員 發表:5 回覆:14 積分:8 註冊:2002-10-25 發送簡訊給我 |
引言:謝謝站長指導~~ 123 123455555555555 我執行了....並沒有錯誤訊息... 我的程式一開始當兩個字串不同大小時... 會有錯誤...後來我修改了紅色部分...就沒有了... 請問站長是出現怎樣的錯誤訊息呢?引言: 我也做了加法的練習... 不知道有沒有錯 < class="code"> function tform1.InfinitAdd(a,b:string):string; var i,j,l:integer; x,y,plus:integer; z,sum:string; begin result:=''; i:=length(a); j:=length(b); l:=length(a); plus:=0; sum:=''; z:=''; if l < length(b) then l:=length(b); while l>0 do begin if i=0 then x:=0 else x:=strtoint(a[i]); if j=0 then y:=0 else y:=strtoint(b[j]); if (i<>0) or (j<>0) then begin z:=inttostr(x y plus); if length(z)=2 then begin plus:=strtoint(z[1]); z:=z[2]; end else plus:=0; sum:=z sum; end; dec(l); if i>0 then dec(i); if j>0 then dec(j); end; if plus<>0 then result:=inttostr(plus) sum else result:=sum; end; 發表人 - CJF 於 2002/12/13 16:55:25寫的很精簡也沒用到DIV MOD, 但是有BUG在x:=strtoint(a[i]); 請試123 123455555555555 就會出錯 給您70分! 加油喔! ~~~Delphi K.Top討論區站長~~~ |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言:不錯,沒有BUG了! 精簡/快速! 給您95分! ~~~Delphi K.Top討論區站長~~~引言:謝謝站長指導~~ 123 123455555555555 我執行了....並沒有錯誤訊息... 我的程式一開始當兩個字串不同大小時... 會有錯誤...後來我修改了紅色部分...就沒有了... 請問站長是出現怎樣的錯誤訊息呢?引言: 我也做了加法的練習... 不知道有沒有錯 < class="code"> function tform1.InfinitAdd(a,b:string):string; var i,j,l:integer; x,y,plus:integer; z,sum:string; begin result:=''; i:=length(a); j:=length(b); l:=length(a); plus:=0; sum:=''; z:=''; if l < length(b) then l:=length(b); while l>0 do begin if i=0 then x:=0 else x:=strtoint(a[i]); if j=0 then y:=0 else y:=strtoint(b[j]); if (i<>0) or (j<>0) then begin z:=inttostr(x y plus); if length(z)=2 then begin plus:=strtoint(z[1]); z:=z[2]; end else plus:=0; sum:=z sum; end; dec(l); if i>0 then dec(i); if j>0 then dec(j); end; if plus<>0 then result:=inttostr(plus) sum else result:=sum; end; 發表人 - CJF 於 2002/12/13 16:55:25寫的很精簡也沒用到DIV MOD, 但是有BUG在x:=strtoint(a[i]); 請試123 123455555555555 就會出錯 給您70分! 加油喔! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
hahalin
版主 發表:295 回覆:1698 積分:823 註冊:2002-04-14 發送簡訊給我 |
function TForm1.myadd(s1, s2:string): string; var i,j,itemp,len1,len2:integer; tmps:string; begin if length(s1) < length(s2) then begin tmps:=s1; s1:=s2; s2:=tmps; end; len1:=length(s1); len2:=length(s2); for i:=1 to len1-len2 do begin s2:='0' s2; end; for i:=1 to len1 do begin setlength(tmps,len1); for j:=1 to len1 do begin tmps[j]:='0'; end; itemp:=strtoint(s1[i]) strtoint(s2[i]); s1[i]:='0';s2[i]:='0'; if itemp>=10 then begin s1[i]:=inttostr(itemp)[2]; if i=1 then begin s1:='1' s1; end else begin tmps[i-1]:='1'; s1:=myadd(s1,tmps); end; end else begin s1[i]:=inttostr(itemp)[1]; end; end; result:=s1; end; |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言:站長Test OK! 不錯,同樣的簡潔有力! 一點點小小的建議,有雙層的for比較不好一點點! 同樣站長給95分! 不錯喔,加油! 可見,不同人寫的程式,風格差異很大, 寫程式就好像畫圖一樣,同樣一幅山水畫, 畫的是一樣的景色, 但是畫風/表現手法是截然不同, 這就是寫程式好玩的地方! 加法有漂亮的解答了, 再來有誰要試看看 減法 或是 難度稍高的 乘法 呢? ~~~Delphi K.Top討論區站長~~~function TForm1.myadd(s1, s2:string): string; var i,j,itemp,len1,len2:integer; tmps:string; begin if length(s1) < length(s2) then begin tmps:=s1; s1:=s2; s2:=tmps; end; len1:=length(s1); len2:=length(s2); for i:=1 to len1-len2 do begin s2:='0' s2; end; for i:=1 to len1 do begin setlength(tmps,len1); for j:=1 to len1 do begin tmps[j]:='0'; end; itemp:=strtoint(s1[i]) strtoint(s2[i]); s1[i]:='0';s2[i]:='0'; if itemp>=10 then begin s1[i]:=inttostr(itemp)[2]; if i=1 then begin s1:='1' s1; end else begin tmps[i-1]:='1'; s1:=myadd(s1,tmps); end; end else begin s1[i]:=inttostr(itemp)[1]; end; end; result:=s1; end;
------
~~~Delphi K.Top討論區站長~~~ |
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
function InfintAdd(s1,s2:string):string; var i,n1,n2:integer; begin n1:=length(s1); n2:=length(s2); if n2 > n1 then Result:=InfintAdd(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 InfintSub(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:='-' InfintSub(s2,s1) else begin Result:=s1; for i:=1 to n2 do OPSub(Result,n1-n2 i, ord(s2[i])-48); end; end; function Infintmul(s1,s2:string):string; var i,j,n1,n2,n:integer; begin n1:=length(s1); n2:=length(s2); if n2 > n1 then Result:=InfintMul(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; 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;發表人 - ccchen 於 2002/12/14 19:11:02 |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言:ccchen真是不是人,是神! 超完美的 加法 與 減法 終於出爐, 加法與減法部份站長給:function InfintAdd(s1,s2:string):string; var i,n1,n2:integer; begin n1:=length(s1); n2:=length(s2); if n2 > n1 then Result:=InfintAdd(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 InfintSub(s1,s2:string):string; var i,n1,n2:integer; begin n1:=length(s1); n2:=length(s2); if ( (n2 > n1) or ((n2=n1) and (ord(s1[1])< ord(s2[1])))) then Result:='-' InfintSub(s2,s1) else begin Result:=s1; for i:=1 to n2 do OPSub(Result,n1-n2 i, ord(s2[i])-48); end; end; function Infintmul(s1,s2:string):string; var i,j,n1,n2,n:integer; begin n1:=length(s1); n2:=length(s2); 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; 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; 1 000 000 11 0 0 0 0 1 0 0 0 0 1 0 0 0 0 111 000 000 分但是,神也有出槌的時後! 乘法部份有> ~~~
------
~~~Delphi K.Top討論區站長~~~ |
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
但是,神也有出槌的時後!
乘法部份有>
稍改一下
< class="code">
function Infintmul(s1,s2:string):string;
var i,j,n1,n2,n:integer;
begin
n1:=length(s1);
n2:=length(s2);
if n2 > n1 then
Result:=InfintMul(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;
不是我行, 是老袓宗聰明,早就想好答案
[/quote]
|
hahalin
版主 發表:295 回覆:1698 積分:823 註冊:2002-04-14 發送簡訊給我 |
除法出現 借cchen老大的程式碼一用
function mydiv(s1,s2:string):string; var n1,n2:integer; i:integer; sr1,sr2,tmpstr:string; begin n1:=length(s1); n2:=length(s2); if n2>n1 then begin tmpstr:=s1; s1:=s2; s2:=tmpstr; end; n1:=length(s1); n2:=length(s2); sr1:='0'; sr2:=s1; while not ( (copy(sr2,1,1)='-') ) do begin sr1:=infintadd(sr1,'1'); sr2:=infintsub(sr2,s2); end; result:=infintsub(sr1,'1'); end;不過減法有問題 試試看 10-13 我在這部分修改 增加一個checkminus的function function InfintSub(s1,s2:string):string; var i,n1,n2:integer; str:string; begin n1:=length(s1); n2:=length(s2); //if ( (n2 > n1) or ((n2=n1) and (ord(s1[1])< ord(s2[1])))) then if ( (n2 > n1) or ((n2=n1) and (checkminus(s1,s2)))) thenCheckminus function checkminus(sr1,sr2:string):boolean; var j:integer; begin result:=false; for j:=1 to length(sr1) do begin if ord(sr1[j])< ord(sr2[j]) then begin result:=true; break; end end; end; |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 但是,神也有出槌的時後! 乘法部份有> 稍改一下 < class="code"> function Infintmul(s1,s2:string):string; var i,j,n1,n2,n:integer; begin n1:=length(s1); n2:=length(s2); if n2 > n1 then Result:=InfintMul(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; 不是我行, 是老袓宗聰明,早就想好答案[/quote] 超完美的 乘法 出爐, 站長給: 1 000 000 11 0 0 0 0 1 0 0 0 0 1 0 0 0 0 111 000 000 分~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 除法出現 借cchen老大的程式碼一用hahalin兄,謝謝您的修正,減法部份OK! 但您的除法有BUG, 請測試mydiv('22','1'); 會當機! 站長給您的研究精神打100分! ~~~Delphi K.Top討論區站長~~~function mydiv(s1,s2:string):string; var n1,n2:integer; i:integer; sr1,sr2,tmpstr:string; begin n1:=length(s1); n2:=length(s2); if n2>n1 then begin tmpstr:=s1; s1:=s2; s2:=tmpstr; end; n1:=length(s1); n2:=length(s2); sr1:='0'; sr2:=s1; while not ( (copy(sr2,1,1)='-') ) do begin sr1:=infintadd(sr1,'1'); sr2:=infintsub(sr2,s2); end; result:=infintsub(sr1,'1'); end;不過減法有問題 試試看 10-13 我在這部分修改 增加一個checkminus的functionfunction InfintSub(s1,s2:string):string; var i,n1,n2:integer; str:string; begin n1:=length(s1); n2:=length(s2); //if ( (n2 > n1) or ((n2=n1) and (ord(s1[1])< ord(s2[1])))) then if ( (n2 > n1) or ((n2=n1) and (checkminus(s1,s2)))) thenCheckminusfunction checkminus(sr1,sr2:string):boolean; var j:integer; begin result:=false; for j:=1 to length(sr1) do begin if ord(sr1[j])< ord(sr2[j]) then begin result:=true; break; end end; end;
------
~~~Delphi K.Top討論區站長~~~ |
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
|
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
補上除法部分
procedure DeleteLD0(var s:string); begin while (s[1]='0') and (length(s)>1) do delete(s,1,1); end; function InfintDiv(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:= infintsub(s1, infintmul(s2,stemp)); DeleteLD0(res); dec(r); until res[1] <> '-'; Result:=Result infintAdd(stemp,infintDiv(res, s2, res)); end; end;發表人 - ccchen 於 2002/12/14 21:03:43 |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 補上除法部分超完美的 除法 出爐, 站長給:procedure DeleteLD0(var s:string); begin while (s[1]='0') and (length(s)>1) do delete(s,1,1); end; function InfintDiv(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:= infintsub(s1, infintmul(s2,stemp)); DeleteLD0(res); dec(r); until res[1] <> '-'; Result:=Result infintAdd(stemp,infintDiv(res, s2, res)); end; end;發表人 - ccchen 於 2002/12/14 21:03:43 1 000 000 11 0 0 0 0 1 0 0 0 0 1 0 0 0 0 111 000 000 分恭喜ccchen,不愧為K.Top得分王! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
站長整理最後解答如下:(範例程式碼)
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討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
補充說明一下
1. 最後補了一個DeleteLD0, 付用來刪除前端之0, 每一function Return前應呼叫, 結果較好看
2. 有些偷懶用了StringofChar, inttostr,strToint等應該可進一步避免,若用C應該連ord, chr都不需要
3. 除法用了Recursive, 將受限於Stack, 達不到"無限的要求, 當被除數和除數之位數差距很大很大時,可能Stack over flow, 不過用Recursive實在太方便了
4. 可能測試還不足
Where there is a Program there is a bug 發表人 - ccchen 於 2002/12/15 08:56:53
|
hahalin
版主 發表:295 回覆:1698 積分:823 註冊:2002-04-14 發送簡訊給我 |
|
ccchen
版主 發表:61 回覆:940 積分:1394 註冊:2002-04-15 發送簡訊給我 |
引言: 請教各位: 在寫除法的時候也有碰到over stack的問題, 後來改用減的方式來逼出結果才讓運算長度多了點. 早上在蹲馬桶的時候突然想到, 預先估計運算量,分散處理的話呢? 在單機執行時是否可以分散給不同的"行程"來作 若是在區域網路環境下,分散給不同電腦作. 若說得不對還希望高明者指點一二.如果你是指前面你貼的除法,那是有點小bug, While條件有問題可能不會結束而造成over stack.另外由於數字大時執行較慢,超過10位數可能要幾分鐘,看起來像當了.去掉bug,那樣寫應該不會有Stack問題. 一般來說Recursive須考慮會nest多少, 大致來說我指是評估不能無限進入實測倒還測出錯誤 在單機執行時分散給不同的"行程"來作 有多cpu的工作站分散給不同CPU 若是在區域網路環境下,分散給不同電腦作. 當然都是可行, 不過要考慮可怕的overhead |
hahalin
版主 發表:295 回覆:1698 積分:823 註冊:2002-04-14 發送簡訊給我 |
各位: 小弟之前post的除法要能正常運作,減法還多修改一個地方忘了post上來,
ccchen已經有post去掉字串左邊多餘零的函式,
我的做法是修改infintsub的結尾,這樣就不用再多一次遞迴了.
不過mydiv在被除數與除數差異很大的時候會很..........慢,
由此可以知道寫code的人偷懶會讓電腦跑得半死 ^^
function checkminus(sr1,sr2:string):boolean; var j:integer; begin result:=false; for j:=1 to length(sr1) do begin if ord(sr1[j])< ord(sr2[j]) then begin result:=true; break; end end; end; function InfintSub(s1,s2:string):string; var i,n1,n2:integer; str:string; begin n1:=length(s1); n2:=length(s2); //if ( (n2 > n1) or ((n2=n1) and (ord(s1[1])< ord(s2[1])))) then if ( (n2 > n1) or ((n2=n1) and (checkminus(s1,s2)))) then Result:='-' InfintSub(s2,s1) else begin Result:=s1; for i:=1 to n2 do OPSub(Result,n1-n2 i, ord(s2[i])-48); end; str:=result; if (copy(str,1,1)='0') and (length(str)>1) then begin str:=copy(str,2,length(str)); end; result:=str; end; |
領航天使
站長 發表:12216 回覆:4186 積分:4084 註冊:2001-07-25 發送簡訊給我 |
引言: 各位: 小弟之前post的除法要能正常運作,減法還多修改一個地方忘了post上來, ccchen已經有post去掉字串左邊多餘零的函式, 我的做法是修改infintsub的結尾,這樣就不用再多一次遞迴了. 不過mydiv在被除數與除數差異很大的時候會很..........慢, 由此可以知道寫code的人偷懶會讓電腦跑得半死 ^^哈哈,透過這樣的討論,好玩吧! 站長給hahalinu也是:function checkminus(sr1,sr2:string):boolean; var j:integer; begin result:=false; for j:=1 to length(sr1) do begin if ord(sr1[j])< ord(sr2[j]) then begin result:=true; break; end end; end; function InfintSub(s1,s2:string):string; var i,n1,n2:integer; str:string; begin n1:=length(s1); n2:=length(s2); //if ( (n2 > n1) or ((n2=n1) and (ord(s1[1])< ord(s2[1])))) then if ( (n2 > n1) or ((n2=n1) and (checkminus(s1,s2)))) then Result:='-' InfintSub(s2,s1) else begin Result:=s1; for i:=1 to n2 do OPSub(Result,n1-n2 i, ord(s2[i])-48); end; str:=result; if (copy(str,1,1)='0') and (length(str)>1) then begin str:=copy(str,2,length(str)); end; result:=str; end; 1 000 000 11 0 0 0 0 1 0 0 0 0 1 0 0 0 0 111 000 000 分在此預告,站長下一次還會有更好玩的點子喔! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~ |
delphinewbie
一般會員 發表:4 回覆:29 積分:22 註冊:2002-10-06 發送簡訊給我 |
|
syntax
尊榮會員 發表:26 回覆:1139 積分:1258 註冊:2002-04-23 發送簡訊給我 |
看了以上一連串文章,一點小心得與大家分享 1. 一個乘法動作 比幾個加法快 ?
是否有必要刻意不去使用 div mod mul ?
若是程式所使用的加法與減法次數過多
那還不如用一個 div or mod or mul 來解決的快
尤其當數字非常大或差異很大時,就可能會出現這樣的狀況 2. 整個程式,以程式設計的觀點來看有:
a. 易讀性不足
b. 簡潔性不夠
c. 快速性不達
乃是因為
(1). 有不必要的程式碼,在 OPAdd 與 OPSub 中,第一個 if 敘述將永遠不會被執行到,永遠只會執行 else 的部分,既然不會用到就別寫出來,以避免讀程式的人會錯意.
(2). 再則程式既然已盡量避免使用 div mod mul ,那為何還要用 procedure call 來 call 去?每一個 call 都是會浪費時間的,而以遞迴的 call更是甚之,寫程式時並未能細心的思考,其實根本不需要這樣浪費時間 call 來 call 去,省下的時間可是很可觀的.
(3). 加法與減法只要一個 loop 與 2~3 個 if 應該就可以解決,所以不需要浪費時間在程序的呼叫上
(4). 另外 ord('9'),難道沒有減去 48 就不是 9 了? 應該沒有必要在一個地方先減去 48 ,在另一個地方再加回來 ? 這樣有意義嗎 ? 應該可以省下這加加減減 48 的動作,因為那是給人思考時候用的,對電腦一點意義都沒有 !
(5). 乘法 m x n 只要 m 個乘 n 個加 與一個 if 就可以完成,不需要在乎叫其他程序來幫助,可以省下 m x n 次的呼叫時間
(6). 除法部分演算方式能仍有改進效能的空間,且若不使用呼叫程序infinitAdd 的方式,相信會加快處理的速度,而且也沒有必要用兩次 if 來判斷相同的條件吧 ! 一件事做兩次 .... 應該沒必要 !!,另外 res 沒有初值,這樣很危險,某個條件下 res 將會是意料之外的亂數值 !
(7). 雖然作者是想要將程式模組化,但是有時反而是得到反效果,而除法也未處理除以零時的狀況,字串處理前也應該檢查一下是否為合理的數字字串 以上小小心得,對事不對人,小弟國文程度不佳若語氣不好,請見諒,不是故意的。 發表人 - syntax 於 2002/12/19 09:21:48
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |