Hoán vị của dãy

Cho dãy số nguyên dương đôi một khác nhau: a1,a2,a3,...,an. Một hoán vị của dẫy số là một cách sắp xếp khác các số hạng của dãy. Hãy liệt kê tất cả các hoán vị khác nhau của dãy thỏa mãn điều kiện: Giữa hai phần tử M và N bất kỳ của hoán vị không có phần tử P của hoán vị để 2*P = M + N.
Ví dụ: Với dãy 11 22 33 44 thì hoán vị 33 11 22 44 thỏa mãn điều kiện trên. Hoán vị 11 22 33 44 không thỏa mãn vì có phần tử P =22 nằm giữa M=11 và N=33 mà 22*2=11+33.
Dữ liệu vào: File văn bản 'Hoanviday.INP' chứa 2 dòng, dòng 1 chứa số n ( 1<n<11), dòng 2 chứa các phần tử a1,a2,a3,...,an của dãy ( 0<ai<100)
Dữ liệu ra: File văn bản 'Hoanviday.OUT'. K dòng đầu chứa các hoán vị tìm được, mỗi phần tử cách nhau một dấu cách. Dòng cuỗi cùng ghi số lượng các hoán vị tìm được.
                                                                 Giải
uses crt;
 const
      fi='Hoanviday.INP';
      fo='Hoanviday.OUT';
 var
    n,i,j,tg,k,dem,x,y:integer;
    a: array[1..50] of integer;
    f: text;
    kt: boolean;
 Procedure sort;
           Begin
                For i:=1 to n-1 do
                    For j:=i+1 to n do
                        Begin
                             if a[i]>a[j] then
                                begin
                                     tg:=a[i];
                                     a[i]:=a[j];
                                     a[j]:=tg;
                                end;
                        End;
           End;
 Procedure doi(var p,q:integer);
           var
             tg:integer;
           Begin
                tg:=p;
                p:=q;
                q:=tg;
           End;
 BEGIN
      clrscr;
      assign(f,fi);
      reset(f);
               Readln(f,n);
               For i:=1 to n do Read(f,a[i]);
      close(f);
      Sort;
      assign(f,fo);
      Rewrite(f);
      Repeat
            kt:=true;
            For i:=1 to n-2 do
                for j:=i+2 to n do
                    For k:=i to j do
                        if a[i]+a[j] = 2*a[k] then kt:=false;
            if kt then
               begin
                   For i:=1 to n do Write(f,a[i],' ');
                    Writeln(f);
                    dem:=dem+1;
               end;
            i:=n-1;
            While (i>0) and (a[i]>a[i+1]) do Dec(i);
            if i>0 then
               Begin
                    k:=n;
                    While a[i]>a[k] do Dec(k);
                    doi(a[i],a[k]);
                    x:=i+1;
                    y:=n;
                    While x<y do
                          begin
                               doi(a[x],a[y]);
                               Inc(x);
                               Dec(y);
                          end;
               End;
      Until i=0;
      Write(f,dem);
      close(f);
 END.