Stop the Hollyweb! No DRM in HTML5.

[高精度模板][Pascal]整数加、减、乘、除、开方等

很匆忙地写了一下,练练手感,可能有不少错的……

program gjdall;

uses math;

Const 
 maxlen=1500;
 numbers=['0'..'9'];
 
Type
 gjd=record
   d:array[0..maxlen] of longint;
	 len:longint;
	 zf:boolean;
 end;
 
Var
 a,b:gjd;
 
Procedure print(p:gjd);forward;
 
Procedure initgjd(var p:gjd;k:longint);//初始化gjd置为k
var
 i:longint;
 s:string;
  begin
	str(abs(k),s);
	p.len:=length(s);
	fillchar(p.d,sizeof(p.d),0);
	if k>=0 then p.zf:=true else p.zf:=false;
	for i:=1 to length(s) do
	  p.d[i]:=ord(s[length(s)-i+1])-ord('0');
end;

Function initgjd(var p:gjd):gjd;//无参数默认为0
  begin
	initgjd(p,0);
	exit(p);
end;

Function zero(P:gjd):boolean;//判断是否为0
  begin
	if (p.len=1) and (p.d[1]=0) then exit(true);
	exit(false);
end;

Function big(p1,p2:gjd):boolean;//比较p1,p2绝对值大小
var
 i:longint;
  begin
	if p1.len>p2.len then exit(true);
	if p1.len<p2.len then exit(false);
	for i:=p1.len downto 1 do
	  begin
	  if p1.d[i]>p2.d[i] then exit(true);
		if p1.d[i]<p2.d[i] then exit(false);
	end;
	exit(false);
end;

Function equal(p1,p2:gjd):boolean;//判断绝对值是否相等
  begin
	if not big(p1,p2) and not big(p2,p1) then exit(true) else exit(false);
end;

Function Create(P:longint):gjd;//得到1eP
  begin
	initgjd(create);
	create.len:=p;
	create.d[p]:=1;
end;	

Function realminus(p1,p2:gjd):gjd;//绝对值减
var
 y,ans:gjd;
 jw,i:longint;
 flag:boolean;
  begin
	if equal(p1,p2) then exit(initgjd(realminus));
	if big(p2,p1) then
	  begin
		y:=p2;
		p2:=p1;
		p1:=y;
		flag:=true;
	end else flag:=false;
	jw:=0;
	initgjd(ans);
	ans.len:=p1.len;
	for i:=1 to ans.len do
	  begin
		ans.d[i]:=p1.d[i]-p2.d[i]-jw;
		if ans.d[i]<0 then
		  begin
			inc(ans.d[i],10);
			jw:=1;
		end else jw:=0;
	end;
	while (ans.len>0) and (ans.d[ans.len]=0) do dec(ans.len);
	
	if flag then ans.zf:=not ans.zf;
	exit(ans);
end;

Function realadd(p1,p2:gjd):gjd;//绝对值加
var
 ans:gjd;
 i,jw:longint;
  begin
	initgjd(ans);
	ans.len:=max(p1.len,p2.len);
	jw:=0;
	for i:=1 to ans.len do
	  begin
		ans.d[i]:=p1.d[i]+p2.d[i]+jw;
		jw:=ans.d[i] div 10;
		ans.d[i]:=ans.d[i] mod 10;
	end;
	if jw>0 then begin inc(ans.len);ans.d[ans.len]:=jw;end;
	while (ans.len>0) and (ans.d[ans.len]=0) do dec(ans.len);
	exit(ans);
end;

Function RealCheng(p1,p2:gjd):gjd;//绝对值乘
var
 i,j:longint;
 ans:gjd;
  begin
	initgjd(ans);
	ans.len:=p1.len+p2.len;
	for i:=1 to p1.len do
	  for j:=1 to p2.len do
		  inc(ans.d[i+j-1],p1.d[i]*p2.d[j]);
	for i:=1 to ans.len do
	  begin
		inc(ans.d[i+1],ans.d[i] div 10);
		ans.d[i]:=ans.d[i] mod 10;
	end;
	while (ans.len>0) and (ans.d[ans.len]=0) do dec(ans.len);
	exit(ans);
end;

Function Add(p1,p2:gjd):gjd;//整数加
  begin
	if zero(p1) then exit(p2);
	if zero(p2) then exit(p1);
	if p1.zf and p2.zf then
		exit(realadd(p1,p2));
	if p1.zf and not p2.zf then
	  exit(realminus(p1,p2));
	if not p1.zf and p2.zf then
	  exit(realminus(p2,p1));
	add:=realadd(p1,p2);
	add.zf:=not add.zf;
end;

Function minus(p1,p2:gjd):gjd;//整数减
  begin
	if zero(p1) then begin minus:=p2;minus.zf:=not minus.zf;exit;end;
	if zero(p2) then exit(p1);
	if p1.zf and p2.zf then exit(realminus(p1,p2));
	if p1.zf and not p2.zf then exit(realadd(p1,p2));
	if not p1.zf and p2.zf then 
	  begin
		minus:=realadd(p1,p2);
	  minus.zf:=not minus.zf;
	  exit;
	end;
	exit(realminus(p2,p1));
end;

Function cheng(p1,p2:gjd):gjd;//整数乘
  begin
	if zero(p1) or zero(p2) then begin initgjd(cheng);exit;end;
	Cheng:=RealCheng(p1,p2);
	if p1.zf xor p2.zf then cheng.zf:=false else cheng.zf:=true;
end;	

Function divide(p:gjd;k:longint):gjd;//高精度整除整数
var
 jw,i:longint;
 ans:gjd;
 flag:boolean;
  begin
	if zero(p) then exit(p);
	jw:=0;
	initgjd(ans);
	ans.len:=p.len;
	if k<0 then begin k:=-k;flag:=true; end else flag:=false;
	for i:=p.len downto 1 do
	  begin
		jw:=jw*10;
		ans.d[i]:=(p.d[i]+jw) div k;
		jw:=(p.d[i]+jw)- ans.d[i]*k;
	end;
	while (ans.len>0) and (ans.d[ans.len]=0) do dec(ans.len);
	if flag then ans.zf:=not ans.zf;
	exit(ans);
end;

Function divide(p1,p2:gjd):gjd;//高精度整除高精度
var
 one,minusone,low,high,mid:gjd;
 i:longint;
  begin
	if zero(p1) then exit(p1);
	if zero(p2) then exit;
	initgjd(one,1);
	initgjd(minusone,-1);
	if equal(p1,p2) then 
	  if p1.zf xor p2.zf then exit(minusone) else
		  exit(one);
	if big(p2,p1) then exit(initgjd(divide));
	low:=create(max(p1.len-p2.len-2,1));
	high:=create(max(p1.len-p2.len+2,1));
  while big(high,low) do
    begin
		mid:=divide(add(low,high),2);
		if equal(realcheng(p2,mid),p1) then begin low:=mid;break;end;
		if big(p1,realcheng(p2,mid)) then low:=add(mid,one) else high:=minus(mid,one);
	end;
	while Big( realcheng(p2,low),p1) do low:=minus(low,one);
	if p1.zf xor p2.zf then low.zf:=false else low.zf:=true;
	exit(low);
end;

Function Sqr(P:gjd):gjd;
  begin
	exit(cheng(p,p));
end;

Function Sqrt(p:gjd):gjd;
var
 low,high,one,mid:gjd;
  begin
	if not p.zf then exit;
	if zero(p) then exit(p);
	initgjd(low,1);
	high:=p;
	initgjd(one,1);
	while big(high,low) do
	  begin
		mid:=divide(add(low,high),2);
		{write('low=');print(low);writeln;write('high=');print(high);writeln;
		write('mid=');print(mid);writeln;}
		if equal(sqr(mid),p) then exit(mid);
		if big(p,sqr(mid)) then low:=Add(mid,one) else high:=minus(mid,one);
	end;
	//writeln('d');
	while Big(sqr(low),p) do low:=minus(low,one);
	exit(low);
end;

Function times(p:gjd;k:longint):gjd;//快速幂
  begin
	if k=1 then exit(p);
	if k=0 then exit(initgjd(times));
	if k mod 2=0 then exit(sqr(times(p,k div 2))) else exit(Cheng(sqr(times(p,k div 2)),p));
end;

Procedure readgjd(var p:gjd);//读入一行高精度
var
 tmp:gjd;
 i:longint;
 c:char;
  begin
	initgjd(tmp);
	tmp.len:=0;
	while not eoln do
	  begin
		read(c);
		if c='-' then tmp.zf:=not tmp.zf;
		if c in numbers then
		  begin
			inc(tmp.len);
			tmp.d[tmp.len]:=ord(c)-ord('0');
		end;
	end;
	readln;
	p:=tmp;
	for i:=1 to p.len do
	  p.d[i]:=tmp.d[p.len-i+1];
end;

Procedure print(p:gjd);//输出一行高精度
var
 i:longint;
  begin
	if not p.zf then write('-');
	for i:=p.len downto 1 do
	  write(p.d[i]);
end;

  begin
	readgjd(a);
	readgjd(b);
	print(Add(a,b));writeln;
	print(minus(a,b));writeln;
	print(cheng(a,b));
	writeln;
	print(divide(a,b));writeln;
	print(sqr(a));
	writeln;
	print(sqr(b));
	writeln;
	print(sqrt(a));
	writeln;
	print(sqrt(b));
end.
 

 

posted on 2012-05-17 21:46  灰天飞雁  阅读(1437)  评论(0编辑  收藏  举报

填写您的邮件地址,订阅我们的精彩内容:  点击这里给我发消息

添加到收藏夹