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

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

 
領航天使
站長


發表:12216
回覆:4186
積分:4084
註冊:2001-07-25

發送簡訊給我
#1 引用回覆 回覆 發表時間:2002-12-12 22:35:25 IP:192.168.xxx.xxx 未訂閱
討論題目:無限位數的加減乘除 記得以前大學時,組合語言的老師出了一個題目: 無限位數的加減乘除 如: 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

發送簡訊給我
#2 引用回覆 回覆 發表時間:2002-12-13 12:14:04 IP:210.243.xxx.xxx 未訂閱
先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

發送簡訊給我
#3 引用回覆 回覆 發表時間:2002-12-13 12:27:01 IP:192.168.xxx.xxx 未訂閱
引言: 先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

發送簡訊給我
#4 引用回覆 回覆 發表時間:2002-12-13 13:29:39 IP:61.219.xxx.xxx 未訂閱
要發揚固有中國文化, 想想算盤
danny
版主


發表:100
回覆:522
積分:595
註冊:2002-03-11

發送簡訊給我
#5 引用回覆 回覆 發表時間:2002-12-13 14:29:18 IP:210.202.xxx.xxx 未訂閱
引言: 要發揚固有中國文化, 想想算盤
ccchen 兄: 可否談談 算盤 的部份, 因為不會用算盤, 不知您所指為何 ?
------
將問題盡快結案也是一種禮貌!
Jasonwong
版主


發表:49
回覆:918
積分:558
註冊:2006-10-27

發送簡訊給我
#6 引用回覆 回覆 發表時間:2002-12-13 15:13:58 IP:211.21.xxx.xxx 未訂閱
引言: 要發揚固有中國文化, 想想算盤
真不虧是 K.TOP 的得分王~~ -- 聰明的人,喜歡猜心;雖然每次都猜對了,卻失去了自己的心 傻氣的人,喜歡給心;雖然每次都被笑了,卻得到了別人的心
------
http://www.cobbler.tw

聰明的人,喜歡猜心;雖然每次都猜對了,卻失去了自己的心
傻氣的人,喜歡給心;雖然每次都被笑了,卻得到了別人的心
turboted
版主


發表:95
回覆:754
積分:452
註冊:2002-07-23

發送簡訊給我
#7 引用回覆 回覆 發表時間:2002-12-13 16:11:59 IP:61.30.xxx.xxx 未訂閱
我昨天有小小的寫了一下,但code沒存起來 我的作法是 (1)輸入兩數在String (2)min比小者,求出相加的個數 例如 一個五位 一個八位 兩者相加的位數為五 (3)用loop 去做...使用StringSub取出String中的數字 (4)完成 算謂的算盤指的不知道的不是我的做法 就是單一相加後進位
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#8 引用回覆 回覆 發表時間:2002-12-13 16:15:42 IP:61.219.xxx.xxx 未訂閱
引言: ccchen 兄: 可否談談 算盤 的部份, 因為不會用算盤, 不知您所指為何 ?
danny兄:算盤上每一串,就像一字元,最多表示為9, 可由左到右計算,進位可直接往下一位元, 故只要模擬算盤, 就解決了. 中國人的袓先多聰明啊 不會用算盤,能想出除法, 那才真高手
CJF
一般會員


發表:5
回覆:14
積分:8
註冊:2002-10-25

發送簡訊給我
#9 引用回覆 回覆 發表時間:2002-12-13 16:39:25 IP:211.21.xxx.xxx 未訂閱
我也做了加法的練習... 不知道有沒有錯 < 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

發送簡訊給我
#10 引用回覆 回覆 發表時間:2002-12-13 17:05:34 IP:192.168.xxx.xxx 未訂閱
引言: 我也做了加法的練習... 不知道有沒有錯 < 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

發送簡訊給我
#11 引用回覆 回覆 發表時間:2002-12-13 17:20:56 IP:211.21.xxx.xxx 未訂閱
引言:
引言: 我也做了加法的練習... 不知道有沒有錯 < 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討論區站長~~~
謝謝站長指導~~ 123 123455555555555 我執行了....並沒有錯誤訊息... 我的程式一開始當兩個字串不同大小時... 會有錯誤...後來我修改了紅色部分...就沒有了... 請問站長是出現怎樣的錯誤訊息呢?
領航天使
站長


發表:12216
回覆:4186
積分:4084
註冊:2001-07-25

發送簡訊給我
#12 引用回覆 回覆 發表時間:2002-12-13 17:26:21 IP:192.168.xxx.xxx 未訂閱
引言:
引言:
引言: 我也做了加法的練習... 不知道有沒有錯 < 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討論區站長~~~
謝謝站長指導~~ 123 123455555555555 我執行了....並沒有錯誤訊息... 我的程式一開始當兩個字串不同大小時... 會有錯誤...後來我修改了紅色部分...就沒有了... 請問站長是出現怎樣的錯誤訊息呢?
不錯,沒有BUG了! 精簡/快速! 給您95分! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~
hahalin
版主


發表:295
回覆:1698
積分:823
註冊:2002-04-14

發送簡訊給我
#13 引用回覆 回覆 發表時間:2002-12-13 22:04:03 IP:203.203.xxx.xxx 未訂閱
 
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

發送簡訊給我
#14 引用回覆 回覆 發表時間:2002-12-13 22:13:10 IP:192.168.xxx.xxx 未訂閱
引言:
 
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;    
站長Test OK! 不錯,同樣的簡潔有力! 一點點小小的建議,有雙層的for比較不好一點點! 同樣站長給95分! 不錯喔,加油! 可見,不同人寫的程式,風格差異很大, 寫程式就好像畫圖一樣,同樣一幅山水畫, 畫的是一樣的景色, 但是畫風/表現手法是截然不同, 這就是寫程式好玩的地方! 加法有漂亮的解答了, 再來有誰要試看看 減法 或是 難度稍高的 乘法 呢? ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#15 引用回覆 回覆 發表時間:2002-12-14 14:29:05 IP:203.217.xxx.xxx 未訂閱
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

發送簡訊給我
#16 引用回覆 回覆 發表時間:2002-12-14 16:08:48 IP:192.168.xxx.xxx 未訂閱
引言:
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;
ccchen真是不是人,是神! 超完美的 加法 與 減法 終於出爐, 加法與減法部份站長給:
   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

發送簡訊給我
#17 引用回覆 回覆 發表時間:2002-12-14 17:26:58 IP:203.217.xxx.xxx 未訂閱
但是,神也有出槌的時後! 乘法部份有> 稍改一下 < 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

發送簡訊給我
#18 引用回覆 回覆 發表時間:2002-12-14 18:25:28 IP:203.203.xxx.xxx 未訂閱
除法出現 借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))))  then
 
Checkminus
 
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

發送簡訊給我
#19 引用回覆 回覆 發表時間:2002-12-14 18:53:04 IP:192.168.xxx.xxx 未訂閱
引言: 但是,神也有出槌的時後! 乘法部份有> 稍改一下 < 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

發送簡訊給我
#20 引用回覆 回覆 發表時間:2002-12-14 18:55:25 IP:192.168.xxx.xxx 未訂閱
引言: 除法出現 借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))))  then
 
Checkminus
 
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;    
hahalin兄,謝謝您的修正,減法部份OK! 但您的除法有BUG, 請測試mydiv('22','1'); 會當機! 站長給您的研究精神打100分! ~~~Delphi K.Top討論區站長~~~
------
~~~Delphi K.Top討論區站長~~~
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#21 引用回覆 回覆 發表時間:2002-12-14 19:12:46 IP:203.217.xxx.xxx 未訂閱
減法部份是有問題, 已修正
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#22 引用回覆 回覆 發表時間:2002-12-14 21:02:50 IP:203.217.xxx.xxx 未訂閱
補上除法部分
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

發送簡訊給我
#23 引用回覆 回覆 發表時間:2002-12-14 21:19:53 IP:192.168.xxx.xxx 未訂閱
引言: 補上除法部分
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

發送簡訊給我
#24 引用回覆 回覆 發表時間:2002-12-14 21:22:07 IP:192.168.xxx.xxx 未訂閱
站長整理最後解答如下:(範例程式碼)
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

發送簡訊給我
#25 引用回覆 回覆 發表時間:2002-12-14 21:43:20 IP:203.217.xxx.xxx 未訂閱
補充說明一下 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

發送簡訊給我
#26 引用回覆 回覆 發表時間:2002-12-15 09:15:17 IP:203.203.xxx.xxx 未訂閱
請教各位: 在寫除法的時候也有碰到over stack的問題, 後來改用減的方式來逼出結果才讓運算長度多了點. 早上在蹲馬桶的時候突然想到, 預先估計運算量,分散處理的話呢? 在單機執行時是否可以分散給不同的"行程"來作 若是在區域網路環境下,分散給不同電腦作. 若說得不對還希望高明者指點一二.
ccchen
版主


發表:61
回覆:940
積分:1394
註冊:2002-04-15

發送簡訊給我
#27 引用回覆 回覆 發表時間:2002-12-15 09:39:33 IP:203.217.xxx.xxx 未訂閱
引言: 請教各位: 在寫除法的時候也有碰到over stack的問題, 後來改用減的方式來逼出結果才讓運算長度多了點. 早上在蹲馬桶的時候突然想到, 預先估計運算量,分散處理的話呢? 在單機執行時是否可以分散給不同的"行程"來作 若是在區域網路環境下,分散給不同電腦作. 若說得不對還希望高明者指點一二.
如果你是指前面你貼的除法,那是有點小bug, While條件有問題可能不會結束而造成over stack.另外由於數字大時執行較慢,超過10位數可能要幾分鐘,看起來像當了.去掉bug,那樣寫應該不會有Stack問題. 一般來說Recursive須考慮會nest多少, 大致來說我指是評估不能無限進入實測倒還測出錯誤 在單機執行時分散給不同的"行程"來作 有多cpu的工作站分散給不同CPU 若是在區域網路環境下,分散給不同電腦作. 當然都是可行, 不過要考慮可怕的overhead
hahalin
版主


發表:295
回覆:1698
積分:823
註冊:2002-04-14

發送簡訊給我
#28 引用回覆 回覆 發表時間:2002-12-15 11:44:25 IP:203.203.xxx.xxx 未訂閱
各位:      小弟之前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

發送簡訊給我
#29 引用回覆 回覆 發表時間:2002-12-15 15:40:29 IP:192.168.xxx.xxx 未訂閱
引言: 各位: 小弟之前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;
   
哈哈,透過這樣的討論,好玩吧! 站長給hahalinu也是:
   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

發送簡訊給我
#30 引用回覆 回覆 發表時間:2002-12-16 04:54:19 IP:163.25.xxx.xxx 未訂閱
看了各位大人的討論,你們...你們真是 ==================== 熱血丫 =_______=" 連蹲馬桶也在想.. 不過這題讓我發現Delphi高達2G大小的AnsiString滿好用的 3年前大一時的作業是用C寫的,不過C的字串是用字元陣列,記得 當時是用記憶體配置來達到"無限"位數的 感覺這裏有一堆熱血的前輩 ^^
syntax
尊榮會員


發表:26
回覆:1139
積分:1258
註冊:2002-04-23

發送簡訊給我
#31 引用回覆 回覆 發表時間:2002-12-19 09:18:01 IP:61.70.xxx.xxx 未訂閱
看了以上一連串文章,一點小心得與大家分享 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] [>>]
系統時間:2017-10-20 4:16:36
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!