ENG  RUS Timus Online Judge
Online Judge
Problems
Authors
Online contests
Site news
Webboard
Problem set
Submit solution
Judge status
Guide
Register
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

## Discussion of Problem 1408. Polynomial Multiplication

Strange! why crash 1 ?????!!!!!!!!
Posted by lhmhl 17 May 2009 14:37
type
fu1=array['a'..'z'] of longint;
su=record
a:fu1;
zf:integer;
x:longint;
end;
kk1=array[1..1000] of su;
var
a,b,c:kk1;
d:su;
i,j,k,l,x,y,n,m:longint;
s:string;
g:boolean;
ch:char;
function jun(g:boolean):integer;
begin
if g then exit(1) else exit(-1);
end;
procedure doit(var a:kk1;  var n:longint);
var
g:boolean;
c:char;
num:string;
nu:longint;
begin
num:='';
for i:=1 to length(s) do
if s[i]<>' ' then num:=num+s[i];
s:='';
for i:=1 to length(num) do
begin
if num[i] in[ '+','-']
then begin
if i<>1 then
s:=s+' '+num[i]+' '
else s:=s+num[i];
end
else begin
s:=s+num[i];
end;
end;

g:=true;
if s[1] in ['+','-']
then begin
if s='-' then g:=false;
delete(s,1,1);
end;
repeat
i:=pos(' ',s);
l:=length(s);
if i=0 then i:=l+1;
d.zf:=jun(g);
d.x:=d.zf;
fillchar(d.a,sizeof(d.a),0);
if s[1] in ['0'..'9']
then begin
num:='';
while (s[1] in ['0'..'9']) and (length(s)<>0) do
begin
num:=num+s[1];
delete(s,1,1);
end;
if s[1]<>' ' then  delete(s,1,1);
val(num,j,nu);
d.x:=j*d.zf;
i:=pos(' ',s);
l:=length(s);
if i=0 then i:=l+1;
end;
if d.x=0 then
begin
delete(s,1,i-1);
g:=s[2]='+';
delete(s,1,3);
continue;
end;
if s[1]=' ' then
begin
inc(n); a[n]:=d;
g:=s[2]='+';
delete(s,1,3);
continue;
end;
if length(s)=0 then begin inc(n); a[n]:=d; break; end;
k:=1;
j:=1;
while j<=i do
begin
c:=s[j];
k:=1;
if (j>=i) then inc(j,2) else begin
if s[j+1]='^'
then begin
inc(j,2);
num:='';
while s[j] in ['0'..'9'] do
begin
num:=num+s[j];
inc(j);
if (j>i) or (j=l+1) then break;
end;
inc(j);
val(num,k,nu);
end
else inc(j,2);
end;

d.a[c]:=d.a[c]+k;
end;
delete(s,1,i-1);
if i<>l+1
then begin
g:=s[2]='+';
delete(s,1,3);
end;
inc(n);
a[n]:=d;
until i=l+1;
end;
function jia(a,b:su):su;
var
i:longint;
c:char;
begin
a.x:=a.x*b.x;
for c:='a' to 'z' do
a.a[c]:=a.a[c]+b.a[c];
exit(a);
end;
function ok(a,b:su):boolean;
var
c:char;
begin
for c:='a' to 'z' do
begin
if a.a[c]<>b.a[c]
then exit(false);
end;
exit(true);
end;
function bijiao1(a,b:su):boolean;
var
c:char;
i,x,y:longint;
begin
i:=2;
x:=0; y:=0;
for c:='a' to 'z' do
begin
x:=x+a.a[c];
y:=y+b.a[c];
if (i=2) then begin
if a.a[c]>=b.a[c]
then begin if a.a[c]>b.a[c] then  i:=1 end
else i:=0;
end;
end;
if (x<y) or ((i=0) and(x=y) ) then exit(true) else exit(false);
end;
begin
{ fillchar(a,sizeof(a),0);
fillchar(b,sizeof(b),0);
fillchar(c,sizeof(c),0); }
n:=0;
m:=0;
doit(a,n);
doit(b,m);

k:=0;
for i:=1 to n do
begin
for j:=1 to m do
begin
d:=jia(a[i],b[j]);
g:=true;
for x:=1 to k do
begin
if ok(c[x],d)
then begin
c[x].x:=c[x].x+d.x;
g:=false;
break;
end;
end;
if g then
begin
inc(k);
c[k]:=d;
end;
end;
end;
for i:=1 to k-1 do
for j:=i+1 to k do
begin
if bijiao1(c[i],c[j])
then begin
d:=c[i];
c[i]:=c[j];
c[j]:=d;
end;
end;
for i:=1 to k do
begin
if (c[i].x=0) then continue;
if (c[i].x>0)
then begin
if i<>1 then write('+');
if i<>1 then write(' ');
end
else begin
write('-');
if i<>1 then write(' ');
end;
c[i].x:=abs(c[i].x);
g:=true;
if c[i].x<>1 then write(c[i].x);
for ch:='a' to 'z' do
begin
if c[i].a[ch]=0 then continue;
if (c[i].x<>1) or (g=false)
then write('*');
g:=false;
write(ch);
if c[i].a[ch]<>1 then write('^',c[i].a[ch]);
end;
if g and (c[i].x=1) then write(1);
if i<>k then
write(' ');
end;
end.

i think there's no problem with mine

Edited by author 17.05.2009 14:38