home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / math.swg / 0071_Type Really Big Number.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  3.1 KB  |  137 lines
  1. {
  2.  I wrote routines to add and multiply any amount of bytes one at a time,
  3.  but then had no way to test them out:)
  4. }
  5. program Really_Big_Math;
  6.  
  7. type ReallyBigNumber = array[0..100] of byte;
  8.     {Byte [0] is the length, [1] is least significant}
  9.  
  10. procedure ShiftRBN(var A:ReallyBigNumber;N:byte);
  11. var Index:Byte;
  12. begin
  13.   if n<>0 then begin
  14.     for Index :=(A[0] + N) downto N+1 do A[Index] := A[Index - N];
  15.     for Index := 1 to N do A[Index] := 0;
  16.     Inc(A[0],N);
  17.   end;
  18. end;
  19.  
  20. procedure ByteAdd(A,B:Byte; var C,S:byte);
  21. var temp:word;
  22. begin
  23.   temp := A+B+C;
  24.   C    := temp div 256;
  25.   S    := temp mod 256;
  26. end;
  27.  
  28. Procedure ByteMult(A,B:Byte;var C,P:byte);
  29. var temp:word;
  30. begin
  31.   temp:=A*B+C;
  32.   C:=temp div 256;
  33.   P:=temp mod 256;
  34. end;
  35.  
  36.  
  37. Procedure Sum(N1,N2:ReallyBigNumber;var S:ReallyBigNumber);
  38. var WorkArray : ReallyBigNumber;
  39.     L,Index,
  40.     Carry     : byte;
  41.  
  42. begin
  43.   Carry := 0;WorkArray[0] := 0;
  44.   if N1[0] = 0 then for Index := 1 to 100 do N1[Index] := 0;
  45.   if N2[0] = 0 then for Index := 1 to 100 do N2[Index] := 0;
  46.   if N1[0] > N2[0] then L := N1[0] else L := N2[0];
  47.   for Index := 1 to L do begin
  48.    ByteAdd(N1[Index],N2[Index],Carry,WorkArray[Index]);
  49.    inc(WorkArray[0]);
  50.   end;
  51.   if Carry <> 0 then inc(WorkArray[0]);
  52.   WorkArray[L+1]:= Carry;
  53.   S := WorkArray;
  54. end;
  55.  
  56. procedure Product(N1,N2:ReallyBigNumber;var PR:ReallyBigNumber);
  57. var C1,C2,L1,L2,
  58.     Carry        :Byte;
  59.     TProduct,
  60.     WorkRBN      :ReallyBigNumber;
  61. begin
  62.   WorkRBN[0] := 0;
  63.   L1 := N1[0];L2 := N2[0];
  64.   for C1 := 1 to L1 do begin
  65.     Carry:=0;TProduct[0]:=0;
  66.     for C2 := 1 to L2 do begin
  67.       ByteMult(N1[C1],N2[C2],Carry,TProduct[C2]);
  68.       inc(TProduct[0]);
  69.     end;
  70.     if Carry<>0 then begin
  71.       TProduct[C2+1] := Carry;
  72.       inc(TProduct[0]);
  73.     end;
  74.     ShiftRBN(TProduct,C1-1);
  75.     Sum(TProduct,WorkRBN,WorkRBN)
  76.   end;
  77.   PR := WorkRBN;
  78. end;
  79.  
  80. procedure STR2RBN(S:String; var R:ReallyBigNumber);
  81.  
  82. var Index,
  83.     SLen      : Byte;
  84.     Value,
  85.     RBNTen,
  86.     RBNPlus   : ReallyBigNumber;
  87.  
  88.  function Ch2Val(C:Char):Byte;
  89.  begin
  90.    Ch2Val := ord(C) - 48;
  91.  end;
  92.  
  93. begin
  94.   SLen := Length(S);
  95.   RBNTen[0] := 1; RBNTen[1] := 10;      {To Multiply Value by Ten}
  96.   RBNPlus[0] := 1; RBNPlus[1] := 0;     {To add to Value}
  97.   Value[0] := 1; Value[1] := Ch2Val(S[1]);
  98.   if SLen > 1 then
  99.     for Index := 2 to SLen do begin     (***THANKS DJ!!***)
  100.       RBNPlus[1] := Ch2Val(S[Index]);
  101.       Product(RBNTen,Value,Value);
  102.       Sum(RBNPlus,Value,Value);
  103.     end;
  104.   R := Value;
  105. end;
  106.  
  107. procedure RBN2Real(RBN:ReallyBigNumber;var RR:Real);
  108. var RValue:Real;
  109. begin
  110.   RValue:=0;
  111.   repeat
  112.     RValue := RValue * 256;
  113.     RValue := RValue + RBN[RBN[0]];
  114.     dec(RBN[0]);
  115.   until RBN[0] < 1;
  116.   RR := RValue;
  117. end;
  118.  
  119. var AA,BB,SS,PP: ReallyBigNumber;
  120.     StA,StB    : String;
  121.     RealP,RealS    : Real;
  122.  
  123. begin
  124.   Writeln('Input A');
  125.   Readln(StA);
  126.   Writeln('Input B');
  127.   Readln(StB);
  128.   STR2RBN(StA,AA);
  129.   STR2RBN(StB,BB);
  130.   Sum(AA,BB,SS);
  131.   Product(AA,BB,PP);
  132.   RBN2Real(SS,RealS);
  133.   RBN2Real(PP,RealP);
  134.   Writeln('Sum =',RealS);
  135.   Writeln('Product =',RealP);
  136. end.
  137.