cloned from srcbox.
[furry-nemesis.git] / multiply.pas
blob4045b555d93628e786b90b3e180e0bbcde6e9038
1 type
2 arr=array [0..80,0..2] of longint;
4 var
5 a,b,c:arr;
6 i,j,lena,lenb,lenc,lenp:longint;
7 st:string;
9 function len(a:longint):string;
10 var
11 s:string;
12 i:longint;
14 begin
15 str(abs(a),s);
16 if s='1' then exit('');
17 for i:=1 to length(s) do s[i]:=' ';
18 exit(s);
19 end;
21 function getsum(st:string; var k:longint):longint;
22 begin
23 getsum:=0;
24 while (k<=length(st)) and (st[k] in ['0'..'9']) do begin getsum:=getsum*10+ord(st[k])-ord('0'); inc(k); end;
25 end;
27 procedure trans(st:string; var p:arr);
28 var
29 i,k1,k2,k,t:longint;
30 q:array [0..80] of string;
31 f:boolean;
33 begin
34 t:=0;
35 for i:=1 to 80 do q[i]:='';
36 i:=0;
37 for j:=1 to length(st) do
38 begin
39 if (st[j]='+') or (st[j]='-') then inc(i);
40 q[i]:=q[i]+st[j];
41 end;
42 lenp:=i;
43 for j:=1 to i do
44 if q[j]<>'' then
45 begin
46 if q[j][1]='-' then p[j,0]:=-1 else p[j,0]:=1;
47 k:=2; t:=getsum(q[j],k);
48 if t<>0 then p[j,0]:=p[j,0]*t;
49 if k>length(q[j]) then continue;
50 if q[j][k]='x' then begin inc(k); t:=getsum(q[j],k); if t=0 then t:=1; p[j,1]:=t; end
51 else if q[j][k]='y' then begin inc(k); t:=getsum(q[j],k); if t=0 then t:=1; p[j,2]:=t; end;
52 if k<=length(q[j]) then
53 if q[j][k]='x' then begin inc(k); t:=getsum(q[j],k); if t=0 then t:=1; p[j,1]:=t; end
54 else if q[j][k]='y' then begin inc(k); t:=getsum(q[j],k); if t=0 then t:=1; p[j,2]:=t; end;
55 end;
56 end;
58 function next(j:longint):longint;
59 var
60 i:longint;
62 begin
63 next:=j+1;
64 for i:=j+1 to lenc do if c[i,0]=0 then inc(next) else break;
65 end;
67 begin
68 assign(input,'multiply.dat'); reset(input);
69 assign(output,'multiply.out'); rewrite(output);
70 readln(st);
71 if st='0' then begin writeln; writeln(0); close(input); close(output); halt; end;
72 if (st[1] in ['x'..'y']) or (st[1] in ['0'..'9']) then st:='+'+st;
73 trans(st,a);
74 lena:=lenp; lenp:=0;
75 readln(st);
76 if st='0' then begin writeln; writeln(0); close(input); close(output); halt; end;
77 if (st[1] in ['x'..'y']) or (st[1] in ['0'..'9']) then st:='+'+st;
78 trans(st,b);
79 lenb:=lenp;
80 for i:=1 to lena do
81 for j:=1 to lenb do
82 begin
83 c[(i-1)*lenb+j,0]:=a[i,0]*b[j,0];
84 c[(i-1)*lenb+j,1]:=a[i,1]+b[j,1];
85 c[(i-1)*lenb+j,2]:=a[i,2]+b[j,2];
86 end;
87 lenc:=lena*lenb;
88 for i:=1 to lena*lenb do
89 for j:=1 to i-1 do
90 if (i<>j) and (c[i,1]=c[j,1]) and (c[i,2]=c[j,2]) then
91 begin
92 inc(c[i,0],c[j,0]);
93 c[j,0]:=0; c[j,1]:=0; c[j,2]:=0;// dec(lenc);
94 end;
96 for i:=1 to lenc-1 do
97 for j:=i+1 to lenc do
98 if (c[i,1]<c[j,1]) or ((c[i,1]=c[j,1]) and (c[i,2]>c[j,2])) then
99 begin
100 c[0]:=c[i]; c[i]:=c[j]; c[j]:=c[0];
101 end;
102 if c[1,0]<0 then write(' ');
103 for i:=1 to lenc do
104 if c[i,0]<>0 then
105 begin
106 write(len(c[i,0]));
107 if (abs(c[i,0])=1) and (c[i,1]=0) and (c[i,2]=0) then write(' ');
108 if c[i,1]<>0 then
109 begin
110 write(' ');
111 if c[i,1]<>1 then write(c[i,1]);
112 end;
113 if c[i,2]<>0 then
114 begin
115 write(' ');
116 if c[i,2]<>1 then write(c[i,2]);
117 end;
118 if c[next(i),0]<>0 then write(' ');
119 end;
120 writeln;
121 if c[1,0]<>0 then
122 begin
123 if c[1,0]<0 then write('-');
124 // if abs(c[1,0])<>1 then write(abs(c[1,0]));
125 end;
126 for i:=1 to lenc do
127 if c[i,0]<>0 then
128 begin
129 if (abs(c[i,0])<>1) or ((abs(c[i,0])=1) and (c[i,1]=0) and (c[i,2]=0)) then write(abs(c[i,0]));
130 if c[i,1]<>0 then write('x',len(c[i,1]));
131 if c[i,2]<>0 then write('y',len(c[i,2]));
132 write(' ');
133 if c[next(i),0]>0 then write('+ ') else
134 if c[next(i),0]<0 then write('- ');
135 end;
136 close(input); close(output);
137 end.