rubik-nerubik
16.12.2007, 13:22
Народ, кто поможет мне?
т.е. парень кинул мне готовую задачу, но разбираться нету сил уже...
program Snak3;
var ss,s:string;
n,i,k:longint;
read(n); ТУТ ругается что нет ':' это как? хм, может кто попробует исправить? спасибо, задача считает вида 1!+2!+3!+...+n!
s:=''; ss:='';
for i:=1 to n do
begin
for k:=1 to i do um(s,str(k),s);
sum(ss,s,ss);
end;
procedure um(a,b:string;var c:string);
var n,k,i,j,x,p:integer; d:string;
begin
n:=length(a);
k:=length(b);
c:=''; d:=''; p:=0;
for i:=1 to n+k do d:=d+'0';
for j:=k downto 1 do
begin
p:=0;
for i:=n downto 1 do begin
x:=(ord(a[i])-ord('0'))*(ord(b[j])-ord('0'))+p+ord(d[i+j])-ord('0');
d[i+j]:=chr((x mod 10)+ord('0'));
p:=x div 10;
end;
d[j]:=chr(ord(d[j])+p);
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
procedure raz(a,b:string;var c:string);
var x,n,k,i,p,g:integer;
d:string;
begin
n:=length(a);
k:=length(b);
if k<n then for i:=k+1 to n do b:='0'+b;
d:=''; c:=''; p:=0;
for i:=n downto 1 do
begin
if a[i]<b[i] then
begin
a[i-1]:=chr(ord(a[i-1])-1);
x:=10+ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end
else begin
x:=ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end;
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
function cmp(a,b:string):string;
var n,k,i:integer; c:string;
begin
n:=length(a);
k:=length(b);
c:='';
if n<k then c:='-' else
begin
if k<n then c:='+' else
begin
i:=1;
while ((a[i]=b[i])and(i<=n)) do inc(i);
if (a[i]<b[i]) then c:='-';
if (a[i]>b[i]) then c:='+';
if (i=n+1) then c:='=';
end;
end;
cmp:=c;
end;
procedure sum(a,b:string;var c:string);
var x,i,p,n,k:integer;
begin
n:=length(a);
k:=length(b);
p:=0;
c:='';
if n<k then begin
for i:=n+1 to k do
a:='0'+a;
end else
begin
for i:=k+1 to n do
b:='0'+b; end;
n:=length(a);
for i:=n downto 1 do
begin
x:=ord(a[i])-ord('0')+ord(b[i])-ord('0')+p;
c:=chr((x mod 10)+ord('0'))+c;
p:=x div 10;
end;
if p<>0 then
begin
inc(n);
c:='1'+c;
end;
т.е. парень кинул мне готовую задачу, но разбираться нету сил уже...
program Snak3;
var ss,s:string;
n,i,k:longint;
read(n); ТУТ ругается что нет ':' это как? хм, может кто попробует исправить? спасибо, задача считает вида 1!+2!+3!+...+n!
s:=''; ss:='';
for i:=1 to n do
begin
for k:=1 to i do um(s,str(k),s);
sum(ss,s,ss);
end;
procedure um(a,b:string;var c:string);
var n,k,i,j,x,p:integer; d:string;
begin
n:=length(a);
k:=length(b);
c:=''; d:=''; p:=0;
for i:=1 to n+k do d:=d+'0';
for j:=k downto 1 do
begin
p:=0;
for i:=n downto 1 do begin
x:=(ord(a[i])-ord('0'))*(ord(b[j])-ord('0'))+p+ord(d[i+j])-ord('0');
d[i+j]:=chr((x mod 10)+ord('0'));
p:=x div 10;
end;
d[j]:=chr(ord(d[j])+p);
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
procedure raz(a,b:string;var c:string);
var x,n,k,i,p,g:integer;
d:string;
begin
n:=length(a);
k:=length(b);
if k<n then for i:=k+1 to n do b:='0'+b;
d:=''; c:=''; p:=0;
for i:=n downto 1 do
begin
if a[i]<b[i] then
begin
a[i-1]:=chr(ord(a[i-1])-1);
x:=10+ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end
else begin
x:=ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end;
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
function cmp(a,b:string):string;
var n,k,i:integer; c:string;
begin
n:=length(a);
k:=length(b);
c:='';
if n<k then c:='-' else
begin
if k<n then c:='+' else
begin
i:=1;
while ((a[i]=b[i])and(i<=n)) do inc(i);
if (a[i]<b[i]) then c:='-';
if (a[i]>b[i]) then c:='+';
if (i=n+1) then c:='=';
end;
end;
cmp:=c;
end;
procedure sum(a,b:string;var c:string);
var x,i,p,n,k:integer;
begin
n:=length(a);
k:=length(b);
p:=0;
c:='';
if n<k then begin
for i:=n+1 to k do
a:='0'+a;
end else
begin
for i:=k+1 to n do
b:='0'+b; end;
n:=length(a);
for i:=n downto 1 do
begin
x:=ord(a[i])-ord('0')+ord(b[i])-ord('0')+p;
c:=chr((x mod 10)+ord('0'))+c;
p:=x div 10;
end;
if p<>0 then
begin
inc(n);
c:='1'+c;
end;