Ïðèìåðû ïðîãðàìì íà ÿçûêå Ïàñêàëü

(Èñòî÷íèê: À.Íèêèòèí, ÒÀÑÓÐ, ÊÝÂÀ)
 

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.