1% Test SCOPE Package.
2% ==================
3% NOTE:  The SCOPE, GHORNER, GSTRUCTR and GENTRAN packages must be loaded
4% to run these tests.
5
6% Further reading: SCOPE 1.5 manual Section 3, example 1;
7
8scope_switches$
9
10% Further reading: SCOPE 1.5 manual Section 3.1, examples 2,3,4 and 5.
11
12on priall$
13optimize z:=a^2*b^2+10*a^2*m^6+a^2*m^2+2*a*b*m^4+2*b^2*m^6+b^2*m^2
14	   iname s;
15off priall$
16on primat,acinfo$
17optimize
18     ghorner <<z:=a^2*b^2+10*a^2*m^6+a^2*m^2+2*a*b*m^4+2*b^2*m^6+b^2*m^2>>
19     vorder m
20     iname s;
21off exp,primat,acinfo$
22q:=a+b$
23r:=q+a+b$
24optimize x:=a+b,q:=:q^2,p(q)::=:r iname s;
25on exp$
26clear q,r$
27
28% A similar example follows.
29% operator a$% Not necessary. Some differences between REDUCE 3.5 and REDUCE 3.6
30% when dealing with indices.
31
32on inputc$
33k:=j:=1$
34u:=c*x+d$
35v:=sin(u)$
36optimize {a(k,j):=v*(v^2*cos(u)^2+u),
37          a(k,j)::=:v*(v^2*cos(u)^2+u)} iname s;
38off exp$
39optimize {a(k,j):=v*(v^2*cos(u)^2+u),
40          a(k,j)::=:v*(v^2*cos(u)^2+u)} iname s;
41off inputc,period$
42optlang fortran$
43optimize z:=(6*a+18*b+9*c+3*d+6*j+18*f+6*g+5*h+5*k+3)^13 iname s;
44off ftch$
45optimize z:=(6*a+18*b+9*c+3*d+6*j+18*f+6*g+5*h+5*k+3)^13 iname s;
46optlang c$
47optimize z:=(6*a+18*b+9*c+3*d+6*j+18*f+6*g+5*h+5*k+3)^13 iname s;
48
49% Note: C code never contains exponentiations.
50
51on ftch$
52optimize {x:=3*a*p,y:=3*a*q,z:=6*a*r+2*b*p,u:=6*a*d+2*b*q,
53v:=9*a*c+4*b*d,w:=4*b} iname s;
54off ftch$
55optlang fortran$
56optimize {x:=3*a*p,y:=3*a*q,z:=6*a*r+2*b*p,u:=6*a*d+2*b*q,
57v:=9*a*c+4*b*d,w:=4*b} iname s;
58on ftch$
59setlength 2$
60optimize {x:=3*a*p,y:=3*a*q,z:=6*a*r+2*b*p,u:=6*a*d+2*b*q,
61v:=9*a*c+4*b*d,w:=4*b} iname s;
62resetlength$
63optlang nil$
64
65% Further reading: SCOPE 1.5 manual section 3.1, example 9 and section 3.2.
66
67u:=a*x+2*b$
68v:=sin(u)$
69w:=cos(u)$
70f:=v^2*w;
71off exp$
72optimize f:=:f,g:=:f^2+f iname s$
73alst:=aresults;
74restorables;
75f;
76arestore f;
77f;
78alst;
79optimize f:=:f,g:=:f^2+f iname s$
80alst:=aresults$
81optimize f:=:f,g:=:f^2+f iname s$
82restoreall$
83f;
84
85% Further reading: SCOPE 1.5 manual section 3.1, example 8.
86%                  See also section 5.
87%                  Also recommended: section 9.
88
89clear a$
90matrix a(2,2)$
91a(1,1):=x+y+z$
92a(1,2):=x*y$
93a(2,1):=(x+y)*x*y$
94a(2,2):=(x+2*y+3)^3-x$
95on exp$
96off fort,nat$
97optimize detexp:=:det(a) out "expfile" iname s$
98off exp$
99optimize detnexp:=:det(a) out "nexpfile" iname t$
100in expfile$
101in nexpfile$
102on nat$
103detexp-detnexp;
104system "rm expfile nexpfile"$
105
106% Further reading: SCOPE 1.5 manual section 4.2, example 15.
107% Although the output is similar, it is in general equivalent and
108% not identical when using REDUCE 3.6 in stead of REDUCE 3.5. This
109% is due to improvements in the simplification strategy.
110
111on acinfo$
112optimize
113   gstructr<<a;aa:=(x+y)^2;b:=(x+y)*(y+z);c:=(x+2*y)*(y+z)*(z+x)^2>>
114name v iname s;
115alst:=
116  algopt(algstructr({a,b=(x+y)^2,c=(x+y)*(y+z),d=(x+2*y)*(y+z)*(z+x)^2},v),s);
117off acinfo$
118
119% Further reading: SCOPE 1.5 manual section 4.3, example 16.
120
121clear a$
122procedure taylor(fx,x,x0,n);
123 sub(x=x0,fx)+(for k:=1:n sum(sub(x=x0,df(fx,x,k))*(x-x0)^k/factorial(k)))$
124hlst:={f1=taylor(e^x,x,0,4),f2=taylor(cos x,x,0,6)}$
125on rounded$
126hlst:=hlst;
127optimize alghorner(hlst,{x}) iname g$
128off rounded$
129
130% Further reading: SCOPE 1.5 manual section 3.1, examples 6 and 7.
131
132optimize z:=:for j:=2:6 sum a^(1/j) iname s$
133optimize z1:=a+sqrt(sin(a^2+b^2)), z2:=b+sqrt(sin(a^2+b^2)),
134         z3:=a+b+(a^2+b^2)^(1/2),  z4:=sqroot(a^2+b^2)+(a^2+b^2)^3,
135         z5:=a^2+b^2+cos(a^2+b^2), z6:=(a^2+b^2)^(1/3)+(a^2+b^2)^(1/6)
136iname s;
137
138% Further reading: SCOPE 1.5 manual section 6, examples 18 and 19.
139
140optlang fortran$
141optimize {x(i+1,i-1):=a(i+1,i-1)+b(i),y(i-1):=a(i-1,i+1)-b(i)} iname s
142         declare <<x(4),a(4,4),y(5): real;b(5): integer>>;
143optlang c$
144optimize {x(i+1,i-1):=a(i+1,i-1)+b(i),y(i-1):=a(i-1,i+1)-b(i)} iname s
145         declare <<x(4),a(4,4),y(5): real;b(5): integer>>;
146optlang  pascal$
147optimize {x(i+1,i-1):=a(i+1,i-1)+b(i),y(i-1):=a(i-1,i+1)-b(i)} iname s
148         declare <<x(4),a(4,4),y(5): real;b(5): integer>>;
149optlang ratfor$
150optimize {x(i+1,i-1):=a(i+1,i-1)+b(i),y(i-1):=a(i-1,i+1)-b(i)} iname s
151         declare <<x(4),a(4,4),y(5): real;b(5): integer>>;
152precision 7$
153on rounded, double$
154optlang fortran$
155optimize x1:=2         *a + 10        *b,
156         x2:=2.00001   *a + 10        *b,
157         x3:=2         *a + 10.00001  *b,
158         x4:=6         *a + 10        *b,
159         x5:=2.0000001 *a + 10.000001 *b
160iname s
161declare << x1,x2,x3,x4,x5,a,b: real>>$
162
163% Further reading: SCOPE 1.5 manual section 7, example 20.
164% Notice the double role of e: In the lhs as identifier. In the rhs as
165% exponential function.
166% Further notice that a is expected to be declared operator. This is
167% due to lower level scope activities.
168
169optimize a(1,x+1)  := g + h*r^f,
170         b(y+1)    := a(1,2*x+1)*(g+h*r^f),
171         c1        := (h*r)/g*a(2,1+x),
172         c2        := c1*a(1,x+1) + sin(d),
173         a(1,x+1)  := c1^(5/2),
174         d         := b(y+1)*a(1,x+1),
175         a(1,1+2*x):= (a(1,x+1)*b(y+1)*c)/(d*g^2),
176         b(y+1)    := a(1,1+x)+b(y+1) + sin(d),
177         a(1,x+1)  := b(y+1)*c + h/(g + sin(d)),
178         d         := k*e + d*(a(1,1+x) + 3),
179         e         := d*(a(1,1+x) + 3) + sin(d),
180         f         := d*(3 + a(1,1+x)) + sin(d),
181         g         := d*(3 + a(1,1+x)) + f
182iname s
183declare << a(5,5),b(7),c,c1,d,e,f,g,h,r: real*8; x,y: integer>>$
184
185% Further reading: SCOPE 1.5 manual section 8, examples 21 and 22.
186%                  Also recommended: section 9.
187
188optlang nil$
189delaydecs$
190 gentran declare <<a,b,c,d,q,w: real>>$
191 gentran a:=b+c$
192 gentran d:=b+c$
193 gentran <<q:=b+c;w:=b+c>>$
194makedecs$
195on gentranopt$
196delaydecs$
197 gentran declare <<a,b,c,d,q,w: real>>$
198 gentran a:=b+c$
199 gentran d:=b+c$
200 gentran <<q:=b+c;w:=b+c>>$
201makedecs$
202off gentranopt$
203delayopts$
204 gentran declare <<a,b,c,d,q,w: real>>$
205 gentran a:=b+c$
206 gentran d:=b+c$
207 gentran <<q:=b+c;w:=b+c>>$
208makeopts$
209delaydecs$
210 gentran declare <<a,b,c,d,q,w: real>>$
211 delayopts$
212  gentran a:=b+c$
213  gentran d:=b+c$
214  gentran <<q:=b+c;w:=b+c>>$
215 makeopts$
216makedecs$
217clear a,b,c,d,q,w$
218matrix a(2,2)$
219a:=mat(((b+c)*(c+d),(b+c+2)*(c+d-3)),((c+b-3)*(d+b),(c+b)*(d+b+4)));
220gentranlang!*:='c$
221delayopts$
222 gentran aa:=:a$
223makeopts$
224end;
225