⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 number.pas

📁 本光盘是《国际大学生程序设计竞赛例题解(一)》的配套光盘
💻 PAS
字号:
program Large_number;

const
  inputfilename='number.dat';	  {输入文件名}
  outputfilename='number.out';	{输出文件名}

var
  n,p:string;

function fix(s:string):string;	{将串s反过来}
var
  ss:string;
  i:longint;
begin
  ss:='';
  for i:=1 to length(s) do ss:=s[i]+ss;
  fix:=ss;
end;

function max(x,y:longint):longint;	{取x,y的最大值}
begin
  if x>y then max:=x
  else max:=y;
end;

function add(s1,s2:string):string;	{高精度加法}
var
  s:string;
  l,o,i:longint;
begin
  s1:=fix(s1);
  s2:=fix(s2);
  l:=max(length(s1),length(s2));
  for i:=1 to l-length(s1) do s1:=s1+'0';
  for i:=1 to l-length(s2) do s2:=s2+'0';
  s:='';  o:=0;
  for i:=1 to l do begin
    inc(o,ord(s1[i])-48+ord(s2[i])-48);
    s:=chr((o mod 10)+48)+s;
    o:=o div 10;
  end;
  if o>0 then s:=chr(o+48)+s;
  add:=s;
end;

function mul(s1,s2:string):string;	{高精度乘法}
var
  num:array[1..250] of longint;
  s:string;
  l,i,j:longint;
begin
  fillchar(num,sizeof(num),0);
  s1:=fix(s1);
  s2:=fix(s2);
  for i:=1 to length(s1) do
    for j:=1 to length(s2) do
      inc(num[i+j-1],(ord(s1[i])-48)*(ord(s2[j])-48));
  l:=length(s1)+length(s2)-1;
  for i:=1 to l do begin
    inc(num[i+1],num[i] div 10);
    num[i]:=num[i] mod 10;
  end;
  while num[l]>10 do begin
    num[l+1]:=num[l] div 10;
    num[l]:=num[l] mod 10;
    inc(l);
  end;
  s:='';
  for i:=l downto 1 do s:=s+chr(num[i]+48);
  mul:=s;
end;

function com(s:string):string;	{计算}
var
  ss:string;
begin
  while s[1]='0' do delete(s,1,1);
  ss:=mul(s,s);
  com:=add(mul(ss,s),add(ss,mul(p,'3')));
end;

function test_max(s1,s2:string):boolean;		{检查s1是否比s2大}
begin
  test_max:=true;
  if length(s1)>length(s2) then exit;
  if (length(s1)=length(s2)) and (s1>s2) then exit;
  test_max:=false;
end;

procedure read_data;		{读入数据}
var
  f:text;
begin
  assign(f,inputfilename);
  reset(f);
    readln(f,n);
  close(f);
end;

procedure search;	{搜索p的最大值}
var
  i:longint;
begin
  while n[1]='0' do delete(n,1,1);
  p:='';
  for i:=1 to length(n) do p:=p+'0';
  for i:=1 to length(p) do begin
    repeat
      p[i]:=succ(p[i]);
      if p[i]>'9' then break;
    until test_max(com(p),n);
    p[i]:=pred(p[i]);
  end;
  while (length(p)>0) and (p[1]='0') do delete(p,1,1);
  if p='' then p:='0';
end;

procedure write_data;		{输出数据}
var
  f:text;
begin
  assign(f,outputfilename);
  rewrite(f);
    writeln(f,p);
  close(f);
end;

begin		{主过程}
  read_data;
  search;
  write_data;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -