高精度运算1

 1 type  
 2   arr=array[1..200]of integer;  
 3  var  
 4   a,b:arr;i,la,lb:integer; n:string;  
 5 procedure add(a,b:arr;la,lb:integer);  
 6   var i,x,lc:integer; c:arr;  
 7   begin  
 8         i:=1; x:=0;  
 9         while (i<=la) or(i<=lb) do 
10          begin x:=a[i]+b[i]+x;  
11                c[i]:=x mod 10;  
12                x:=x div 10 ;  
13                i:=i+1;  
14          end;  
15          if x>0 then begin lc:=i; c[lc]:=x; end else lc:=i-1;  
16          for i:=lc downto 1 do write(c[i]);  
17          writeln;  
18    end;  
19  begin  
20   readln(n);  la:=length(n);  
21   for i:=1 to la do a[i]:=ord(n[la-i+1])-ord(‘0‘);  
22   readln(n);  lb:=length(n);  
23   for i:=1 to lb do b[i]:=ord(n[lb-i+1])-ord(‘0‘);  
24   add(a,b,la,lb);  
25  end.

 1 type
 2   arr=array[1..200]of integer;
 3  var
 4   a,b:arr;i,la,lb:integer; n,n1,n2:string;
 5 procedure sub(a,b:arr;la,lb:integer);
 6   var i,x,lc:integer; c:arr;
 7   begin
 8     i:=1;
 9     x:=0;
10     fillchar(c,sizeof(c),0);
11     while (i<=la) or(i<=lb) do
12       begin
13         x := a[i] - b[i] + 10 + x; {不考虑大小问题，先往高位借10}
14         c[i] := x mod 10 ; {保存第i 位的值}
15         x := x div 10 - 1; {将高位借掉的1减去}
16         i := i + 1
17       end;
18     lc:=i;
19     while (c[lc]=0) and (lc>1) do dec(lc); {最高位的0 不输出}
20     for i:=lc downto 1 do write(c[i]);
21     writeln
22   end;
23  begin
24   readln(n1);
25   readln(n2); {处理被减数和减数}
26   la:=length(n1); lb:=length(n2);
27   if (la<lb) or (la=lb) and (n1<n2) then
28     begin
29       n:=n1;n1:=n2;n2:=n;
30       write(‘-‘) {n1<n2,结果为负数}
31     end;
32   la:=length(n1); lb:=length(n2);
33   for i:=1 to la do a[la-i+1]:=ord(n1[i])-ord(‘0‘);
34   for i:=1 to lb do b[lb-i+1]:=ord(n2[i])-ord(‘0‘);
35   sub(a,b,la,lb);
36  end.

 1 program fbnq;
 2 type
 3   arr=array[1..7010] of integer;
 4 var
 5   a,b,c:arr;
 6   l,i,n:integer;
 7 procedure plus(a1,b1:arr;var x:arr);
 8   var i,k:integer;
 9   begin
10     k:=0;
11     for i:=1 to l do
12       begin
13         a1[i]:=a1[i]+b1[i]+k;
14         k:=a1[i] div 10;
15         a1[i]:=a1[i] mod 10;
16       end;
17     if k>0 then begin inc(l);a1[l]:=k;end;
18     x:=a1;
19   end;
20 begin
21   readln(n);
22   fillchar(a,sizeof(a),0);
23   fillchar(b,sizeof(b),0);
24   fillchar(c,sizeof(c),0);
25   if n=1 then begin writeln(1);halt;end;
26   if n=2 then begin writeln(2);halt;end;
27   a[1]:=1;
28   b[1]:=1;
29   l:=1;
30   for i:=3 to n+2 do
31     begin
32       plus(a,b,c);
33       a:=b;
34       b:=c;
35     end;
36   if c[1]-1<0 then
37     begin
38       c[1]:=9;
39       dec(c[2]);
40       for i:=2 to l do
41         begin
42           if (c[i]<0) then begin c[i+1]:=c[i+1]-1;c[i]:=c[i]+10; end
43             else break;
44         end;
45     end
46   else dec(c[1]);
47   while c[l]=0 do dec(l);
48   for i:=l downto 1 do write(c[i]);writeln;
49 end.

 1 program fbnq;
 2 type
 3   arr=array[1..7010] of integer;
 4 var
 5   a,b,c:arr;
 6   l,i,n:integer;
 7 function plus(a,b:arr):arr;
 8   var i,c:integer;
 9   begin
10     c:=0;
11     for i:=1 to l do
12       begin
13         a[i]:=a[i]+b[i]+c;
14         c:=a[i] div 10;
15         a[i]:=a[i] mod 10;
16       end;
17     if c>0 then begin inc(l);a[l]:=c;end;
18     plus:=a;
19   end;
20 begin
21   readln(n);
22   fillchar(a,sizeof(a),0);
23   fillchar(b,sizeof(b),0);
24   fillchar(c,sizeof(c),0);
25   if n=1 then begin writeln(1);halt;end;
26   if n=2 then begin writeln(2);halt;end;
27   a[1]:=1;
28   b[1]:=1;
29   l:=1;
30   for i:=3 to n+2 do
31     begin
32       c:=plus(a,b);
33       a:=b;
34       b:=c;
35     end;
36   if c[1]-1<0 then
37     begin
38       c[1]:=9;
39       dec(c[2]);
40       for i:=2 to l do
41         begin
42           if (c[i]<0) then begin c[i+1]:=c[i+1]-1;c[i]:=c[i]+10; end
43             else break;
44         end;
45     end
46   else dec(c[1]);
47   while c[l]=0 do dec(l);
48   for i:=l downto 1 do write(c[i]);writeln;
49 end.

 1 program huiwen;
 2 type arr=array[1..50] of byte;
 3 var
 4   a:arr;
 5   n,step,l,i,j:integer;
 6   m:string[20];
 7 procedure add(var a:arr);
 8   var c,i:integer;
 9       b:arr;
10   begin
11     b:=a;
12     c:=0;
13     for i:=1 to l do
14       begin
15         a[i]:=a[i]+b[l+1-i]+c;
16         c:=a[i] div n;
17         a[i]:=a[i] mod n;
18       end;
19     if c<>0 then begin inc(l);a[l]:=c; end;
20   end;
21 procedure try(var a:arr);
22   var i:integer;
23   begin
24     for i:= 1 to l div 2 do
25       if a[i]<>a[l+1-i] then exit;
26     writeln(‘STEP=‘,step);
27     halt;
28   end;
29 begin
30   readln(n);
31   readln(m);
32   l:=length(m);
33   for i:=1 to l do
34     if m[i] in [‘0‘..‘9‘] then a[l-i+1]:=ord(m[i])-ord(‘0‘)
35       else case m[i] of
36              ‘A‘,‘a‘:a[l-i+1]:=10;
37              ‘B‘,‘b‘:a[l-i+1]:=11;
38              ‘C‘,‘c‘:a[l-i+1]:=12;
39              ‘D‘,‘d‘:a[l-i+1]:=13;
40              ‘E‘,‘e‘:a[l-i+1]:=14;
41              ‘F‘,‘f‘:a[l-i+1]:=15;
42            end;
43   step:=0;
44   try(a);
45   while step<=30 do
46     begin
47       add(a);
48       inc(step);
49       try(a);
50     end;
51   writeln(‘Impossible!‘);
52 end.