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

unit my_unit;

Interface
{LongArifmetika}

Const
   MaxLen=255;
 Type
   TNum=Array[0..MaxLen] Of Byte;
   mas= record
         s:array[1..32000] of integer;
        end;
 Var
   mt,dt:Array[0..100] Of Byte;
   iii:Longint;

Procedure Add(A,B:TNum;Var C:TNum); {cyma}
Procedure Sub(A,B:TNum;Var C:TNum);
Procedure Mul10(Pow:Longint;Var X:TNum);
Procedure Mulm10(Pow:Longint;Var X:TNum);
Procedure Mul(A,B:TNum;Var C:TNum); {c=a*b}
Procedure MulC(A:TNum;C:Longint;Var B:TNum); {b=a*c}
Function InputLong(Var X:TNum):Boolean; {pomeshaetsa x v longint?}
Procedure PrintLong(Var X:TNum); {pechat x}
Function Len(X:TNum):Longint; {╬яЁхфхыхэшх фышэ√}
Function CmpEqLns(A,B:TNum):Char; {╤Ёртэхэьх ўшёхы юфэющ фышэ√}
Function Cmp(A,B:TNum):Char; {╤Ёртэхэшх ўшёхы}
Procedure Dvd(A,B:TNum;Var C:TNum);
Procedure IntToTNum(K:Longint;Var R:TNum);
Procedure StrToTNum(S:String;Var R:TNum);
{Sortirovka}
Procedure QuickSort( L, R : Integer;var a:mas ); { Быстрая сортировка массива A[] }
{Screen}
Procedure initgr;
Procedure clrscreen;
Procedure enter;
{Key}
Function vihod:boolean;
Function ScanKey : Byte;
{File}
Function Exist(Name : String) : Boolean;
{Math Chisla}
Function HEX_DEC(x:string):longint;
Function DEC_HEX(x:longint):string;
Function BIN_DEC(x:string):longint;
Function DEC_BIN(x:longint):string;

Function BinAdd(s1,s2:string):string;
Function BinSub(s1,s2:string):string;
{Math}
Function koren(x,n:longint):real;
Function realstep(x,k:real):real;
Function Sumacifr(n: LongInt): Integer;
Function NOK(x,y:longint):longint; { фукнция поиска наим. общ. кратного }
Function NOD(x,y:longint):longint; { фукнция поиска наиб. общ. делителя }
Function step(a,b:byte):longint;
Function Fact(n:longint):longint;
Function Symetry(n:longint):boolean;
Function Kolcifr(n:longint):byte;
Function Polind(i:integer):integer;
Function Armstrong(n:longint):boolean;
Function Proste(n:word):boolean;
Function Fibon(n:byte):longint;
Function Rad(q:real):real;
Function Strtofloat( s : string ) : real;
Function Step10(num:byte) : longint;
Function Floattostr(int: real): string;
Function Strtoint(str: longint): integer;
Function Inttostr(int: longint): string;
{Timer}
Function ReadTimer: longint;
Function ReadTimerChipCount: word;
Function ReadOscelator: longint;
Procedure DelayEX(ms: word);
{Mouse}
Function MousePressed: Boolean;
Procedure initm;
Procedure InitMouse(Var ButtonCount,ErrorCode  :byte);
Procedure MouseOn;
Procedure MouseOff;
Procedure GetMouseXY(Var  x,y :word;Var  LeftButton,RightButton,ThirdButton :boolean);
Procedure SetMouseXY(x,y  :word);
Procedure GetMouseXYOnDown(Var  x,y:word;ButtonNumber  :byte;Var  Count  :byte;Var LeftButton,RightButton,ThirdButton:boolean);
Procedure GetMouseXYOnUp(Var  x,y  :word;ButtonNumber  :byte;Var  Count  :byte;Var LeftButton,RightButton,ThirdButton:boolean);
Implementation

Uses Crt,Dos,graph;

Var
 SystemTimer: LongInt absolute $40:$6C;
Var
   regs :registers;

Procedure initgr;
var gd,gm:integer;
begin
 gd:=detect;
 initgraph(gd,gm,'');
 SetTextStyle(smallfont, HorizDir, 6);
end;

Procedure swapper(var a,b :real);
var z:real;
begin
 z:=a;
 a:=b;
 b:=a;
end;

Function koren (x,n:longint):real;
begin
 koren:=realstep(x,1/n);
end;

Function realstep(x,k:real):real;
begin
 if x>0 then
  realstep:=Exp(k*ln(x))
 else
  realstep:=-1;
end;

Function Sumacifr(n: LongInt): Integer;
Var
  s: Integer;
Begin
 s := 0;
 While n <> 0 Do
 Begin
  Inc(s, n mod 10);
  n := n div 10
 End;
 sumacifr:= s
End;

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;

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;

Procedure QuickSort( L, R : Integer;var a:mas ); { Быстрая сортировка массива A[] }
var i,j,x,y : integer;
begin
  i := l; j := r;
  x := a.s[(l+r) div 2];
  repeat
    while (A.s[i]<x) do inc(i);
    while (x<A.s[j]) do dec(j);
    if ( i<=j ) then
    begin
      y:=A.s[i]; a.s[i]:=a.s[j]; a.s[j]:=y;
      inc(i); dec(j);
    end;
  until (i>j);
  if (l<j) then QuickSort(l,j,a);
  if (i<r) then QuickSort(i,r,a);
end;

Function NOK(x,y:longint):longint; { фукнция поиска наим. общ. кратного }
begin
   NOK:=( x div NOD(x,y) ) * y;
end;

Function NOD(x,y:longint):longint; { фукнция поиска наиб. общ. делителя }
begin
   if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y;
end;

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;

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;
 a:string;
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;

Function step(a,b:byte):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;
     step:=r;
end;

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;

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;

Function Fact(n:longint):longint;
var
 f:longint;
 j:shortint;
begin
 f:=1;
 for j:=1 to n do f:=f*j;
 fact:=f;
end;

Function symetry(n:longint):boolean;
var
 z,c:longint;
begin
 if (n<0) or (kolcifr(n)<>2) or (kolcifr(n)<>4) or (kolcifr(n)<>6) or (kolcifr(n)<>8)
  then symetry:=false
  else
 begin
  z:=n;
  c:=n mod step10(kolcifr(n) div 2);
  z:=z div step10(kolcifr(n) div 2);
  if z=c then symetry:=true else symetry:=false;
 end;
end;

Function Kolcifr(n:longint):byte;
begin
 While N <> 0 Do
 Begin
  Writeln(N Mod 10);
  N:=N Div 10;
 End;
End;

Function polind(i:integer):integer;
 var p,s:integer;
begin
 s:=0;
 p:=i;
 while p>0 do
 begin
  s:=s*10+p mod 10;
  p:=p div 10;
 end;
 polind:=s;
end;

Function Armstrong(n:longint):boolean;
var
  z,a,t:longint;
begin
 t:=n;
 z:=0;
  if n<0 then armstrong:=false
 else
  if n<10 then armstrong:=true
 else
  while a<>0 do
  begin
   a:=t mod 10;
   t:=t div 10;
   z:=z+a;
  end;
  if z=n then armstrong:=true else armstrong:=false;
end;

Function Proste(n:word):boolean;
var
  zuy:boolean;
  i:word;
begin
  zuy:=true;
  for i:=2 to round(sqrt(n)+1) do
  if n mod i=0 then zuy:=false;
  proste:=zuy;
end;

Function Fibon(n:byte):longint;
begin
  if (n=1) or (n=0) then fibon:=1 else
  fibon:=fibon(n-1)-fibon(n-2);
end;

Function rad(q:real):real;
begin
    rad:=q/360*2*pi;
end;

Function ReadTimer: longint;
begin
 ReadTimer := SystemTimer;
end;

Function ReadTimerChipCount: word;
var frec: word;
begin
 frec := port[$40];
 frec := frec or (port[$40] shl 8);
 ReadTimerChipCount := frec;
end;

function ReadOscelator: longint;
begin
  ReadOscelator := ((ReadTimer and $7fff)*$10000)
                or (65535-ReadTimerChipCount);
end;

procedure DelayEX(ms: word);
const k=1193180/1000;
var T: longint;
begin
 T := ReadOscelator + trunc(ms*k);
 Repeat until T <= ReadOscelator;
end;


Function strtofloat;
var code    : integer;
    x       : real;
begin
     Val(s,x,Code);
     if code>0 then begin
        s:=Copy(s,1,code-1);
        Val(s,x,code);
     end;
     strtofloat:=x;
end;

Procedure enter;
begin
 writeln;
end;

Procedure clrscreen;
begin
 clrscr;
end;

Function Exist(Name : String) : Boolean;
Var
  F  : File;
Begin
  Assign(F,name);
  {$I-}
  Reset(F);
  Close(F);
  {$I+}
  Exist:= IOResult=0;
End;

Function vihod:boolean;
var z:byte;
begin
 repeat
  if keypressed then
   z:=scankey;
 until (z=21) or (z=49);
 if z=21 then vihod:=true else vihod:=false;
end;

Function ScanKey : Byte; Assembler;
Asm
  Mov Ah,0
  Int 16h
  Xchg Ah,Al
  Xor Ah,Ah
End;

Function step10(num:byte) : longint;
var govn,givn:byte;
begin
 givn:=1;
 for govn:=1 to num do
 givn:=givn*10;
 step10:=givn;
end;

Function floattostr(int: real): string;
var s: string;
begin
 str(int:2:2,s);
 floattostr:=s;
end;

Function strtoint(str: longint): integer;
var I, Code: Integer;
begin
  Val(ParamStr(1), I, Code);
  if code = 0 then strtoint:=i;
end;

Function inttostr(int: longint): string;
var s: string;
begin
 str(int:10,s);
 inttostr:=s;
end;

procedure Start (var T:longint);
begin
T:=SystemTimer;
end;

procedure Stop (var T:longint);
begin
T:=SystemTimer-T;
end;

procedure Pause (T:longint);
var Xn,Xt:longint;
begin
Xt:=0;
Xn:=SystemTimer;
While ((Xt-Xn)/18.2)*1000 < T do
Xt:=SystemTimer;
end;

Procedure InitMouse;
Begin

   With regs do
      begin
         ax:=$0000;
         Intr($33,regs);
         If ax=$FFFF then ErrorCode:=0 else ErrorCode:=1;
         ButtonCount:=bx
      end

End;
{----------------------------------------------------------------------------}
Function MousePressed: Boolean;
var
resultbx:word;
begin
asm
 Mov ax, $03
 Int $33
 mov resultbx,bx
end;
MousePressed := resultbx<>0
end;
{----------------------------------------------------------------------------}
Procedure initm;
var
  x,y:word; lb,mb,rb:boolean; b,err:byte;
begin
 initmouse(b,err);
 setmousexy(0,0);
 mouseon;
end;
{----------------------------------------------------------------------------}
Procedure MouseOn;
Begin
   regs.ax:=$0001;
   intr($33,regs)
End;
{----------------------------------------------------------------------------}
Procedure MouseOff;
Begin
   regs.ax:=$0002;
   intr($33,regs)
End;
{----------------------------------------------------------------------------}
Procedure GetMouseXY;
Var
   ButtonCode   :byte;
Begin
   With regs do
      begin
         ax:=$0003;
         intr($33,regs);
         x:=cx;
         y:=dx;
         ButtonCode:=bx
      end;
   LeftButton:=(ButtonCode and 1)=1;
   RightButton:=(ButtonCode and 2)=2;
   ThirdButton:=(ButtonCode and 4)=4
End;
{----------------------------------------------------------------------------}
Procedure SetMouseXY;
Begin
   With regs do
      begin
         ax:=$0004;
         cx:=x;
         dx:=y;
         intr($33,regs)
      end
End;
{----------------------------------------------------------------------------}
Procedure GetMouseXYOnDown;
Var
   ButtonCode   :byte;
Begin
   with regs do
      begin
         ax:=$0005;
         bx:=ButtonNumber;
         intr($33,regs);
         ButtonCode:=ax;
         Count:=Bx;
         x:=cx;
         y:=dx
      end;
   LeftButton:=(ButtonCode and 1)=1;
   RightButton:=(ButtonCode and 2)=2;
   ThirdButton:=(ButtonCode and 4)=4
End;
{----------------------------------------------------------------------------}
Procedure GetMouseXYOnUp;
Var
   ButtonCode   :byte;
Begin
   with regs  do
      begin
         ax:=$0006;
         bx:=ButtonNumber;
         intr($33,regs);
         ButtonCode:=ax;
         Count:=Bx;
         x:=cx;
         y:=dx
      end;
   LeftButton:=(ButtonCode and 1)=1;
   RightButton:=(ButtonCode and 2)=2;
   ThirdButton:=(ButtonCode and 4)=4
End;

{ARIFMARIFMARIFMARIFMARIFMARIFMARIFMARIFMARIFM}

Function Max(X,Y:Longint):Longint;
Begin
 If X>Y Then Max:=X Else Max:=Y;
End;

Procedure Add;
Var
  I,D :Longint;
Begin
 IntToTNum(0,C);
 D:=0;
 For I:=MaxLen DownTo MaxLen-Max(Len(A),Len(B)) Do
 Begin
  C[I]:=(A[I]+B[I]+D) Mod 10;
  D:=(A[I]+B[I]+D) Div 10;
 End;
 C[0]:=Max(Len(A),Len(B))+1;
 If C[MaxLen-Max(Len(A),Len(B))]=0 Then
 Dec(C[0]);
End;

Procedure Mul10;
Var
  I:Longint;
Begin
 For I:=1 To MaxLen-Pow Do
 X[I]:=X[I+Pow];
 For I:=MaxLen+1-Pow To MaxLen Do
 X[I]:=0;
 Inc(X[0],Pow);
End;

Procedure Mulm10;
Var
  I:Longint;
Begin
 For I:=MaxLen DownTo Pow+1 Do
 X[I]:=X[I-Pow];
 For I:=1 To Pow Do
 X[I]:=0;
 Dec(X[0],Pow);
 If X[0]<0 Then
 X[0]:=0;
End;

Procedure Mul;
Var
  I,J,D,V,LA,LB,P :Integer;
  T :TNum;
Begin
 FillChar(c,SizeOf( c ),0);
 LA:=Len(a); LB:=Len(b);
 For i:=LB DownTo 1 Do
 Begin
  d:=0;
  For j:=LA DownTo 0 Do
  Begin
   P:=MaxLen-LA+j+i-LB;
   V:=a[MaxLen-LA+j]*b[MaxLen-LB+i]+d+c[P];
   c[P]:=mt[V];
   d:=dt[v];
  End;
 End;
End;

Procedure MulC;
Var
  i,j,d:Longint;
  t:TNum;
Begin
 For I:=1 To MaxLen Do B[I]:=0;
 For J:=1 To MaxLen Do T[J]:=0;
 D:=0;
 For J:=MaxLen DownTo MaxLen-Len(A) Do
 Begin
  T[J]:=(A[J]*C+D) Mod 10;
  D:=(A[J]*C+D) Div 10;
 End;
 T[0]:=Len(A)+1;
 Add(T,B,B);
End;

Function InputLong;
Var
  I :Longint;
  S :String;
  Cod :Integer;
Begin
 Readln(S);
 If s='-1' Then
 Begin
  InputLong:=False;
  Exit;
 End;
 InputLong:=True;
 FillChar(X,SizeOf(X),0);
 For I:=1 To Length(S) Do Val(S[I],X[MaxLen-Length(S)+I],Cod);
 X[0]:=Length(s);
End;

Procedure PrintLong;
Var
  I :Longint;
Begin
 If Len(X)=0 Then
 Write(0)
 Else
 For I:=MaxLen+1-Len(X) To MaxLen Do
 Write(X[I]);
End;

Function Len;
Var
  I :Longint;
Begin
 Len:=0;
 I:=2;
 While ((X[I]=0) And (I<=MaxLen)) Do Inc(I);
 Len:=MaxLen+1-I;
End;

Function CmpEqLns;
Var
  I :Longint;
  R :Char;
Begin
 R:='=';
 I:=1;
 While ((I<=MaxLen) And (R='=')) Do
 Begin
  If A[I]>B[I] Then
  R:='>'
  Else If A[I]<B[I] Then
  R:='<';
  Inc(I);
 End;
 CmpEqLns:=R;
End;

Function Cmp;
Begin
 If Len(A)>Len(B) Then Cmp:='>' Else
 If Len(A)<Len(B) Then Cmp:='<' Else
 Cmp:=CmpEqLns(A,B);
End;

Procedure Sub;
Var
  I,D :Longint;
Begin
 IntToTNum(0,C);
 Begin
  D:=0;
  For I:=MaxLen DownTo MaxLen-Max(Len(A),Len(B)) Do
  Begin
   C[I]:=(A[I]-B[I]+10-D) Mod 10;
   If (A[I]-B[I]-D)<0 Then
   D:=1
   Else
   D:=0;
  End;
  C[0]:=Max(Len(A),Len(B));
 End;{If}
End;

Procedure IntToTNum;
Var
  i:Longint;
  cod:Integer;
  s:String;
Begin
 if k<0 then
 begin
  R[0]:=1;
  K:=-K;
 end;
 str(k,s);
 for i:=0 to MaxLen do R[i]:=0;
 for i:=1 to length(s) do
 val(s[i],R[MaxLen-length(s)+i],Cod);
 R[0]:=Length(s);
End;

Procedure StrToTNum;
Var
  cod:Integer;
  i:Longint;
Begin
 if s[1]='-' then
 begin
  R[0]:=1;
  Delete(s,1,1);
 end;
 for i:=1 to MaxLen do R[i]:=0;
 for i:=1 to length(s) do
 val(s[i],R[MaxLen-length(s)+i],Cod);
End;

Procedure Dvd;
Var
  i,j,k:Longint;
  r,t,n,v:TNum;
Begin
 k:=MaxLen+1-len(A);
 IntToTNum(a[k],n);
 IntToTNum(0,r);
 IntToTNum(0,v);
 while k<=MaxLen do
 begin
  i:=10;
  repeat
   dec(i);
   MulC(b,i,t)
  until cmp(t,n)<>'>';
  mul10(1,r);
  v[MaxLen]:=i;
  add(r,v,r);
  sub(n,t,n);
  mul10(1,n);
  inc(k);
  if k<=MaxLen then
  begin
   v[MaxLen]:=a[k];
   add(n,v,n);
  end;
 end;
 c:=r;
End;
Begin
 For iii:=0 To 100 Do Begin
 mt[iii]:=iii Mod 10;
 dt[iii]:=iii Div 10;
End;

END.