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