Задача 1. Новий Рік в епоху інформатизації.

У одній з шкіл міста Olympijsk працює лаборант Олена. Вона мріє, 
щоб Дід Мороз подарував їй у новорічну ніч великого пухнастого білого 
ведмедика. Зайшовши на офіційний сайт Діда Мороза у 
Інтернеті www.moroz.did, Оленка вирішила замовити собі новорічний 
подарунок через on-line систему бронювання подарунків "Yalynka". Але 
замість вітання "Happy New Year!" вона помітила незрозумілий рядок 
літер "pyHNa pYr eaew!". Це результат роботи жахливого вірису 
"AntiFrost", що був написаний хакером Alex'ом. Попри свою шкідливість, 
вірус має нескладну логіку, і лише переставляє літери у тексті таким 
чином:
1) Вірус окремо опрацьовує голосні та приголосні літери.
2) Вірус міняє місцями 1-шу голосну з 2-ою, 3-ю з 4-ою, 5-ту з 6-ою,
   і т.д. 
   за таким же принципом він міняє місцями і приголосні літери.
3) Вірус змінює лише латинські літери, всі інші символи він залишає
   незмінними.
Голосними літерами вважати (a,o,i,u,y,e)

Оленка зберігла спотворений вірусом текст у файл NOVYJRIK.HTM
Напишіть програму, яка запише початковий (вірний) текст у файл 
OLENA.HTM 0<= Розмір файлу NOVYJRIK.HTM <= 60000 байт. У файлі 
можуть бути присутні рядки, довжина яких перевищуватиме 255 символів.
*****
VAR F:file;
    A:Array[1..60001] of char;
    Size,g,p,i:word;

PROCEDURE Swap(p1:word; var p2:word);
var T:char;
begin
  T:=A[p1]; A[p1]:=A[p2]; A[p2]:=T; p2:=0;
end;

BEGIN
  assign(f,'NOVYJRIK.HTM'); reset(f,1);
  BlockRead(f,A,SizeOf(A),Size);
  close(f);
  g:=0; p:=0;
  for i:=1 to Size do
    if UpCase(A[i]) in ['A','O','U','I','E','Y']
      then if g=0 then g:=i
                  else Swap(i,g)
      else if UpCase(A[i]) in ['A'..'Z']
             then if p=0 then p:=i
                         else Swap(i,p);
  assign(f,'OLENA.HTM'); rewrite(f,1);
  BlockWrite(f,A,Size,i);
  close(f);
END.

Задача 2.
Маленкий програміст Петрик вчиться програмувати на мові "CALC". Ця 
дивовижна мова програмування дозволяє лише обчислювати арифметичні 
вирази. Мова CALC має такі особливості:
1) Змінні позначаються великими латинськими літерами (A,B,C,...,Z)
2) Оператор присвоєння має наступний синтаксис:
   Змінна = вираз
3) Вираз - арифметичний вираз, що містить у собі дужки, числа, змінні 
   та знаки арифметичних операцій + , - , * , / , де ділення 
   відбувається цілочисельно (тобто 7/3 дорівнює 2)
4) Виведення реалізується за допомогою оператора:
   ? вираз
5) На початку роботи програми всі змінні мають значення 0


У файлі PETRO.CLC записана правильна програма на мові CALC.
Напишіть програму, яка виведе у файл PETRO.OUT результат роботи 
програми PETRO.CLC.
Гарантується, що значення усіх змінних, виразів, а також будь-якого 
підвиразу лежатимуть в межах від -10000 до 10000.
Символи пропуску можуть зустрічатися у довільному місті рядка.
Довжина рядків у програмі PETRO.CLC не буде перевищувати 100 символів.
Програма міститиме не більше 50 рядків.
*****
VAR Z:Array['A'..'Z'] of integer;
    Buf:string;
    p:integer;

FUNCTION Expr:integer;forward;

FUNCTION Fact:integer;
var r:integer;
begin
  if Buf[p]='('            { (Expr) }
    then begin
           inc(p);
           r:=Expr;
           inc(p)
         end
    else if Buf[p] in ['A'..'Z']     {  Var  }
           then begin
                  r:=Z[Buf[p]];
                  inc(p);
                end
           else begin  { Number }
                  r:=0;
                  while Buf[p] in ['0'..'9'] do
                    begin r:=r*10+ord(Buf[p])-ord('0'); inc(p) end;
                end;
  Fact:=r;
end;

FUNCTION Term:integer;
var r:integer;
begin
  r:=Fact;
  while Buf[p] in ['*','/'] do
    if Buf[p]='*' then begin inc(p); r:=r*Fact end
                  else begin inc(p); r:=r div Fact end;
  Term:=r;
end;

FUNCTION Expr:integer;
var r:integer;
begin
  r:=Term;
  while Buf[p] in ['+','-'] do
    if Buf[p]='+' then begin inc(p); r:=r+Term end
                  else begin inc(p); r:=r-Term end;
  Expr:=r;
end;

FUNCTION NotSpace(S:string):string;
var ss:string;
    i:integer;
begin
  ss:='';
  for i:=1 to length(S) do
    if s[i]<>' ' then ss:=ss+s[i];
  NotSpace:=ss;
end;

BEGIN
  assign(INPUT,'petro.clc'); reset(INPUT);
  assign(OUTPUT,'petro.out'); rewrite(OUTPUT);
  while not eof(INPUT) do
  begin
    readln(Buf);
    Buf:=NotSpace(Buf);
    if Buf='' then continue;
    Buf:=Buf+'$';
    if Buf[1]='?' then begin p:=2; writeln(Expr) end
                  else begin p:=3; Z[Buf[1]]:=Expr end;
  end;
  close(OUTPUT);
  close(INPUT);
END.
*****
VAR Z:Array['A'..'Z'] of integer;

VAR Res:Array[1..200] of integer;
    NR:integer;

    Stack:Array[1..200] of char;
    SP:integer;

FUNCTION Prior(op:char):integer;
begin
  case op of
    '(':Prior:=0;
    '+','-':Prior:=1;
    '*','/':Prior:=2;
    '~':Prior:=3;
  end;
end;

PROCEDURE AddOperand(S:string);
var code:integer;
begin
  inc(NR);
  if S[1] in ['A'..'Z'] then Res[NR]:=Z[S[1]]
                        else Val(S,Res[NR],code);
end;

PROCEDURE RemoveTopStack;
begin
  case Stack[SP] of
    '+':Res[NR-1]:=Res[NR-1]+Res[NR];
    '-':Res[NR-1]:=Res[NR-1]-Res[NR];
    '*':Res[NR-1]:=Res[NR-1]*Res[NR];
    '/':Res[NR-1]:=Res[NR-1] div Res[NR];
    '~':begin Res[NR]:=-Res[NR]; inc(NR) end
  end;
  dec(SP);
  dec(NR);
end;

PROCEDURE AddOperator(op:char);
begin
  if (SP=0) or (op='(') then begin inc(SP); Stack[SP]:=op; Exit end;
  if op=')' then begin
                   while Stack[SP]<>'(' do RemoveTopStack;;
                   dec(SP);
                   Exit;
                 end;
  while (SP<>0) and (Prior(op) <= Prior(Stack[SP])) do RemoveTopStack;;
  inc(SP); Stack[SP]:=op;
end;

FUNCTION CountLine(S:string):integer;
var LS,beg,i:integer;
    canminus:boolean;
    ss:string;
begin
  LS:=length(S);
  beg:=1;
  canminus:=true;
  while beg<=LS do
  begin
    ss:=S[beg];
    if (S[beg] in ['0'..'9','A'..'Z'])
      then begin { Operand }
             i:=beg+1;
             while (i<=LS) and (S[i] in ['0'..'9','A'..'Z']) do
               begin ss:=ss+s[i]; inc(i) end;
             AddOperand(ss);
             beg:=i;
             canminus:=false;
           end
      else begin
             if (S[beg]='-') and canminus
               then AddOperator('~')
               else AddOperator(S[beg]);
             inc(beg);
             canminus:=true;
           end;
  end;
  while SP<>0 do RemoveTopStack;
  CountLine:=Res[1];
  if (NR<>1) or (SP<>0) then writeln('ERROR!!!');
end;

PROCEDURE ProcessLine(S:string);
var SS:string;
    i:integer;
begin
  NR:=0; SP:=0;

  SS:='';
  for i:=1 to length(S) do
    if S[i]<>' ' then SS:=SS+S[i];
  if SS='' then Exit;
  if SS[1]='?' then writeln(CountLine(Copy(SS,2,length(SS)-1)))
               else begin
                      Z[SS[1]]:=CountLine(Copy(SS,3,length(SS)-2));
                    end;
end;

VAR S:string;
BEGIN
  assign(INPUT,'PETRO.CLC'); reset(INPUT);
  assign(OUTPUT,'PETRO.OUT'); rewrite(OUTPUT);
  while not eof(INPUT) do
  begin
    readln(S);
    ProcessLine(S);
  end;
  close(INPUT);
  close(OUTPUT);
END.


Задача 3. "Новий Рік не прийде".

Подорожуючи до міста Olympijsk з країни Вічних Снігів, Дід Мороз 
зупинився у одному з готелів невеличкого містечка. У місцевому 
ресторані він познайомився з ICE'om - видатним гравцем 
у "Крижинки", який запропонував зіграти Діду Морозу на його подарунки.
У випадку програшу Діда Мороза, він програє свою чарівну торбинку з 
подарунками, без якої свято Нового Року не відбудеться. Знаючи, що Дід
Мороз не вміє грати у "Крижинки" ICE запропонував йому вирішити, буде
він ходити першим чи другим.

Гра відбувається на полі розміру NxN. У першому рядку розташовані 
крижинки ICE'а, у N-ому крижинки Діда Мороза. На кожному ході гравець
обирає свою крижинку та переміщує її вперед на будь-яку кількість 
вільних клітинок. Програє гравець, що не зможе зробити хід. 
(3<=N<=1000)

***Гра***
{$R-,S-,Q-}
UNIT Game;

INTERFACE

FUNCTION InitGame:integer;
PROCEDURE BeginGame(K:integer);
PROCEDURE MakeDidMorozMove(C,P:integer);
PROCEDURE GetIceMove(var C,P:integer);
PROCEDURE EndGame;



IMPLEMENTATION

{USES Crt;}
USES Dos;

CONST TimeLimit = 300;

VAR N,AllXor,Curr:integer;
    IceMove,RandomMove:boolean;

    AllM:longint;

    A:Array[1..1000] of integer;

    HH,MM,SS,Hu,HH2,MM2,SS2,Hu2:word;

{    B1,B2:Array[1..1000] of integer;}


{
PROCEDURE DrawField;
var i,j:integer;
begin
  clrscr;
  for i:=1 to N do
  begin
    for j:=1 to N do
    begin
      if B1[j]=i then write('x')
                 else if B2[j]=i then write('o')
                                 else write('.');
    end;
    writeln;
  end;
end;
}

PROCEDURE Error(S:string);
begin
  writeln(S);
  Halt(0);
end;

FUNCTION InitGame:integer;
var code,R,i:integer;
begin
  Val(ParamStr(1),N,code);
  Val(ParamStr(1),R,code);

  RandomMove:=R=1;

{  readln(N);}
  InitGame:=N;
  if Odd(N) then AllXor:=N-2 else AllXor:=0;
  for i:=1 to N do A[i]:=N-2;
  Curr:=N;

{  for i:=1 to N do begin B1[i]:=1; B2[i]:=N end;}

end;

PROCEDURE BeginGame(K:integer);
begin
  if (K<>1) and (K<>2) then Error('Wrong K in BeginGame');
  IceMove:= K=1;

{  DrawField;}
end;

PROCEDURE MakeDidMorozMove(C,P:integer);
begin

inc(AllM);


  if IceMove then Error('Illegal order');
  if A[C]<P then Error('Illegal move');
  AllXor:=AllXor xor A[C] xor (A[C]-P);
  if AllXor <> 0 then Error('Oh! Where is my magic bag? New Year never comes :-(');
  A[C]:=A[C]-P;

{  dec(B2[C],P);}

  while (Curr>0) and (A[Curr]=0) do dec(Curr);
  IceMove:=true;

{  DrawField;}

end;

PROCEDURE GetIceMove(var C,P:integer);
begin
inc(AllM);


  if not IceMove then Error('Illegal order');
{  readln(C,P);}
  C:=Curr;
  if RandomMove then P:=random(A[C])+1
                else P:=1;

  AllXor:=AllXor xor A[C] xor (A[C]-P);
  A[C]:=A[C]-P;


{  inc(B1[C],P);}


  while (Curr>0) and (A[Curr]=0) do dec(Curr);
  IceMove:=false;

{  DrawField;}

end;

PROCEDURE EndGame;
var Time:longint;
begin
  GetTime(HH2,MM2,SS2,Hu2);

{  writeln(HH2,':',MM2,':',SS2,':',Hu2); }

  if Curr<>0 then Error('Why EndGame?');

  if HH2<HH then HH2:=HH2+24;

  Time:=(((longint(HH2)-HH)*60+MM2-MM)*60+SS2-SS)*100+Hu2-Hu;

{  writeln('Time = ',Time); }

{  writeln('AllM = ',AllM);}

  if Time>TimeLimit then
  begin
    writeln('Time = ',Time);
    Error('Time Limit');
  end;

  writeln(' --------------------------- ');
  writeln('|      Happy New Year!      |');
  writeln(' --------------------------- ');
  writeln;

end;

BEGIN
  GetTime(HH,MM,SS,Hu);
{  writeln(HH,':',MM,':',SS,':',Hu); }
END.
******
USES Game;
VAR N,S:longint;
    C,P:integer;
BEGIN
  N:=InitGame;
  BeginGame(1 + N mod 2);
  S:=(N-2)*N;
  if Odd(N) then begin MakeDidMorozMove(1 + N div 2,N-2); dec(S,N-2) end;
  while S>0 do
  begin
    GetIceMove(C,P);
    MakeDidMorozMove(N + 1 - C,P);
    dec(S,2*P);
  end;
  EndGame;
END.