input_case nil$ % Group statement and block % ------------------------- a:=0$ x:=<>; a; x:=begin scalar a; a:=y; write a; return a end; a; clear a,x; let x*y=2; x*z/(x*y); x*z/<>; clear x*y; strange!?var!#name; % including any characters in a name % Conditional statement % --------------------- n:=10$ m:=b$ if fixp(n) and fixp(m) and n>m then <> else <>; a; clear n,m,a; % Arrays and loops % ---------------- n:=5$ array a(n); for i:=0:n do a(i):=x^i; for i:=0:n do write a(i); for i:=0:n sum a(i); clear n,a; for i:=1:100 product i; % 100! for i:=2 step 2 until 100 product i; % 100!! % Lists % ----- l:={x,x+1,x+2}; first(l); rest(l); length(l); second(l); third(l); l:=(x-1).l; % adding element append({a,b},{c,d}); reverse({a,b,c}); reverse({{a,b},c}); while l neq {} do <>; l:=for i:=-1:2 collect x+i; for each u in l do write u," squared = ",u^2; clear l,u; % Procedures % ---------- procedure fac(n); for i:=1:n product i; f100:=fac(100)$ % recursive procedure procedure fac(n); if n=0 then 1 else n*fac(n-1)$ if fac(100)=f100 then write "OK" else write "error"; clear fac,f100; % Taylor series for exp procedure exp1(x,n); begin scalar s,u; s:=1; u:=1; for i:=1:n do <>; return s end$ on div,revpri; exp1(x,10); clear exp1; % method using small variables procedure exp2(x); begin scalar s,u,i; s:=1; u:=x; i:=1; repeat <> until u=0; return s end$ weight x=1$ wtlevel 10$ exp2(x); exp2(x+x^2); clear exp2; % binominal series (1+x)^n procedure binom(x,n); begin scalar s,u,i,j; s:=u:=i:=1; j:=n; while (u:=u*x*j/i) neq 0 do <>; return s end$ binom(y,4); binom(x,1/2); binom(x,-1); binom(x+x^2,-1); wtlevel 4$ r:=binom(x,n)$ clear x; factor x; off div; on rat; r; remfac x; off rat,revpri; procedure conj(z); sub(i=-i,z)$ procedure Re(z); (z+conj(z))/2$ procedure Im(z); (z-conj(z))/(2*i)$ for all z such that Im(z) neq 0 let e^z=e^Re(z)*(cos(Im(z))+i*sin(Im(z))); e^((x+i*y)/(u+i*v)); for all z such that Im(z) neq 0 clear e^z; clear conj,Re,Im; operator fac; for all n let fac(n)=for i:=1:n product i; fac(n); for all n clear fac(n); for all n such that fixp(n) let fac(n)=for i:=1:n product i; fn:=fac(n); n:=10$ fn; for all n such that fixp(n) clear fac(n); clear n,fn; procedure show(); <>$ % empty brackets () are not mandatory show; show(); clear show; let show=<>; show; clear show; let let1=<>, cle1=<>; let1$ cos(z)^4; cle1$ cos(z)^4; clear let1,cle1; % Substitution lists % ------------------ Fourier:={cos(~x)^2=>(1+cos(2*x))/2,sin(~x)^2=>(1-cos(2*x))/2, cos(~x)*cos(~y)=>(cos(x-y)-cos(x+y))/2, sin(~x)*sin(~y)=>(cos(x-y)+cos(x+y))/2, sin(~x)*cos(~y)=>(sin(x-y)+sin(x+y))/2}; y:=((a*cos(x)+b*sin(x))^2 where Fourier); let Fourier; (a*cos(x)+b*sin(x))^2; clearrules Fourier; (a*cos(x)+b*sin(x))^2; clear y; operator Cos; rule:={Cos(~n*pi)=>(-1)^n when fixp(n)}; let rule; Cos(100*pi); Cos(101*pi); Cos(n*pi); clearrules rule; clear Cos; operator f,g; rule:={f(x*~~y)=>g(y), f(x^~~n*y^~~m)=>g(n,m)}; let rule; f(x*y*z); f(x); f(x^2*y^3); f(x^2*y); clearrules rule; clear rule,f,g; % Debugging % --------- %load_package rdebug; % %procedure fib(n); if n<3 then 1 else fib(n-1)+fib(n-2)$ %tr fib$ fib(5); %untr fib$ clear fib; % %weight x=1$ wtlevel 4$ %trst binom$ binom(x,-2); %untrst binom$ % %procedure brk(); <<>>$ % %procedure binom(x,n); %begin scalar s,u,i,j; s:=u:=i:=1; j:=n; % while (u:=u*x*j/i) neq 0 do % <>; % return s %end$ % %weight x=1$ wtlevel 4$ y:=x+x^2$ k:=-1$ %br brk$ binom(y,k); %unbr brk$ clear brk; % %trrl Fourier$ (a*cos(x)+b*sin(x))^4; %untrrl Fourier$ clearrules Fourier; clear Fourier; % Assignments and substitutions % ----------------------------- x:=xx$ y:=yy$ let x=y; x; xx; clear y; x; clear x; x:=xx$ y:=yy$ x:=y; x; xx; clear y; x; clear x; x:=xx$ y:=yy$ set(x,y); x; xx; clear x; xx; clear y; xx; clear xx; procedure call_let(a,b); let a=b$ x:=xx*yy$ y:=xy$ call_let(x,y); clear x,y; xx^2*yy^3; clear xx*yy; x:=xx$ y:=yy$ sub(x=y,xx); clear x,y; operator f; x:=xx$ y:=yy$ let f(x)=y; clear x; f(x); f(xx); clear y; f(xx); clear f(xx); x:=xx$ y:=yy$ f(x):=y; clear x; f(x); f(xx); clear y; f(xx); clear f(xx); let x^2=x2; x^5; let x^3=x3; x^5; x^2; clear x^3; let x*y^2=xy2; x^2*y^4; let x^2*y=x2y; x^2*y; x*y^2; x^4*y^4; % result depends on order of application of substitutions clear x*y^2,x^2*y; x:=xx$ x^2:=x2; clear x; x^2; xx^2; clear xx^2; x:=xx$ y:=yy$ x*y:=xy; clear x,y; x*y; xx*yy; clear xx*yy; procedure p(a,b); << a:=aa; let b=bb; >>$ x:=xx$ y:=yy$ p(x,y)$ x; y; clear x,y; yy; clear yy; x:=xx$ y:=yy$ p(x,x*y)$ x*y; clear x,y; xx*yy; clear xx*yy; for all a,b let f(a,b)=<< a:=aa; b:=bb >>; x:=xx$ f(x,f(x))$ x; f(x); clear x; xx; f(xx); clear xx; f(aa); clear f(aa); % Jensen device - remember Algol60 ? end;