(: ., , )
 

1. . 2

2. ( ) 2

3. , "". 2

4. A.. 2

5. 10000. 3

6. 500. 3

7. . 3

8. . 3

9. ?. 4

10. C...D.. 4

11. . 4

12. . 4

13. ?. 5

WHILE.. 5

FOR.. 5

14. "" .. 5

15. : A*x^2 + B*x + C = 0. 6

16. . 6

17. (A B) . 6

18. 3 .. 6

19. M(x,y) O(Xc,Yc) R 7

20. . 7

21. . 7

22. . 7

23. . 8

24. .. 8

. 8

. 8

. 9

. 9

25. 2- . 10

26. 3- . 10

27. .. 11

2 ?. 11

?. 11

?. 12

? 1. 13

? 2. 13

28. .. 14

. 14

. 14

. 15

. 16

29. -, ROW - 1 , COL - 2 . 16

30. . ( ) 17

31. . 17

. 17

. 17

. 18

. 18

( ) 18

( ) 19

{...}. 19

32. -: . 19

33. -. 21

.. 21

. 22

. 23

. 25

.. 27

 

1.         

var s:string;
 r:real;
 i,j,n:integer;
begin
 r:=0;
 readln(s);
 for i:=1 to length(s) do begin
 n:=0;
 for j:=1 to length(s) do begin
 if s[i]=s[j] then inc(n);
 end;
 r:=r+1/n;
 end;
 writeln('   = ', r:1:0);
end.

2.          ( )

var s:string;
 i,j,n:integer;
begin
 readln(s);
 s:=s[length(s)] + copy(s,1,length(s)-1);
 writeln(s);
end.

3.          , ""

{ , "", "" -  }
program primer1;
var s1,s2:string;
 i:integer;
begin
 readln(s1); s2:='';
 for i:=length(s1) downto 1 do begin
 s2:=s2+s1[i];
 end;
 if s1=s2 then writeln(s1, ' - ')
 else writeln(s1, ' -  ');
end.

4.          A

var a,n,c,d:word;
begin {   }
 readln( a );
 n:=1;
 while ( n <= sqrt(a) ) do begin
 c:=a mod n;
 d:=a div n;
 if c = 0 then begin
 writeln( n );
 if n <> d then writeln( d );
 end;
 inc( n );
 end;
end.

5.          10000

const LIMIT = 10000;
var n,i,j,s,lim,c,d : word;
begin {   }
 for i:=1 to LIMIT do begin
 s:=1; lim:=round(sqrt(i));
 for j:=2 to lim do begin
 c:=i mod j;
 d:=i div j;
 if c = 0 then begin
 inc(s,j);
 if (j<>d) then inc(s,d); {    }
 end;
 end;
 if s=i then writeln(i);
 end;
end.

6.          500

const LIMIT = 500;
var i,j,lim : word;
 
begin {   }
 writeln; { ,    }
 for i:=1 to LIMIT do begin
 j:=2; lim:=round(sqrt(i));
 while (i mod j <> 0) and (j <= lim) do inc( j );
 if (j > lim) then write( i,' ' );
 end;
end.

7.         

var a:array[1..10] of integer;
 s:longint;
 i:integer;
begin
 writeln(' 10  ');
 s:=0;
 for i:=1 to 10 do begin
 readln( a[i] );
 s:=s+a[i];
 end;
 writeln( '   = ', s );
end.

8.         

var a:array[1..10,1..2] of integer;
 s:longint;
 i,j:integer;
begin
 writeln(' 20  ');
 s:=0;
 for i:=1 to 10 do begin
 for j:=1 to 2 do begin
 readln( a[i,j] );
 s:=s+a[i,j];
 end;
 end;
 writeln( '   = ', s );
end.

9.          ?

var a:array[1..10] of integer;
 min:integer;
 i:integer;
begin
 writeln(' 10  ');
 min:=MAXINT;
 for i:=1 to 10 do begin
 readln( a[i] );
 if min>a[i] then min:=a[i];
 end;
 writeln( '   = ', min );
end.

10.       C...D

var a:array[1..10] of integer;
 c,d:integer;
 i:integer;
begin
 writeln(' 10  ');
 for i:=1 to 10 do readln( a[i] );
 writeln('  C  D');
 readln( c,d );
 for i:=1 to 10 do begin
 if (a[i]>=C) and (a[i]<=D) then writeln(a[i]);
 end;
end.

11.      

var a:array[1..10] of integer;
 x:integer;
 i:integer;
begin
 writeln(' 10  ');
 for i:=1 to 10 do readln( a[i] );
 x:=a[10];
 for i:=10 to 2 do begin
 a[i]:=a[i-1];
 end;
 a[1]:=x;
 writeln(' :');
 for i:=1 to 10 do writeln( a[i] );
end.

12.      

var a:array[1..10] of integer;
 i,j,m,p,n:integer;
begin
 writeln(' 10  ');
 for i:=1 to 10 do readln( a[i] );
 m:=1; p:=1;
 for i:=1 to 10 do begin
 n:=0;
 for j:=1 to 10 do begin
 if a[i]=a[j] then inc(n);
 end;
 if n>m then begin
 m:=n; p:=i;
 end;
 end;
 writeln('   :',a[p]);
end.

13.       ?

WHILE

 
var a:array[1..10] of integer;
 i,j:integer;
begin
 writeln(' 10  ');
 for i:=1 to 10 do readln( a[i] );
 i:=1;
 while (i<10) and (j<11) do begin
 j:=i+1;
 while (j<11) and (a[i]<>a[j]) do inc(j);
 inc(i);
 end;
 if i<11 then writeln('    ')
 else writeln('   ');
end.

FOR

var a:array[1..10] of integer;
 i,j:integer;
begin
 writeln(' 10  ');
 for i:=1 to 10 do readln( a[i] );
 for i:=1 to 9 do begin
 for j:=i+1 to 10 do begin
 if a[i]=a[j] then break;
 end;
 if j<10 then break;
 end;
 if i<9 then writeln('    ')
 else writeln('   ');
end.

14.       ""

const n = 10; {     }
var a:array[1..n] of integer;
 i,j,x:integer;
begin
 writeln(' ',n,'  ');
 for i:=1 to n do readln( a[i] );
 
 for i:=1 to n-1 do begin
 for j:=i+1 to n do begin
 if a[i]>a[j] then begin
 x:=a[i]; a[i]:=a[j]; a[j]:=x;
 end;
 end;
 end;
 writeln(' :');
 for i:=1 to n do writeln( a[i] );
end.

15.       : A*x^2 + B*x + C = 0

var a,b,c,d,x:real;
begin
 writeln(' A,B,C');
 readln( a,b,c );
 d:=sqr(b)-4*a*c;
 if d<0 then begin
 writeln('  ');
 end else if d=0 then begin
 x:=(-b)/2*a;
 writeln(' : ',x);
 end else begin
 x:=(-b+sqrt(d))/2*a;
 writeln('1-  : ',x);
 x:=(-b-sqrt(d))/2*a;
 writeln('2-  : ',x);
 end
end.

16.      

var x1,y1,x2,y2,d:real;
begin
 writeln(' A(X1,Y1)  B(X2,Y2)');
 readln( x1,y1,x2,y2 );
 d:=sqrt(sqr(y2-y1)+sqr(x2-x1));
 writeln('  |AB|=',d);
end.

17.       (A B)

var x1,y1,x2,y2,d1,d2:real;
begin
 writeln(' A(X1,Y1)  B(X2,Y2)');
 readln( x1,y1,x2,y2 );
 d1:=sqrt(sqr(y1)+sqr(x1));
 d2:=sqrt(sqr(y2)+sqr(x2));
 if d1<d2 then writeln(' A ')
 else if d1>d2 then writeln(' B ')
 else writeln('');
end.

18.       3

var x1,y1,x2,y2,x3,y3,a,b,c,p,s:real;
begin
 writeln(' A(X1,Y1), B(X2,Y2)  C(X3,Y3)');
 readln( x1,y1,x2,y2,x3,y3 );
 c:=sqrt(sqr(y1-y2)+sqr(x1-x2));
 a:=sqrt(sqr(y2-y3)+sqr(x2-x3));
 b:=sqrt(sqr(y1-y3)+sqr(x1-x3));
 p:=(a+b+c)/2;
 s:=p*sqrt((p-a)*(p-b)*(p-c));
 writeln('  = ',s);
end.

19.       M(x,y) O(Xc,Yc) R

var xc,yc,mx,my,d,r:real;
begin
 writeln(' M(X,Y), O(Xc,Yc)  R');
 readln( mx,my,xc,yc,r );
 d:=sqrt(sqr(xc-mx)+sqr(yc-my));
 if d<=r then writeln (' M   ')
 else writeln (' M   ');
end.

20.      

var a : longint;
 
function DEC_BIN(x:longint):string;
const digits:array [0..1] of char = ('0','1');
var res:string; d:0..1;
begin
 res:='';
 while (x<>0) do begin
 d:=x mod 2; res:=digits[d]+res;
 x:=x div 2;
 end;
 DEC_BIN:=res;
end;
 
begin {   }
 readln( a );
 writeln( DEC_BIN(a) );
end.

21.      

var a : string;
 
function BIN_DEC(x:string):longint;
const digits:array [0..1] of char = ('0','1');
var res,ves:longint; i,j:byte;
begin
 res:=0; ves:=1;
 for i:=length(x) downto 1 do begin
 j:=0;
 while (digits[j]<>x[i]) do inc(j);
 res:=res+ves*j;
 ves:=ves*2;
 end;
 BIN_DEC:=res;
end;
 
begin {   }
 readln( a );
 writeln( BIN_DEC(a) );
end.

22.      

var a : longint;
 
function DEC_HEX(x:longint):string;
const digits:array [0..15] of char = ('0','1','2','3','4','5','6','7',
 '8','9','A','B','C','D','E','F');
var res:string; d:0..15;
begin
 res:='';
 while (x<>0) do begin
 d:=x mod 16;
 x:=x div 16;
 res:=digits[d]+res;
 end;
 DEC_HEX:=res;
end;
 
begin {   }
 readln( a );
 writeln( DEC_HEX(a) );
end.

23.      

var a : string;
 
function HEX_DEC(x:string):longint;
const digits:array [0..15] of char =
 ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var res,ves:longint; i,j:byte;
begin
 res:=0; ves:=1;
 for i:=length(x) downto 1 do begin
 j:=0; a[i]:=UpCase(a[i]);
 while (digits[j]<>x[i]) do inc(j);
 res:=res+ves*j;
 ves:=ves*16;
 end;
 HEX_DEC:=res;
end;
 
begin {   }
 readln( a );
 writeln( HEX_DEC(a) );
end.

24.      

var a,b:longint;
 
function NOD(x,y:longint):longint; {   . .  }
begin
 if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y;
end;
 
function NOK(x,y:longint):longint; {   . .  }
begin
 NOK:=( x div NOD(x,y) ) * y;
end;
 
begin {   }
 readln(a,b);
 writeln( '   = ', NOD(a,b) );
 writeln( '   = ', NOK(a,b) );
end.

var n:integer;
 
function f(x:integer):longint;
begin
 if x = 1 then f := 1 else f := x * f(x-1);
end;
 
begin
 writeln(' N (N=1..13)');
 readln(n);
 writeln('N!=',f(n));
end.

const n = 3; {    }
var a:array[1..n] of integer;
 index : integer;
 
procedure generate (l,r:integer);
var i,v:integer;
begin
 if (l=r) then begin
 for i:=1 to n do write(a[i],' ');
 writeln;
 end else begin
 for i := l to r do begin
 v:=a[l]; a[l]:=a[i]; a[i]:=v; { a[i],a[j]}
 generate(l+1,r); {  }
 v:=a[l]; a[l]:=a[i]; a[i]:=v; { a[i],a[j]}
 end;
 end;
end;
 
begin
 for index := 1 to N do A[index]:=index;
 generate( 1,n );
end.

{ ----------------------------------------------------------------------- }
{  . }
{  I=1  J=N.   A[I]  A[J].  }
{ A[I]<=A[J],   J  1     - }
{  A[I]  A[J].    J   - }
{   A[I]  A[J]    ,   }
{  A[I] <= A[J].   A[I]   A[J],  - }
{   A[I]  A[J],   I  1   - }
{   A[I]  A[J].    I  }
{  ( A[I]  A[J])    ,  - }
{   A[I] <= A[J].   A[I]   A[J],  }
{    A[I]  A[J],    J. }
{   J   I,    - }
{ ,    ,    , }
{   I=J.      }
{     ,     -   }
{ ,     -   . }
{      ,   }
{   ..  ,   A   - }
{ . }
{    " "  - }
{      (). }
{ ----------------------------------------------------------------------- }
 
var a:array[1..10] of integer; {   }
 n:integer;
 
procedure QuickSort( L, R : Integer ); {    A[] }
var i,j,x,y : integer;
begin
 i := l; j := r;
 x := a[(l+r) div 2];
 repeat
 while (A[i]<x) do inc(i);
 while (x<A[j]) do dec(j);
 if ( i<=j ) then
 begin
 y:=A[i]; a[i]:=a[j]; a[j]:=y;
 inc(i); dec(j);
 end;
 until (i>j);
 if (l<j) then QuickSort(l,j);
 if (i<r) then QuickSort(i,r);
end;
 
begin
 writeln(' 10  :');
 for n:=1 to 10 do readln(a[n]);
 QuickSort( 1, 10 ); {  :      }
 writeln(' :');
 for n:=1 to 10 do writeln(a[n]);
end.

25.       2-

{ ------------------------------------------------------------------------ }
{   ࠠ }
{ |a1*x + b1*y = c1 }
{ |a2*x + b2*y = c2 }
{ }
{  : }
{ |c1 b1| |a1 c1| }
{ |c2 b2| |a2 c2| }
{ x = --------- y = --------- }
{ |a1 b1| |a1 b1| }
{ |a2 b2| |a2 b2| }
{ }
{    : }
{ x = (c1*b2-c2*b1)/(a1*b2-a2*b1) }
{ y = (a1*c2-a2*c1)/(a1*b2-a2*b1) }
{ ------------------------------------------------------------------------ }
var a1,a2,b1,b2,c1,c2,x,y,d,dx,dy:real;
begin
 writeln('  : a1,b1,c1,a2,b2,c2');
 readln(a1,b1,c1,a2,b2,c2);
 d := (a1*b2-a2*b1);
 dx := (c1*b2-c2*b1);
 dy := (a1*c2-a2*c1);
 if ( d=0 ) and ( (dx=0) or (dy=0) ) then
 writeln('  ')
 else if ( d<>0 ) and ( (dx=0) or (dy=0) ) then
 writeln(' ')
 else begin
 x:=dx/d; y:=dy/d;
 writeln('x = ', x); writeln('y = ', y);
 end;
end.

26.       3-

{ ------------------------------------------------------------------------ }
{   : }
{ |a1*x + b1*y + c1*z = d1| }
{ |a2*x + b2*y + c2*z = d2| }
{ |a3*x + b3*y + c3*z = d3| }
{ }
{  : }
{ |d1 b1 c1| |a1 d1 c1| |a1 b1 d1| }
{ |d2 b2 c2| |a2 d2 c2| |a2 b2 d2| }
{ |d3 b3 c3| |a3 d3 c3| |a3 b3 d3| }
{ x = ---------- y = ---------- z = ---------- }
{ |a1 b1 c1| |a1 b1 c1| |a1 b1 c1| }
{ |a2 b2 c2| |a2 b2 c2| |a2 b2 c2| }
{ |a3 b3 c3| |a3 b3 c3| |a3 b3 c3| }
{ }
{    : }
{ e := (a1*b2*c3+b1*c2*a3+c1*a2*b3-a3*b2*c1-b3*c2*a1-c3*a2*b1); }
{ ex := (d1*b2*c3+b1*c2*d3+c1*d2*b3-d3*b2*c1-b3*c2*d1-c3*d2*b1); }
{ ey := (a1*d2*c3+d1*c2*a3+c1*a2*d3-a3*d2*c1-d3*c2*a1-c3*a2*d1); }
{ ez := (a1*b2*d3+b1*d2*a3+d1*a2*b3-a3*b2*d1-b3*d2*a1-d3*a2*b1); }
{ x = ex/e }
{ y = ey/e }
{ z = ez/e }
{ ------------------------------------------------------------------------ }
var a1,a2,a3,b1,b2,b3,c1,c2,c3,d1,d2,d3,x,y,z,e,ex,ey,ez:real;
begin
 writeln('  :a1,b1,c1,d1,a2,b2,c2,d2,a3,b3,c3,d3');
 readln(a1,b1,c1,d1,a2,b2,c2,d2,a3,b3,c3,d3);
 e := (a1*b2*c3+b1*c2*a3+c1*a2*b3-a3*b2*c1-b3*c2*a1-c3*a2*b1);
 ex := (d1*b2*c3+b1*c2*d3+c1*d2*b3-d3*b2*c1-b3*c2*d1-c3*d2*b1);
 ey := (a1*d2*c3+d1*c2*a3+c1*a2*d3-a3*d2*c1-d3*c2*a1-c3*a2*d1);
 ez := (a1*b2*d3+b1*d2*a3+d1*a2*b3-a3*b2*d1-b3*d2*a1-d3*a2*b1);
 if ( e=0 ) and ( (ex=0) or (ey=0) or (ez=0) ) then
 writeln('  ')
 else if ( e<>0 ) and ( (ex=0) or (ey=0) or (ez=0) ) then
 writeln(' ')
 else begin
 x:=ex/e; y:=ey/e; z:=ez/e;
 writeln('x = ', x); writeln('y = ', y); writeln('z = ', z);
 end;
end.

27.      

2 ?

{ ------------------------------------------------------------------------ }
{    A(ax1,ay1,ax2,ay2)  B (bx1,by1,bx2,by2),}
{   TRUE -   ,    }
{      ,  FALSE () }
{ ------------------------------------------------------------------------ }
function Intersection(ax1,ay1,ax2,ay2,bx1,by1,bx2,by2:real):boolean;
var v1,v2,v3,v4:real;
begin
 v1:=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1);
 v2:=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1);
 v3:=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1);
 v4:=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1);
 Intersection:=(v1*v2<0) and (v3*v4<0);
end;
 
begin {  ,   -  }
 writeln(Intersection(1,1,5,5,1,2,3,1)); {test1, yes Intersection}
 writeln(Intersection(1,1,5,5,1,2,1,3)); {test2, no Intersection}
end.

?

{ ------------------------------------------------------------------------ }
{     (  ) - TRUE,   - FALSE }
{ tx,ty -  ࠠ }
{ x1,y1,x2,y2 -    ࠠ }
{ px,py -   蠠 }
{ }
{ ------------------------------------------------------------------------ }
 
{  , 1 -  , -1 - , 0 - 0 }
function sign(r:real):integer;
begin
 sign:=0; if r=0 then exit;
 if r<0 then sign:=-1 else sign:=1;
end;
 
function InsideSector(tx,ty,x1,y1,x2,y2,px,py:real):boolean;
var x,y,a1,a2,b1,b2,c1,c2:real;
var i1,i2,i3,i4:integer;
begin
 x:=(tx+x1+x2)/3; y:=(ty+y1+y2)/3;
 a1:=ty-y1; b1:=x1-tx; c1:=tx*y1-ty*x1;
 a2:=ty-y2; b2:=x2-tx; c2:=tx*y2-ty*x2;
 i1:=sign(a1*x+b1*y+c1); i2:=sign(a2*x+b2*y+b2);
 i3:=sign(a1*px+b1*py+c1); i4:=sign(a2*px+b2*py+c2);
 InsideSector:=((i1=i3) and (i2=i4)) or
 ((i1=0) and (i2=i4)) or
 ((i1=i3) and (i2=0));
end;
begin {  ,   -  }
 writeln(InsideSector(1,1,5,1,1,5,3,3)); {test1, yes Inside}
 writeln(InsideSector(1,1,5,1,7,2,3,3)); {test2, no Intersection}
end.

?

{ ------------------------------------------------------------------------ }
{  vector(a)  vector(b) -  a  b , : }
{ }
{ vector(a)*vector(b) = ax*by - ay*bx = a*b*sin(beta-alfa) }
{ ax,ay,bx,by -   ⠠ }
{ a -   a }
{ b -   b }
{ alfa -     a }
{ beta -     b }
{ }
{ :          }
{  ,       , }
{   ,  . }
{ }
{    ,  ,      }
{       : }
{ ,   A   B }
{ |AB| = |B| - |A|,   AB_x = Bx-Ax, AB_y= By-Ay}
{ }
{  , : }
{    |AB|,   ax,ay,bx,by   px,py, }
{           ,    }
{ : }
{ (bx-ax)*(py-ay)-(by-ay)*(px-ax) }
{ ------------------------------------------------------------------------ }
 
var i:integer;
 
(*      ࠠ *)
Function WherePoint(ax,ay,bx,by,px,py:real):integer;
var s :real;
begin
 s:=(bx-ax)*(py-ay)-(by-ay)*(px-ax);
 if s>0 then WherePoint:=1
 else if s<0 then WherePoint:=-1
 else WherePoint:=0;
end;
 
Begin (*    *)
 i:=WherePoint(1,1,8,8,2,5);
 if i > 0 then writeln('   ')
 else if i < 0 then writeln('   ')
 else writeln(' ,      ');
End.

? 1

{ ------------------------------------------------------------------------ }
{ :     . }
{       ,   蠠 }
{ ------------------------------------------------------------------------ }
 
(*      ࠠ *)
Function WherePoint(ax,ay,bx,by,px,py:real):integer;
var s :real;
begin
 s:=(bx-ax)*(py-ay)-(by-ay)*(px-ax);
 if s>0 then WherePoint:=1
 else if s<0 then WherePoint:=-1
 else WherePoint:=0;
end;
 
(*     :    *)
Function PointInsideTreangle(ax,ay,bx,by,cx,cy,px,py:real):boolean;
var s1,s2,s3 :integer;
begin
 PointInsideTreangle:=FALSE;
 s1:=WherePoint(ax,ay,bx,by,px,py);
 s2:=WherePoint(bx,by,cx,cy,px,py);
 if s2*s1<=0 then EXIT;
 s3:=WherePoint(cx,cy,ax,ay,px,py);
 if s3*s2<=0 then EXIT;
 PointInsideTreangle:=TRUE;
end;
 
Begin (*    *)
 writeln(PointInsideTreangle(1,1,8,1,1,8,2,2)); {TEST1, Inside}
 writeln(PointInsideTreangle(1,1,8,1,1,8,6,6)); {TEST2, Outside}
End.

? 2

{ ------------------------------------------------------------------------ }
{ :    ABC   P.   ABC   }
{   ABP,BCP,CAP,    . }
{ ------------------------------------------------------------------------ }
 
(*      *)
Function Distance(ax,ay,bx,by:real):real;
begin
 Distance := sqrt(sqr(ax-bx)+sqr(ay-by));
end;
 
(*        *)
Function SqrGeron(ax,ay,bx,by,cx,cy:real):real;
var p,a,b,c :real;
Begin
 a:=Distance(cx,cy,bx,by);
 b:=Distance(ax,ay,cx,cy);
 c:=Distance(ax,ay,bx,by);
 p:=(a+b+c)/2;
 SqrGeron:=sqrt(p*(p-a)*(p-b)*(p-c));
End;
 
(*     :    *)
Function PointInsideTreangle(ax,ay,bx,by,cx,cy,px,py:real):boolean;
const error = 1.000001;
var s,s1,s2,s3 :real;
begin
 PointInsideTreangle:=TRUE;
 s :=SqrGeron(ax,ay,bx,by,cx,cy);
 s1:=SqrGeron(ax,ay,bx,by,px,py);
 s2:=SqrGeron(bx,by,cx,cy,px,py);
 s3:=SqrGeron(cx,cy,ax,ay,px,py);
 if s*error>s1+s2+s3 then PointInsideTreangle:=TRUE
 else PointInsideTreangle:=FALSE;
end;
 
Begin (*    *)
 writeln(PointInsideTreangle(1,1,8,1,1,8,2,2)); {TEST1, Inside}
 writeln(PointInsideTreangle(1,1,8,1,1,8,6,6)); {TEST2, Outside}
End.

28.      

{ ------------------------------------------------------------------------ }
var sr,sf,ss:string;
 
function BinAdd(s1,s2:string):string;
var s:string; l,i,d,carry:byte;
begin
 {   }
 if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2
 else while length(s1)<length(s2) do s1:='0'+s1;
 l:=length(s1);
 s:=''; carry:=0;
 for i:=l downto 1 do begin
 d := (ord(s1[i])-ord('0')) + (ord(s2[i])-ord('0')) + carry;
 carry := d div 2;
 d:=d mod 2;
 s:=char(d+ord('0')) + s;
 end;
 if carry<>0 then s:='1'+s;
 BinAdd:=s;
end;
 
begin
 writeln(' 1-  :');
 readln(sf);
 writeln(' 2-  :');
 readln(ss);
 sr:=BinAdd(sf,ss);
 writeln('  = ',sr);
end.

{ ------------------------------------------------------------------------ }
var sr,sf,ss:string;
 
{   ,     >=  }
function BinSub(s1,s2:string):string;
var s:string; l,i,j:byte;
begin
 {   }
 if length(s1)>length(s2) then while length(s2)<length(s1) do s2:='0'+s2
 else while length(s1)<length(s2) do s1:='0'+s1;
 
 l:=length(s1); {  }
 s:='';
 for i:=l downto 1 do begin
 case s1[i] of
 '1': if s2[i]='0' then s:='1'+s else s:='0'+s;
 '0': if s2[i]='0' then s:='0'+s else begin
 s:='1'+s;
 if (s1[i-1]='1') then s1[i-1]:='0' else begin
 j:=1;
 while (i-j>0) and (s1[i-j]='0') do begin
 s1[i-j]:='1';
 inc(j);
 end;
 s1[i-j]:='0';
 end;
 end;
 end;
 end;
 {  }
 while (length(s)>1) and (s[1]='0') do delete(s,1,1);
 BinSub:=s;
end;
 
begin
 writeln(' 1-  :');
 readln(sf);
 writeln(' 2-  :');
 readln(ss);
 sr:=BinSub(sf,ss);
 writeln('  = ',sr);
end.

 

1 ()

var x,y:integer;
 
function Degree(a,b:integer):longint;
var r:longint;
begin
 r:=1;
 while b>0 do begin
 r:=r*a;
 b:=b-1;
 end;
 Degree:=r;
end;
 
begin
 writeln('   ( )  ');
 readln(x,y);
 writeln(Degree(x,y)); { print x^y }
end.

 

2 ( )

var x,y:integer;
 
function Degree(a,b:integer):longint;
var r:longint; c:integer;
begin
 r:=1; c:=a;
 while b>0 do begin
 if odd(b) then begin
 r:=r*c;
 dec(b);
 end else begin
 c:=c*c;
 b:=b div 2;
 end;
 end;
 Degree:=r;
end;
 
begin
 writeln('   ( )  ');
 readln(x,y);
 writeln(Degree(x,y)); { print x^y }
end.

{       ROW. }
{     10000 ⠠ }
{ ------------------------------------------------------------------------ }
{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
uses crt;
var {-------- use calc factorial ---------}
 row : array[1..20000] of byte;
 col : array[1..10000] of byte;
 nr,nc,dp : integer;
 c : char;
 
procedure PrintResult;
begin
 write('         = ');
 while (dp<=high(row)) do begin
 write(char(row[dp]+ord('0')));
 inc(dp);
 end;
 writeln;
end;
 

29.       -, ROW - 1 , COL - 2

{     ROW }
procedure Multiplying;
var i,j,cr,cc:integer;
 carry,sum:longint;
begin
 dp:=high(row); cr:=nr; cc:=nc;
 carry := 0;
 while (cc>0) do begin
 i:=cr; j:=cc; sum:=carry;
 while (i<=nr) and (j>=1) do begin
 sum:=sum+row[i]*col[j];
 inc(i); dec(j);
 end;
 row[dp]:=sum mod 10; dec(dp);
 carry:=sum div 10;
 if cr>1 then dec(cr) else dec(cc);
 end;
 while (carry<>0) do begin
 row[dp]:=carry mod 10;
 carry:=carry div 10;
 dec(dp);
 end;
 inc(dp);
end;
 
begin
 { -}
 fillchar(row,sizeof(row),0); fillchar(col,sizeof(col),0);
 {  1- }
 writeln(' 1-  :');
 c:=#0;
 while NOT(c in ['0'..'9']) do c:=readkey;
 nr:=0;
 while (c in ['0'..'9']) do begin
 write(c);
 inc(nr); row[nr]:=ord(c)-ord('0');
 c:=readkey;
 end;
 writeln;
 {  2- }
 writeln(' 2-  :');
 while NOT(c in ['0'..'9']) do c:=readkey;
 nc:=0;
 while (c in ['0'..'9']) do begin
 write(c);
 inc(nc); col[nc]:=ord(c)-ord('0');
 c:=readkey;
 end;
 writeln;
 {  ,  -    }
 Multiplying; PrintResult;
end.

30.       . ( )

{--------------------------------------------------------------------------}
{ :        - "" }
{--------------------------------------------------------------------------}
 
var s:string;
 i,key:integer;
begin
 writeln(' '); readln(s);
 writeln('  (  1  255)'); readln(key);
 for i:=1 to length(s) do s[i]:=char( ord(s[i]) + key );
 writeln(' : ',s);
end.

31.      

{--------------------------------------------------------------------------}
{   - ,   -    堠 }
{--------------------------------------------------------------------------}
const Alpha : set of char=['A'..'Z',''..'',''..'','a'..'z',''..'',''..''];
var s:string;
 i:integer;
 wc:integer;
begin
 writeln(' '); readln(s);
 i:=1; wc:=0;
 Repeat
 while NOT(s[i] in Alpha) and (i<=length(s)) do inc(i);
 if (i<=length(s)) then inc(wc);
 while (s[i] in Alpha) and (i<=length(s)) do inc(i);
 Until (i>length(s));
 writeln('     = ',wc);
end.

{--------------------------------------------------------------------------}
{   - ,   -  ⠠ }
{--------------------------------------------------------------------------}
const Alpha : set of char=['A'..'Z',''..'',''..'','a'..'z',''..'',''..''];
var s,t:string;
 i:integer;
begin
 writeln(' '); readln(s);
 writeln('   :');
 i:=1;
 Repeat
 while NOT(s[i] in Alpha) and (i<=length(s)) do inc(i);
 t:='';
 while (s[i] in Alpha) and (i<=length(s)) do begin
 t:=t+s[i];
 inc(i);
 end;
 if length(t)<>0 then writeln(t);
 Until (i>length(s));
end.

{--------------------------------------------------------------------------}
{   - ,   -  렠 }
{--------------------------------------------------------------------------}
const Digits : set of char=['0'..'9'];
var s,d:string;
 i:integer;
begin
 writeln(' ,     :'); readln(s);
 writeln('   :');
 i:=1;
 Repeat
 while NOT(s[i] in Digits) and (i<=length(s)) do inc(i);
 d:='';
 while (s[i] in Digits) and (i<=length(s)) do begin
 d:=d+s[i];
 inc(i);
 end;
 if length(d)<>0 then writeln(d);
 Until (i>length(s));
end.

{--------------------------------------------------------------------------}
{   -    (     }
{--------------------------------------------------------------------------}
uses crt;
const ENTER=#13;
var c:char;
 
begin
 writeln('   ');
 c:=readkey;
 while (c<>ENTER) do begin
 if c in ['0'..'9'] then write(c);
 c:=readkey;
 end;
 writeln;
end.

( )

{--------------------------------------------------------------------------}
{   - ,   -    ⠠ }
{--------------------------------------------------------------------------}
var s:string;
 
function SmallAlpha(ps:string):string;
var i:integer;
begin
 for i:=1 to length(ps) do begin
 case ps[i] of
 'A'..'Z',''..'': inc(ps[i],32);
 ''..'' : inc(ps[i],80);
 end;
 end;
 SmallAlpha:=ps;
end;
 
begin
 writeln('  '); readln(s);
 writeln('    :');
 writeln(SmallAlpha(s));
end.

( )

{--------------------------------------------------------------------------}
{   - ,   -    ⠠ }
{--------------------------------------------------------------------------}
var s:string;
 
function BigAlpha(ps:string):string;
var i:integer;
begin
 for i:=1 to length(ps) do begin
 case ps[i] of
 'a'..'z',''..'': dec(ps[i],32);
 ''..'' : dec(ps[i],80);
 end;
 end;
 BigAlpha:=ps;
end;
 
begin
 writeln('  '); readln(s);
 writeln('    :');
 writeln(BigAlpha(s));
end.

{...}

{--------------------------------------------------------------------------}
{   -   ,   -   ⠠ }
{--------------------------------------------------------------------------}
var s,r:string;
 state,i:integer;
begin
 writeln('    '); readln(s);
 r:=''; state:=0; { }
 for i:=1 to length(s) do begin
 case s[i] of
 '{': if state=0 then state:=1; {   }
 '}': if state=1 then state:=0 {    }
 else r:=r+s[i]; {   }
 else if state=0 then r:=r+s[i]; {   }
 end;
 end;
 writeln(' :'); writeln(r);
end.

32.       -:

{--------------------------------------------------------------------------}
{  "". (..) }
{    "".  - , - }
{ , "".   "",     , }
{       "".    "". - }
{      ""  ..    }
{ .   ,      }
{ (  )    . }
{ }
{  :  TOWN.IN  1-      }
{ .     (   )   }
{  (    - ). }
{ }
{  : 1-  TOWN.OUT    - }
{ .       , ..  ( }
{   )   ,    . }
{ }
{ :        20. }
{   - 2 . (Pentium) }
{ }
{ : }
{ ┌──────── TOWN.IN ──────────────┬─────────── TOWN.OUT ───────────────┐ }
{ │5 │5 │ }
{ │ʠ │ │ }
{ │͠ │͠ │ }
{ │ │ʠ │ }
{ │Р │  │ }
{ │  │Р │ }
{ └───────────────────────────────┴────────────────────────────────────┘ }
{--------------------------------------------------------------------------} 
{$M $8000,0,$1FFFF}
program towns; { "".  .,  }
const mnt = 20; {      }
var list,chain,store :array [1..mnt] of string; {     }
 numin :integer; {      }
 pc :integer; {     }
 ml :integer; {    }
 sym :char; {     }
 
procedure read_data; {      }
var i : integer;
begin
 pc:=0; ml:=0; numin:=0;
 assign(input,'TOWN.IN'); reset(input);
 fillchar(chain,sizeof(chain),0);
 readln(numin);
 if (numin>mnt) then numin:=mnt;
 for i:=1 to numin do readln(list[i]);
 close(input);
end;
procedure write_results; {     }
var i : integer;
begin
 assign(output,'TOWN.OUT'); rewrite(output);
 writeln(ml);
 if (ml>0) then begin
 for i:=1 to ml do writeln(store[i]);
 end;
 close(output);
end;
procedure store_chain; {      }
var i:integer;
begin
 if (pc>ml) then begin
 store:=chain;
 ml:=pc;
 end;
end;
{     1- , 0 -    }
function find_next_item( c:char; n:integer ):integer;
var i:integer;
begin
 i:=1; find_next_item:=0;
 while (i<=numin) and (n>0) do begin
 if (list[i][1]=c) then dec(n);
 inc(i);
 end;
 if (n=0) then find_next_item:=pred(i);
end;
{   . }
procedure build_chain( c:char; n:integer ); { :   . }
var i:integer; {   "back-tracking" }
begin
 i:=find_next_item(c,n);
 if (i>0) then begin
 inc(pc); chain[pc]:=list[i]; list[i][1]:='X'; {  }
 build_chain(list[i][length(list[i])], 1);
 dec(pc); list[i][1]:=c; {  }
 build_chain(c, n+1);
 end else store_chain;
end;
 
begin
 read_data;
 for sym:='' to '' do build_chain(sym,1);
 write_results;
end.

33.       -

. OUTPUT.TXT

{--------------------------------------------------------------------------} 
{$G+}
const wb=8; nb=wb*wb;
 s:array[1..8,1..2] of integer =
 ((-2,1),(-1,2),(1,2),(2,1),(2,-1),(1,-2),(-1,-2),(-2,-1));
 
var b: array[1..wb,1..wb] of boolean;
 m: array[1..nb,1..2] of integer;
 p: integer;
 
procedure PrintAndExit;
var i:integer;
begin
 assign(output,'output.txt'); rewrite(output);
 for i:=1 to nb-1 do write(m[i,1],':',m[i,2],',');
 writeln(m[nb,1],':',m[nb,2]); halt;
end;
 
procedure Solution(r,c:integer);
var d,i,j:integer;
begin
 if (p>pred(nb)) then PrintAndExit;
 for d:=1 to 8 do begin
 i:=r+s[d,1]; j:=c+s[d,2];
 if NOT(i in[1..wb]) or NOT(j in[1..wb]) or (b[i,j]) then continue;
 inc( p );
 m[p,1]:=i; m[p,2]:=j; b[i,j]:=true;
 Solution( i,j );
 dec( p );
 b[i,j]:=false;
 end;
end;
 
var i,j:integer;
begin
 fillchar(b,sizeof(b),false);
 for i:=1 to wb div 2 do
 for j:=1 to wb div 2 do begin
 p:=1; m[p,1]:=i; m[p,2]:=j; b[i,j]:=true;
 Solution(i,j);
 b[i,j]:=false;
 end;
end.

{   n:m,   0  1. 1 -  , 0 - . }
{       is,js ()   ie, je }
{ (). }
{ }
{   LAB.IN : }
{ 1-  -   }
{ 2-  -    (row,col) }
{ 3-  -    (row,col) }
{ 4-    -    0  1 }
{ : }
{ 10 10 }
{ 2 10 }
{ 1 6 }
{ 1 1 1 1 1 0 1 1 1 1 }
{ 1 0 0 0 0 0 1 0 1 0 }
{ 1 0 1 1 1 1 1 0 1 0 }
{ 1 0 1 0 1 0 0 0 1 0 }
{ 1 0 1 0 1 0 0 0 1 0 }
{ 0 0 1 0 1 0 0 0 1 0 }
{ 0 0 1 0 1 1 1 1 1 0 }
{ 1 0 0 1 0 1 0 0 0 0 }
{ 1 1 0 0 0 0 0 1 0 0 }
{ 1 1 1 1 1 1 1 1 1 1 }
{ }
{   LAB.OUT    (i1:j1 ... in:jn): }
{ 1:10 }
{ 2:10 }
{ 3:10 }
{ .... }
{--------------------------------------------------------------------------} 
const LN = 50; LM = 50;
var a:array[1..LN,1..LM] of byte;
 p:array[1..LN*LM,1..2] of byte;
 s:array[1..LN*LM,1..2] of byte;
 n,m,si,sj,ei,ej,index,min:integer;
 
procedure INIT;
var i,j:integer;
begin
 assign(input,'lab.in'); reset(input);
 assign(output,'lab.out'); rewrite(output);
 readln(n,m);
 readln(si,sj);
 readln(ei,ej);
 for i:=1 to n do begin
 for j:=1 to n-1 do begin
 read(a[i,j]);
 end;
 readln(a[i,n]);
 end;
 index:=0; min:=ln*lm;
end;
 
procedure Store;
begin
 if (min > index) then begin
 move( p, s, sizeof(p) );
 min:=index;
 end;
end;
 
procedure DONE;
var i:integer;
begin
 for i:=1 to min do writeln(s[i,1],':',s[i,2]);
end;
 
procedure FindPath(i,j:integer);
begin
 a[i,j]:=2;
 inc(index);
 p[index,1]:=i; p[index,2]:=j;
 if (i=ei) and (j=ej) then begin
 Store;
 end else begin
 if (i>1) and (a[i-1,j]=0) then FindPath(i-1,j);
 if (i<n) and (a[i+1,j]=0) then FindPath(i+1,j);
 if (j>1) and (a[i,j-1]=0) then FindPath(i,j-1);
 if (j<m) and (a[i,j+1]=0) then FindPath(i,j+1);
 end;
 dec(index);
 a[i,j]:=0;
end;
 
begin
 INIT;
 FindPath(si,sj);
 DONE;
end.

{--------------------------------------------------------------------------} 
{   N      (1<=N<=28). }
{    ,     N    }
{ ,          }
{ . }
{ }
{  :     "D.IN"    }
{  . 1-  -  . }
{ 2-    -    (  }
{ ).      ,   頠 }
{ .       . }
{  :       "D.OUT".}
{ 1-      . 2- ࠠ }
{    ,    ()   }
{   , ,       }
{ . }
{   :   : }
{ 5 5 }
{ 1 2 56:62:21:13:36 }
{ 1 3 }
{ 2 6 }
{ 3 6 }
{ 5 6 }
{--------------------------------------------------------------------------} 
 
{  "", : .,  }
{$M $C000,0,650000}
const max = 28;
 maxtime = 60;
 tl :longint = (maxtime*18); {   60  }
 yes :boolean = false; { ,      n}
var m :array [0..6,0..6] of boolean;
 n :byte; {-   , 1..28}
 cep,best :array [1..max*2] of byte; { / }
 p,maxlen :integer; {    / .. }
 jiffy :longint absolute $0040:$006C; { ,   }
 
procedure ReadData; {      }
var i,a,b : byte;
begin
 tl:=jiffy + tl;
 p:=1; maxlen:=0;
 assign(input,'d.in'); reset(input);
 fillchar(cep,sizeof(cep),0);
 fillchar(m,sizeof(m),false);
 readln(n);
 for i:=1 to n do begin
 readln(a,b);
 m[a,b]:=true; m[b,a]:=true;
 end;
 close(input);
end;
 
procedure WriteResults; {   }
var i : integer;
begin
 assign(output,'d.out'); rewrite(output);
 writeln(maxlen div 2);
 if (maxlen>1) then begin
 i:=1;
 while (i<pred(maxlen)) do begin
 write(best[i],best[i+1],':');
 inc(i,2);
 end;
 write(best[pred(maxlen)],best[maxlen]);
 end;
 close(output);
end;
{       best }
procedure s_cep;
begin
 if (p-1>maxlen) then begin
 move(cep,best,p-1);
 maxlen:=p-1;
 yes:=(maxlen div 2=n);
 end;
end;
{     ? }
function exist(k:integer):boolean;
var i : integer;
begin
 i:=0; while (i<=6) and not(m[k,i]) do inc(i);
 exist:=(i<=6);
end;
{   }
procedure make_cep(f:integer);
var s:integer;
begin
 if (yes) or (tl-jiffy<=0) then exit; { ?}
 if (m[f,f]) then begin {   }
 m[f,f]:=false; {   }
 cep[p]:=f; cep[succ(p)]:=f; inc(p,2); {  - }
 if exist(f) then make_cep(f) else s_cep;
 dec(p,2);
 m[f,f]:=true; {   }
 end else
 for s:=0 to 6 do { -}
 if (m[f,s]) then begin
 m[f,s]:=false; m[s,f]:=false; {   }
 cep[p]:=f; cep[succ(p)]:=s; inc(p,2);
 if exist(s) then make_cep(s) else s_cep;
 dec(p,2);
 m[f,s]:=true; m[s,f]:=true; {   }
 end;
end;
 
var i:integer;
begin
 ReadData;
 for i:=0 to 6 do make_cep(i);
 WriteResults;
end.

{--------------------------------------------------------------------------}
{     (  ࠠ }
{  1  1000). -    . }
{      (  ) 頠 }
{ ,     .   }
{       󠠠 }
{     -.  , }
{           }
{    . }
{ }
{  :  SEQ.IN  1-     ⠠ }
{  - N (1<=N<=100). }
{  2-      ,    ࠠ }
{  .      ,  堠 }
{ . }
{ }
{  : }
{   SEQ.OUT   . }
{ 1-      . }
{ 2-    -   ,   ⠠ }
{      . }
{ }
{   : }
{ }
{  "SEQ.IN"  "SEQ.OUT" }
{ 12 7 }
{ 59 4 }
{ 4 21 }
{ 21 27 }
{ 36 34 }
{ 18 45 }
{ 27 47 }
{ 79 93 }
{ 34 }
{ 45 }
{ 47 }
{ 34 }
{ 93 }
{--------------------------------------------------------------------------}
 
{$M $8000,0,$4ffff} (* ,  *)
Const MaxItem = 100;
 TimeLimit = 29*18; {29 sec}
 
var Numbers, Seq, Best: array[1..MaxItem] of integer;
 pc,maxpc,num:integer;
 timer:longint absolute $0040:$006C;
 jiffy:longint;
 
Procedure Init;
var i:integer;
begin
 jiffy:=timer;
 fillchar(Numbers, Sizeof(Numbers),#0);
 Seq:=Numbers; Best:=Numbers; pc:=0; maxpc:=0;
 assign(input,'seq.in'); reset(input);
 readln(num); if num>MaxItem then num:=MaxItem;
 for i:=1 to num do readln(Numbers[i]);
 close(input);
end;
 
Procedure Done;
var i:integer;
begin
 assign(output,'seq.out'); rewrite(output);
 writeln(maxpc);
 for i:=1 to maxpc do writeln(Best[i]);
 close(output);
end;
 
procedure StoreChain;
begin
 if (pc>maxpc) then begin
 Best:=Seq;
 maxpc:=pc;
 if (maxpc=num) then begin
 Done;
 Halt(0);
 end;
 end;
end;
 
function testFWD(i:integer):integer;
var m:integer;
begin
 m:=Numbers[i]; inc(i);
 while (i<=num) and (m>Numbers[i]) do inc(i);
 if i>num then testFWD:=0 else testFWD:=i;
end;
 
procedure solution(n:integer); {   }
var i,s:integer;
begin
 if ((timer-jiffy)>TimeLimit) then exit;
 i:=testFWD(n);
 if (i=0) then begin
 StoreChain;
 end else begin
 inc(pc); {  }
 Seq[pc]:=Numbers[i];
 solution(i);
 dec(pc); {  }
 s:=Numbers[i]; Numbers[i]:=-1; {}
 solution(n);
 Numbers[i]:=s; {}
 end;
end;
 
var index:integer;
begin
 Init;
 index:=1;
 repeat
 pc:=1;
 Seq[pc]:=Numbers[index];
 solution(index);
 while (index<=num) and (Numbers[index]>=Seq[pc]) do inc(index);
 until (index>num);
 Done;
end.

{   NxN,       , ⠠ }
{ ,    ( 2)   . }
{ :        ࠠ }
{ n*n(n*n+1) div (2*n) }
{--------------------------------------------------------------------------}
const N=3; SQRN = N*N; {  NxN}
 IdealSum = N*(SQRN+1) div 2;
var a:array[1..SQRN] of byte;
 b:array[1..SQRN] of byte;
 f:boolean; recurse:longint;
 
Procedure PRINT;
var i,j:integer;
begin
 assign(output,'magic.out'); rewrite(output);
 for i:=1 to N do begin
 for j:=1 to N do write(a[pred(i)*N+j],' ');
 writeln;
 end;
end;
 
function TestRow(i:integer):boolean;
var j,s:integer;
begin
 s:=0; i:=(i-1)*n;
 for j:=1 to N do s:=s+a[i+j];
 TestRow:=(s=IdealSum);
end;
 
function TestCol(i:integer):boolean;
var j,s:integer;
begin
 s:=0;
 for j:=1 to N do s:=s+a[(j-1)*N+i];
 TestCol:=(s=IdealSum);
end;
 
function TestDiag:boolean;
var j,s:integer;
begin
 s:=0;
 for j:=1 to N do s:=s+a[(N-j)*N+j];
 TestDiag:=(s=IdealSum);
end;
 
function TestMagic:boolean; {    . . }
var srow,scol,sdiag1,sdiag2,i,j:integer;
begin
 TestMagic:=FALSE;
 sdiag1:=0; sdiag2:=0;
 for i:=1 to N do begin
 srow:=0; scol:=0;
 for j:=1 to N do begin
 srow:=srow+a[pred(i)*N+j];
 scol:=scol+a[pred(j)*N+i];
 end;
 if (srow<>scol) or (scol<>IdealSum) then EXIT;
 sdiag1:=sdiag1+a[pred(i)*N+i];
 sdiag2:=sdiag2+a[(N-i)*N+i];
 end;
 if (sdiag1<>sdiag2) or (sdiag2<>IdealSum) then EXIT;
 TestMagic:=TRUE;
end;
 
procedure SqMagic(k:integer);
var i:integer; still:boolean;
begin
 i:=1;
 while (i<=SQRN) and NOT(f) do begin
 still:=true;
 if b[i]=0 then begin
 b[i]:=1; a[k]:=i;
 if k=SQRN then begin
 if TestMagic then begin PRINT; f:=true; still:=false; end;
 end else if (k mod n=0) then begin {  }
 if NOT(TestRow(k div n)) then still:=false;
 end else if (k>SQRN-N) then begin {  }
 if NOT(TestCol(k mod n)) then still:=false;
 end else if (k=SQRN-N+1) then begin {  }
 if NOT(TestDiag) then still:=false;
 end;
 if still then SqMagic(k+1);
 b[i]:=0;
 end;
 inc(i);
 end;
end;
 
begin
 f:=false; recurse:=0;
 fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),0);
 SqMagic(1);
end.