{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}

program Olymp;

var
  F1,F2 : Text;                     { Файлы I/O                        }
  i     : Integer;                  { Номер билета                     }
  A     : Array [1..30000] of word; { Массив номеров мест              }
  N     : Integer;                  { Количество мест                  }
  Count : Word;                     { Кол-во зрителей поменявших места }

begin
  Assign(F1,'INPUT.TXT');  Reset(F1);
  Assign(F2,'OUTPUT.TXT'); Rewrite(F2);
  Readln(F1,N);
  for i:=1 to N do Read(F1,A[i]);   { Заполняем массив номерами        }
  Readln(F1,i);                     { Считываем номер опоздавшего      }
  Count:=0;                         { Инициализируем счетчик           }
  while A[i]<>0 do                  { Пока место занято выполнять      }
  begin                             { -------------------------------- }
     Inc(Count);                    { Увеличиваем кол-во пересаживаний }
     i:=A[i];                       { Номер следующего зрителя         }
  end;                              { -------------------------------- }
  Writeln(F2,Count);                { Записываем результаты в файл     }
  Close(F1);                        { Закрываем файлы                  }
  Close(F2);                        { -------------------------------- }
end.

program find;
uses crt;
const
  path='d:\'; {путь к "карте"}
  filename='lab1.txt';
  SizeOfArray=100; {максимальная размерность массива}
  razd='|';

label step1;

function StrToFloat(str:string):integer;
{ действует так же, как и аналогичная в Делфи }
var code,v:integer;
begin
  val(str,v,code);
  strtofloat:=v;
end;

var
  fil:text;
  str:string;
  m, { кол-во строк }
  n, { кол-во столбцов }
  kli, { клад находится в ячейке mas[kli, klj] }
  klj,
  i, j, a,
  walls {кол-во стен (искомая величина) }
  : byte;

  mas: array[1 .. sizeofarray, 1 .. sizeofarray] of byte;

procedure draw; { прорисовка массива }
begin
  for i:=1 to m do begin
    for j:=1 to n do write(mas[i,j]:3, razd);
    writeln;
  end;
end;

begin
  textcolor(white); clrscr;
  writeln('Путь файла-карты> '+path+filename);
  assign(fil,path+filename); reset(fil);
  Writeln('Данные о лабиринте> ');
  readln(fil,m);
  gotoxy(21,2); write('Строк m=',m);
  readln(fil,n);
  gotoxy(21,3); write('Столбцов n=',n);
  readln(fil,kli);
  readln(fil,klj);
  gotoxy(21,4); write('Клад находится в ячейке: ',kli,'x',klj);

  FOR i:=1 to m do begin {считываем лабиринт из файла и записываем в массив}
    readln(fil,str);
    for j:=1 to n do mas[i,j]:=StrToFloat(str[j]);
  end;
  close(fil);
  writeln;
  writeln('Карта> ');

  draw;

  { algorithm }
  step1:

  {1}
  a:=2;
  mas[1,1]:=a;
  while (a<m*n) do begin
    for i:=1 to m do
      for j:=1 to n do begin
        if mas[i,j]=0 then begin
          if mas[i+1,j]=a then mas[i,j]:=a+1;
          if mas[i-1,j]=a then mas[i,j]:=a+1;
          if mas[i,j-1]=a then mas[i,j]:=a+1;
          if mas[i,j+1]=a then mas[i,j]:=a+1;
        end;
      end;
    inc(a);
  end;
  {\1}

  {2}
  if mas[kli,klj]<=1 then begin
    for i:=1 to m do
      for j:=1 to n do
        if (mas[i,j]=1) and
           ((mas[i-1,j]>1)or(mas[i+1,j]>1)or(mas[i,j-1]>1)or(mas[i,j+1]>1)) then
        begin
          mas[i,j]:=0;
        end;
    inc(walls);
    goto step1;
  end;
  {/2}

  {/algorithm}
  writeln;
  draw;
  writeln('Клад найден! Чтобы добраться до него надо проломать ',walls,' стен.');
end.

 0| 0| 0| 0|
 0| 1| 0| 1|
 0| 1| 1| 1|
 0| 0| 1| 0|
 0| 1| 1| 0|
 0| 0| 1| 1|

 2| 3| 4| 5|
 3| 1| 5| 1|
 4| 1| 1| 1|
 5| 6| 1| 0|
 6| 1| 1| 0|
 7| 8| 1| 1|

uses crt;

function main(n:longint):longint;
var
  step,first,last:longint;
  b:boolean;
begin
  step:=2;
  first:=1;
  last:=n;
  b:=false;
  while first<>last do begin
    if b then begin
      if (last-first+step div 2) mod step=0 then last:=last-step div 2;
    end
    else begin
      if (last-first) mod step=0 then last:=last-step div 2;
      inc(first,step div 2);
    end;
    step:=step*2;
    b:=not(b);
  end;
  main:=first;
end;

begin
  clrscr;
  writeln(main(10));
  readln;
end.

program asd;
Uses
     CRT;
var
     num, count, i    :  LongInt; { <--- вместо Integer }
     st   :  String;
     by,num2, count2  :  Byte;
     ch,ch2 :  Integer;
(*______________________________ *)
     vrem   : Integer;
begin
     ClrScr;
             WriteLn('Input number:');
             ReadLn(num);

             For  count:= 12 to num-1 do
                  begin
                        Str(count,st);
                        by:= Length(st);
                        For count2:= 1 to by do
                            begin
                                 Delete(st, count2, 1);
                                 Val(st, num2,i);
                                 vrem:=num2 + count;

                                 If vrem = num then
                                    WriteLn(num2,'+',count);
                            end;
                  end;
     ReadKey;
end.

program troiki;
uses crt;
var
  c, cmax, summ, maxsumm: real;
  n,q: integer; a, amax, b, bmax: longint;
begin
  clrscr;
  write('n=');read(N);
  for a:=1 to n do begin
    for b:=1 to n do begin
      if a<b then begin { добавление этой строки уменьшит время вычисления }
        c:=sqrt(sqr( a ) + sqr( b ));
        if frac( c ) = 0 then begin
          summ:=(a+b+c);
          if summ>maxsumm then begin
            maxsumm:=summ;
            amax:=a; bmax:=b; cmax:=c;
          end;
          q:=q+1;
        end;
      end;
    end;
  end;
  writeln;
  writeln(q);
  writeln(amax,' ',bmax,' ',trunc(cmax));
  writeln(trunc(maxsumm));
  readkey;
end.

program chisla;
uses crt;
var
  i, n, i1: longint;
  s, d: string;
begin
  clrscr;
  read(n);
  for i:=1 to n do begin
    str(i,s);
    if (length(d))<=n then d:=d+s;
  end;
  writeln;
  writeln(d);
  writeln(d[n]);
  readkey;
end.

function get_digit(n: longint): char;
var
  i: longint;
  digits: byte;
  start_of, maximal: longint;
  num_of_n, num_of_digit: integer;
  s: string;
begin
  digits := 1;
  start_of := 0;

  maximal := 9;
  while n > digits * maximal + start_of do begin
    inc(digits); maximal := maximal * 10;
    inc(start_of, pred(digits) * (maximal div 10));
  end;
  maximal := maximal div 10;

  dec(n, start_of);
  num_of_n := (n div digits) + byte((n mod digits) <> 0);
  num_of_digit := n - digits * pred(num_of_n);

  n := 1;
  for i := digits downto 2 do n := n * 10;
  str(n + pred(num_of_n), s);
  get_digit := s[num_of_digit];
end;

function DigitInfo(const k: LongInt): Char;
var
  temp, curr, digit_len, digit_owner_number, digit_group: LongInt;
  digit_pred_group: LongInt;
  s: String;
begin
    digit_group := 9;
    digit_pred_group := 0;
    digit_len := 1;
    temp := 9;

    while (k > digit_group) do begin
      inc(digit_len);
      temp := 9 * digit_len * round(exp(pred(digit_len) * ln(10)));
      digit_pred_group := digit_group;
      digit_group := temp + digit_group;
    end;

    digit_owner_number := (k - digit_pred_group - 1) div digit_len + 1;
    str(round(exp((digit_len - 1) * ln(10))) + digit_owner_number - 1, s);
    DigitInfo := s[k - (digit_pred_group + digit_len * (digit_owner_number - 1) + 1) + 1];
end;

var
  k: Integer;

begin
  readln(k);
  writeln(DigitInfo(k));
end.

function GetDigit(k: integer): integer;
var counter: integer;     // счетчик натуральных чисел
    number: integer;      // текущее разбираемое число
    needNewNumber: boolean; // флаг - "завершился ли разбор числа?"
    maxDecimalMask: integer;  // максимальная маска десятичного разряда
    nextDecimalMask: integer; //  maxDecimalMask * 10
    decimalMask: integer;     // текущая маска десятичного разряда

    procedure Init;
    begin
        counter := 0;
        maxDecimalMask := 1;
        nextDecimalMask := maxDecimalMask * 10;
        needNewNumber := true;
    end;

    function GetNextDigit: integer;
    var digit: integer;
    begin
        // получаем следующее натуральное число
        if needNewNumber then begin
            needNewNumber := false;
            inc(counter);
            number := counter;
            if (counter mod nextDecimalMask) = 0 then begin
                maxDecimalMask := nextDecimalMask;
                nextDecimalMask := maxDecimalMask * 10;
            end;
            // сбрасываем маску
            decimalMask := maxDecimalMask;
        end;
        // получаем число в разряде
        digit := number div decimalMask;
        number := number mod decimalMask;
        decimalMask := decimalMask div 10;
        // если маска нулевая, то мы разобрали число
        if decimalMask = 0 then
            needNewNumber := true;
        // возвращаем результат
        GetNextDigit := digit;
    end;

var i: integer;
    digit: integer;
begin
    Init;
    // тупо перебираем k-разрядов
    digit := 0;
    for i := 1 to k do
        digit := GetNextDigit;
    // возращаем результат
    GetDigit := digit;
end;

function test (x:longint): char;
var i:longint;
s:string;
begin
i:=0;
repeat
inc (i); str (i,s);
if x<=length(s) then begin
test:=s[x]; x:=0; end else
x:=x-length(s);
until x=0;
end;

uses crt;
const
  g=100;
  h=1000;
var
  x:array [1..1000] of integer;
  y:array [1..1000] of integer;
  n,m,i,j,min,zuy:integer;
  f,f1:text;
Begin
 randomize;
 assign(f,'c.pas');
 rewrite(f);
 assign(f1,'co.pas');
 rewrite(f1);
 n:=random(g)+1;
 m:=random(g)+1;
 writeln(f,n,' ',m);
 for j:=1 to h do
 begin
  if j<=n then
  begin
   x[j]:=random(h);
   write(f,' ',x[j],' ');
  end;
 end;
 writeln(f,' ');
 for i:=1 to h do
 begin
  if i<=m then begin
  y[i]:=random(h);
  write(f,' ',y[i],' ');
  end;
 end;
 zuy:=0;
 for j:=1 to h do
 begin
  if j<=n then
  begin
   min:=abs(x[j]-y[1]);
   for i:=1 to h do
    if i<=m then
    begin
     if abs(x[j]-y[i])<min then min:=abs(x[j]-y[i]);
    end;
   zuy:=zuy+min;
  end;
 end;
 write(f1,'',zuy,' ');
 close(f);
 close(f1);
End.

program Zadacha1;
uses Crt;
var c:boolean;
    a,b:string;
 function Sovmestimost(a,b:string):boolean;
 var len1,len2,i,ii,res:integer;
     aM,bM:array [1..20] of string;
     d3:boolean;
  begin
   res:=0;
   len1:=length(a);
   len2:=length(b);
   for i:=1 to len1 do aM[i]:=copy(a,i,1);
   for i:=1 to len2 do bM[i]:=copy(b,i,1);
   for i:=1 to len2 do
    for ii:=1 to len1 do
     if bM[i]=aM[ii] then begin res:=res+1; aM[ii]:=''; bM[i]:='*' end;
   if res=len2 then d3:=true else d3:=false;
   Sovmestimost:=d3
  end;
begin
clrscr;
writeln('Vvedite pervoe slovo');
readln(a);
writeln('Vvedite vtoroe slovo');
readln(b);
if length(a)>length(b) then c:=Sovmestimost(a,b) else c:=Sovmestimost(b,a);
if c=true then writeln('YES') else writeln('NO');
readln
end.

program Zadacha2;
uses Crt;
const n=6;
type masyv=array [1..n] of integer;
var a,b:masyv;
    i,ii,x:integer;
begin
clrscr;
writeln('Vvedite 6 chusel');
for i:=1 to n do readln(a[i]);
for i:=1 to n-1 do
 for ii:=i+1 to n do
  begin
   if a[i]>a[ii] then
    begin
     x:=a[i];
     a[i]:=a[ii];
     a[ii]:=x
    end
   end;
if (a[1]+a[6]=a[2]+a[5])and(a[2]+a[5]=a[3]+a[4]) then writeln(a[1]+a[6])
 else writeln('N');
readln
end.

program zadaha3;
uses Crt;
var n,d5,k,ii:integer;
    min,max,i,control:longint;
    iText:string;
    iLetter:array [1..10] of string;
    iDigit:array [1..10] of integer;

function Stepin(x,y:integer):integer;
 var d1:integer;
     d2:integer;
  begin
   d2:=x;
   for d1:=1 to y-1 do d2:=d2*x;
   Stepin:=d2
  end;

function Minimal(n:integer):longint;
 var d3:integer;
     d4:longint;
  begin
   d4:=1;
   if n=0 then d4:=1 else for d3:=1 to n-1 do d4:=d4*10;
   Minimal:=d4
  end;


begin
 clrscr;
 writeln('Vvedite n');
 readln(n);
 min:=Minimal(n);
 max:=Minimal(n+1)-1;
 for i:=min to max do
  begin
   control:=0;
   str(i,iText);
   for ii:=1 to n do begin iLetter[ii]:=copy(iText,ii,1);
                           val(iLetter[ii],iDigit[ii],d5) end;
   for ii:=1 to n do control:=control+Stepin(iDigit[ii],n);
   if control=i then begin writeln(i); k:=k+1 end
  end;
 writeln('Vsego chusel Armstronga   ',k);
 readln
end.

uses crt;
var
  r,s,i,l,k:integer;
  d,c:array [0..25] of integer;

begin
 clrscr;

 writeln('Vvedite dlinu telefonnoqo nomera: ');
 readln(k);

 r:=0;

 for i:=1 to 10 do c[i-1]:=1;

 for l:=1 to k-1 do
  begin

   d[0]:=c[8];
   d[1]:=c[2]+c[4];
   d[2]:=c[1]+c[3]+c[5];
   d[3]:=c[6]+c[2];
   d[4]:=c[1]+c[5]+c[7];
   d[5]:=c[2]+c[4]+c[6]+c[8];
   d[6]:=c[3]+c[5]+c[9];
   d[7]:=c[4]+c[8];
   d[8]:=c[5]+c[7]+c[9]+c[0];
   d[9]:=c[6]+c[8];

   for i:=0 to 9 do c[i]:=d[i];

 end;

 for i:=0 to 9 do r:=r+c[i];

 writeln('Xod ladyey:');

 writeln( R );
 readln;

end.

program podschet;
uses crt;
const c=9;
var m,s1,s2,s3,s4,s5,s6,a,k:longint;
file1:file of longint;
begin
clrscr;
assign(file1,'c:\file1.txt');
rewrite(file1);
k:=0;
m:=0;
for s1:=0 to c do
for s2:=0 to c do
for s3:=0 to c do
for s4:=0 to c do
for s5:=0 to c do
for s6:=0 to c do
  begin
     if m<>0 then
       if (s1+s2+s3)=(s4+s5+s6) then
          begin
            a:=s1*100000+s2*10000+s3*1000+s4*100+s5*10+s6;
            write(file1,a);
            k:=k+1;
          end;
      m:=m+1;
  end;
writeln('kolichestvo biletov=',k);
close(file1);
readln;
end.

program podshet;
var start, finish, sum : longint;
begin
write ('Vvedite perviy i posledniy nomer diapasona >');
readln (start, finish);
sum := 0;
        repeat
                if (start div 100000 + start div 10000 mod 10 +
                start div 1000 mod 10) = (start div 100 mod 10 + start div 10 mod 10 +
                start mod 10)    {сравниваем сумму первых и последних трех цифр}
                                  then begin
                writeln ('S4astliviy bilet: ', start);
                sum := sum + 1
                end;
                start := start + 1
        until start > finish;
writeln ('Vsego s4astlivix biletov ', sum);
readln
end.

program korabli;

type index = 'A'..'E';
     ships = array [index] of char;
     timetostay = array [index] of integer;

var ship : ships;
    time : timetostay;

    procedure initialise ( var ship : ships; var time : timetostay);

     var i : index;

     begin
             WriteLn ('Enter time of every ship');
             for i := 'A' to 'E' do begin
             ship [i] := i;
             write ('Ship ', ship[i], ': ');
             readln (time[i])
             end
      end;

  procedure sort (var ship : ships; var time : timetostay);

       var
           temp : integer;
           i, i2 : index;

    begin
          for i := 'A' to 'E' do begin
              for i2 := i to 'E' do begin
              if time [i2] < time [i] then begin
                   temp := time[i];
                   time [i] := time [i2];
                   time [i2] := temp;
                   temp := ord (ship[i]);
                   ship [i] := ship [i2];
                   ship [i2] := chr (temp)
               end
               end
           end
     end;

 procedure display  (var ship : ships; var time : timetostay);

     var i : index;

   begin
         writeln ('The best variant');
               for i := 'A' to 'E' do begin
         writeln  (chr (ord(i) -16), ') ', ship[i],' - ', time [i])
               end
   end;

 begin
       initialise  (ship, time);
       sort (ship, time);
       display (ship, time);
       readln
 end.

var
  i,j,k,m,n,a: integer;
  c,d: byte;
  r: array[1..999]of boolean;

begin
  ReadLn(k);
  c:=0;
  m:=MaxInt;
  for d:=1 to 9 do begin
    for j:=1 to k do r[j]:=false;
    a:=d;
    n:=1;
    repeat
      r[a]:=true;
      while a<k do begin
        a:=a*10+d;
        Inc(n)
      end;
      while a>=k do a:=a-k
    until (a=0) or r[a];
    if a=0 then if n<m then begin
      c:=d;
      m:=n
    end
  end;
  if c=0 then WriteLn('No') else WriteLn(c,' ',m)
end.

function solve(const k: integer): longint;
var
  i, count: byte;
  n, value: longint;
  found: boolean;
begin
  found := false;
  i := 1;
  while not (found) and ( i < 10 ) do begin
    n := 10;
    value := i;
    count := 1;
    while not(found) and (n <= 1000000) do begin
      inc(count);
      inc(value, i * n);
      found := value mod k = 0;
      if not found then n := n * 10;
    end;
    if not found then inc(i);
  end;
  if found and ( value <> k ) then writeln(i, ',', count) else writeln('no');
end;

var
  k, v: longint;

begin
  {* for k := 1 to 999 do *}
  k := 123; 
  solve(k);
end.

Program Robot_Society;
Uses CRT;
Var A:Array[1..3] Of Longint;
	//в векторе храним число роботов возрастов 1, 2 и 3.
N,K,I:Integer;
X,Y,Rb,Nt:Longint;
// X- группы по 3, Y- группы по 5
Begin
ClrScr;
Write('nr robots=');ReadLn(K);
Write('nr years=');ReadLn(N);
A[1]:=K; A[2]:=0; A[3]:=0; Nt:=K;
For I:=1 To N Do Begin
X:=0; Y:=0; Rb:=Nt;  //Nt будет нашим результатом
While (Rb mod 3<>0) And (Rb>0) Do Begin Y:=Y+1; Rb:=Rb-5 End;  // делаем групы по 3 и 5 
If Rb>0 Then X:=Rb div 3;   
A[3]:=A[2]; A[2]:=A[1]; A[1]:=5*X+9*Y;
Nt:=A[1]+A[2]+A[3]
End;
WriteLn('nr total=', Nt);
ReadKey; End. 

Program Cantina;
Uses CRT;
Type Meniu=Record
Hour:1..24;
Val:100..500 End;
T=Array[1..100] Of Meniu;
Lin=Array[1..24] Of Meniu;
Var A:T; B:Lin; F:Text;
N,I:Byte; S:Longint;
Procedure Writing;
Begin
Assign(F,'cantina.in'); Reset(F);
ReadLn(F,N);
For I:=1 To N Do
ReadLn(F,A[I].Hour,A[I].Val); Close(F)
End;
Procedure Sort;
Var V:Boolean; C:Meniu;
Begin V:=True;
While V Do Begin V:=False;
For I:=1 To N-1 Do
If (A[I].Val<A[I+1].Val) Or
(A[I].Val=A[I+1].Val) And (A[I].Hour>A[I+1].Ora)
Then Begin C:=A[I]; A[I]:=A[I+1]; A[I+1]:=C;V:=True End
End
End;
Procedure Print;
Var L:Byte;
Begin B[A[1].Hour]:=A[1]; S:=A[1].Val;
For I:=2 To N Do Begin
L:=A[I].Hour;
While (L>=1) And (B[L].Hour>0) Do Dec(L);
If L>=1 Then Begin B[L]:=A[I]; S:=S+A[I].Val End
End;
WriteLn(S)
End;
Begin ClrScr;
Writing; Sort; Print;
ReadKey End.