高精度

高精度整数加
var
  s1,s2:string;
  a,b,c:array[1..255] of byte;
  la,lb,lc,i:integer;
begin
  write('a=');
  readln(s1);
  write('b=');
  readln(s2);
  la:=length(s1);
  lb:=length(s2);
  if la>lb then lc:=la
           else lc:=lb;
  for i:=1 to la do a[i]:=ord(s1[la-i+1])-48;
  for i:=1 to lb do b[i]:=ord(s2[lb-i+1])-48;
  for i:=1 to lc do begin
    c[i]:=c[i]+a[i]+b[i];
    c[i+1]:=c[i] div 10;
    c[i]:=c[i] mod 10;
  end;
  write('a+b=');
  if c[lc+1]>0 then write(1);
  for i:=lc downto 1 do write(c[i]);
  readln;
end.

高精度整数减
var
  s1,s2,st:string;
  a,b,c:array[1..255] of shortint;
  la,lb,t,i:integer;
begin
  write('a=');
  readln(s1);
  write('b=');
  readln(s2);
  la:=length(s1);
  lb:=length(s2);
  write('a-b=');
  if (lb>la) or ((lb=la) and (s1<s2)) then begin
    write('-');
    st:=s1;s1:=s2;s2:=st;
    t:=la;la:=lb;lb:=t;
  end;
  for i:=1 to la do a[i]:=ord(s1[la-i+1])-48;
  for i:=1 to lb do b[i]:=ord(s2[lb-i+1])-48;
  for i:=1 to la do begin
    c[i]:=a[i]-b[i];
    if c[i]<0 then begin
      c[i]:=c[i]+10;
      a[i+1]:=a[i+1]-1;
    end;
  end;
  t:=la;
  while (c[t]=0) and (t>1) do dec(t);
  for i:=t downto 1 do write(c[i]);
  readln;
end.

高精度整数乘
var
  s1,s2:string;
  a,b,c:array[1..255] of byte;
  la,lb,i,j,t:integer;
begin
  write('a=');
  readln(s1);
  write('b=');
  readln(s2);
  la:=length(s1);
  lb:=length(s2);
  for i:=1 to la do a[i]:=ord(s1[la-i+1])-48;
  for i:=1 to lb do b[i]:=ord(s2[lb-i+1])-48;
  for i:=1 to la do
    for j:=1 to lb do begin
      c[i+j-1]:=c[i+j-1]+a[i]*b[j];
      c[i+j]:=c[i+j]+c[i+j-1] div 10;
      c[i+j-1]:=c[i+j-1] mod 10;
    end;
  write('a*b=');
  t:=la+lb;
  while (c[t]=0) and (t>1) do dec(t);
  for i:=t downto 1 do write(c[i]);
  readln;
end.

高精度整数乘方
var
  s:array[1..500] of byte;
  x,n,i,j,ls,lx,k1,k2:integer;
begin
  write('x=');
  readln(x);
  write('n=');
  readln(n);
  s[1]:=1;
  ls:=0;
  lx:=trunc(ln(x)/ln(10))+1;

  for i:=1 to n do begin
    ls:=ls+lx;
    k1:=0;
    for j:=1 to ls do begin
      k2:=s[j]*x+k1;
      k1:=k2 div 10;
      s[j]:=k2 mod 10;
    end;
  end;

  write('x^n=');
  for i:=trunc(n*ln(x)/ln(10))+1 downto 1 do write(s[i]);
  readln;
end.

高精度实数加
var
  s1,s2,s3,s:string;
  d1,d2,z1,z2,z3,x1,x2,x3,i,len,code:integer;
  a,b,c:array[0..255] of byte;
begin
  readln(s1);
  readln(s2);

  d1:=pos('.',s1);
  if d1=0 then begin
    z1:=length(s1);
    x1:=0;
  end else begin
    z1:=d1-1;
    x1:=length(s1)-d1;
    delete(s1,d1,1);
  end;

  d2:=pos('.',s2);
  if d2=0 then begin
    z2:=length(s2);
    x2:=0;
  end else begin
    z2:=d2-1;
    x2:=length(s2)-d2;
    delete(s2,d2,1);
  end;

  if z1<z2 then for i:=1 to z2-z1 do s1:='0'+s1
           else for i:=1 to z1-z2 do s2:='0'+s2;
  if x1<x2 then for i:=1 to x2-x1 do s1:=s1+'0'
           else for i:=1 to x1-x2 do s2:=s2+'0';

  if z1>z2 then z3:=z1
           else z3:=z2;
  if x1>x2 then x3:=x1
           else x3:=x2;
  len:=z3+x3;

  for i:=1 to len do begin
    val(copy(s1,i,1),a[i],code);
    val(copy(s2,i,1),b[i],code);
  end;

  for i:=len downto 1 do begin
    c[i]:=a[i]+b[i]+c[i];
    c[i-1]:=c[i] div 10;
    c[i]:=c[i] mod 10;
  end;

  s3:='';
  for i:=0 to len do begin
    str(c[i],s);
    s3:=s3+s;
  end;

  insert('.',s3,z3+2);

  len:=len+2;
  while s3[len]='0' do begin
    delete(s3,len,1);
    len:=len-1;
  end;

  if s3[len]='.' then delete(s3,len,1);

  if s3[1]='0' then delete(s3,1,1);

  writeln(s3);
  readln;
end.

高精度实数减
var
  s1,s2,s3,s:string;
  d1,d2,z1,z2,z3,x1,x2,x3,i,len,code:integer;
  a,b,c:array[1..255] of shortint;
begin
  readln(s1);
  readln(s2);

  d1:=pos('.',s1);
  if d1=0 then begin
    z1:=length(s1);
    x1:=0;
  end else begin
    z1:=d1-1;
    x1:=length(s1)-d1;
    delete(s1,d1,1);
  end;

  d2:=pos('.',s2);
  if d2=0 then begin
    z2:=length(s2);
    x2:=0;
  end else begin
    z2:=d2-1;
    x2:=length(s2)-d2;
    delete(s2,d2,1);
  end;

  if z1<z2 then for i:=1 to z2-z1 do s1:='0'+s1
           else for i:=1 to z1-z2 do s2:='0'+s2;
  if x1<x2 then for i:=1 to x2-x1 do s1:=s1+'0'
           else for i:=1 to x1-x2 do s2:=s2+'0';

  if z1>z2 then z3:=z1
           else z3:=z2;
  if x1>x2 then x3:=x1
           else x3:=x2;
  len:=z3+x3;

  if s2>s1 then begin
    write('-');
    s3:=s1;s1:=s2;s2:=s3;
  end;

  for i:=1 to len do begin
    val(copy(s1,i,1),a[i],code);
    val(copy(s2,i,1),b[i],code);
  end;

  for i:=len downto 1 do begin
    c[i]:=a[i]-b[i];
    if c[i]<0 then begin
      c[i]:=c[i]+10;a[i-1]:=a[i-1]-1;
    end;
  end;

  s3:='';
  for i:=1 to len do begin
    str(c[i],s);
    s3:=s3+s;
  end;

  insert('.',s3,z3+1);

  len:=len+1;
  while s3[len]='0' do begin
    delete(s3,len,1);
    len:=len-1;
  end;

  if s3[len]='.' then delete(s3,len,1);

  while (s3[1]='0') and (z3>1) do begin
    delete(s3,1,1);
    z3:=z3-1;
  end;

  writeln(s3);
  readln;
end.

麦森数（2003复赛第4题）
var
  p,ls,i,j,k1,k2:longint;
  s:array[1..500] of byte;
begin
  readln(p);
  writeln(trunc(p*ln(2)/ln(10))+1);
  s[1]:=1;
  ls:=0;
  for i:=1 to p do begin
    ls:=ls+1;
    if ls>500 then ls:=500;
    k1:=0;
    for j:=1 to ls do begin
      k2:=s[j]*2+k1;
      k1:=k2 div 10;
      s[j]:=k2 mod 10;
    end;
  end;
  s[1]:=s[1]-1;
  for i:=500 downto 1 do begin
    write(s[i]);
    if (i-1) mod 50=0 then writeln;
  end;
  readln;
end.

综合运用：2011年（第十七届）普及组初赛第四大题第2小题 大整数开方