INFOMAN брой 6

{
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 Панайот Марков Добриков ,
 ФМИ/ СУ - спец."информатика" , 1 курс
 Пловдив , ул."Мали Богдан" N22 , ап.16 , тел./032/ 272-181
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ

     Задача 6 за 1997 година от конкурса по информатика на сп. Computer
     ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ

    В най-общи линии условието на задачата беше: Даден е масив от N различни
 по между си числа - a[1],a2[],...,a[N]. Разполагаме с машина, която може да
 изпълнява команди от вида (i,j)  като една команда  (i,j) означава следното:
 "ако i<j и a[i]>a[j], размени стойностите на a[i] и a[j]".  Дадена е съвкуп-
 ност от неравенства, които са изпълнени за някои двойки от елементи на маси-
 ва, които не си противоречат.  Да се напише програма, която генерира минима-
 лен брой команди за машината с цел да подреди произволен масив с N елемента
 във възходящ ред, ако за него са изпълнени дадените неравенства.


 1.Анализ на задачата
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 И така задачата е да се намери алгоритъм за сортировка, чиято сложност
 в максимално лошия случай да е минимална. Ако нямаме никакви начални
 релации, то какъвто и алгоритъм да използваме сложноста е винаги O(Ný) ,
 въпреки че при някои стойности за N е възможна последоватленост от операции
 водещи винаги до сортиране, чийто брой да е по-малък от Ný.

 2.Алогритъм и Програма
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
 И така алгоритъма е следния :
  Генерираме всички възможни последователност от операции , като
  започваме с последователност с дължина 1 , след това са дължина 2 и т.н.
  докато намерим решение - при първото намерено решение разполагаме и с
  минималната по дължина последователност. За една последователност от
  операции казваме че е решение, ако сортира всички възможни масиви, които
  отговарят на началните (дадените по условие) релации.
  Една добра оптимизация (тя е възможна само когато няма никакви налични
  начални релации) е следната :
  Вместо да се проверява дали всяка последователностт сортира всички
  възможни масиви (N!), може да се проверява само дали последователността
  сортира масива [N, N-1, N-2, N-3, .... , 1] - ако го сортира, то тя ще
  сортира и всичките останали N! възможни масива. Тази оптимизация е и
  добро Greedy(но не-винаги работещо) решение , когато имаме някакви начални
  релация.
  В случая, когато имаме начални релации всяка последователност се пробва
  дали сортира всички масиви, отговарящи на началните релации.
  Схемата на алгоритъма е следната :

  function SortAll:boolean;
  begin
   Генерират_се_пермутациите_отговарящи_на_началните_релации
   if [Съществува пермутация на числата от 1 до N,която да не може да се
       сортира от текущата последователност от команди] then SortAll:=false;
   //else// SortAll:=true;
  end;

  procedure GenerateAll;
  begin
    for i:=1 to MaxInt do
     begin
       Построяване_следващата_последователност_с_дължина_i;
       if SortAll then [Това е оптималното решение];
     end; // Since the complexity of algorytm is O((2^N)^(N!)) i will become
          // maxint far after the end of the universe
  end;

  Ето и съответно процедурите в програмата :
  procedure GenLen(i:integer)
         - генерира всички последователности от команди, в главната
           порграма имаме for L:=1 to (N*(N-1) div 2) do GenLen(1);
  function SortThemAlways:boolean;
         - връща true ако генерираната от GenLen последователност успява
           да сортира всички възможни масиви, false иначе, ако SortThemAlways
           върне true значи това е решение на задачата и следва Halt;
           Използва процедурата Permut
  procedure Permut(Nn:integer);
    function TryOne:boolean;   връща true ако текущата последователност
                               (генерирана от GenLen) може да сортира
                               текущата пермутация (генерирана от Perm)
    procedure Perm(l:integer); рекурсивна процедура, генерираща всички
                               пермутации на числата от 1 до N, но без онези
                               които не отговарят на начално зададените
                               релации.

 3.Сложност на алгоритъма
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
   Сложноста на алгоритъма е O((2^N)^(N!)) в най-лошия случай - а той е
   когато няма никакви релации , тогава е уместно да се пуска Greedy
   решението. Общо взето програмата трудно би намерила решение при случай
   за N>6 и малко на брой начални релации.
}


Uses Crt,Dos;
Type OperType=record a,b:integer;end;
Var AllOper:array[1..100] of OperType;
    Oi,On,N:integer;
    InitOper:array[1..100] of OperType;

procedure ReadData;
var f:text;
    p1,p2,i,k:integer;
begin
 ClrScr;
 assign(f,'INPUT.TXT');
 reset(f);
 readln(f,N);
 readln(f,K);
 Oi:=0;
 for i:=1 to K do
  begin
    Readln(f,p1,p2);
    Inc(Oi);
    InitOper[Oi].a:=p1;
    InitOper[Oi].b:=p2;
  end;
 close(f);

 On:=0;
 for i:=1 to N-1 do
  for k:=i+1 to N do
   begin
     inc(On);
     AllOper[On].a:=i;
     AllOper[On].b:=k;
   end;
end;

procedure WriteData;
var i:integer;
begin
 Writeln('All poss oper ');
 for i:=1 to On do write('(',AllOper[i].a,' ',AllOper[i].b,') ');
 writeln;
 Writeln('Init relations ');
 for i:=1 to Oi do write('(',InitOper[i].a,' ',InitOper[i].b,') ');
 writeln;{readkey;}
 writeln('-------------------------');
end;

Var L:integer;
    TakeOper:array[1..100] of OperType;
       SThem:boolean;

  Const MaxN=100;
  Var SaveMp,Mp:array[1..MaxN] of integer;

  function TryOne:boolean;
   Var i,swap:integer;
    begin
      SaveMp:=Mp;
      for i:=1 to L do
       if Mp[TakeOper[i].a]>Mp[TakeOper[i].b] then
        begin
         {swap them}
         swap:=Mp[TakeOper[i].a];
         Mp[TakeOper[i].a]:=Mp[TakeOper[i].b];
         Mp[TakeOper[i].b]:=swap;
        end;
      {check wheteher operations permutation is sorted}
      for i:=1 to N-1 do if Mp[i]>Mp[i+1] then
        begin
          TryOne:=False;
          Mp:=SaveMp;
          exit;
        end;
      Mp:=SaveMp;
      TryOne:=True;
    end;

 procedure Permut(Nn:integer);
 var Used:array[1..100] of boolean;

 procedure Perm(l:integer);
 var k,i:integer;
     GenMore:boolean;
 begin
   if not(SThem) then exit;
   if l>N then begin;if not(TryOne) then SThem:=false;exit;end;
   for k:=1 to N do
    if Not(used[k]) then
     begin
       used[k]:=true;
       Mp[l]:=k;
      {check if permutation is suitable to init conditions}
      GenMore:=true;
      for i:=1 to Oi do
       if (InitOper[i].a<=l)and(InitOper[i].b<=l) then
        if Mp[InitOper[i].a]>Mp[InitOper[i].b] then
          begin
            GenMore:=false;
            break;
          end;
       if GenMore then Perm(l+1);
       used[k]:=false;
     end;
 end;
 begin
  Fillchar(used,sizeof(used),false);
  Perm(1);
 end;


function SortThemAlways:boolean;
begin
  {Alg : Generate all permutations of N
         Check if the TakeOper operations sorts all of these permutations }
  SThem:=true;
  Permut(N);
  SortThemAlways:=SThem;
end;


procedure TryOperation;
var i:integer;
begin
  If SortThemAlways then
  begin
    for i:=1 to L do write('(',TakeOper[i].a,' ',TakeOper[i].b,') ');
    Writeln(' ->  This is the minimal line of sortments ');
    Halt;{}
  end;
end;

procedure GenLen(i:integer);
var k:integer;
begin
  if i=L+1 then
   begin
     TryOperation;
     exit;
   end;
  for k:=1 to On do
   begin
     TakeOper[i]:=AllOper[k];
     GenLen(i+1);
   end;
end;

begin
  ReadData;
  WriteData;
  for L:=1 to (N*(N-1) div 2) do GenLen(1);
end.