Программа о подстановках Опции

[K Y S K A]

Помогите чего-то не компилируется, а задача: вывести на экран подстановки из н элементов.

Program PODSTANOVKI;

var n: longint;
    a: array [1..100]

{-*-*-*-*-*-*-*-*-*-*-*-*-}

procedure see(n:longint);
var i : longint;
Begin
     For i := 1 to n do
         write(a[i]);
end;

{-*-*-*-*-*-*-*-*-*-*-*-*-}

procedure Fill(n: longint);
var i :longint;
begin
     for i:= 1 to n do
     a[i]:=i;
end;

{-*-*-*-*-*-*-*-*-*-*-*-*-}

procedure perstanovka(j: longint);
var       i,k,m:longint;
          predel:boolean;
          nomer:longint;
Begin
     if j = 0 then
         Fill(n)
     else
         perestanovka(j-1);
     predel:=false;
     for i:= n downto 1 begin
         if a[i]=n then begin
            predel:=true;
            nomer:=i;
         end;
     end;
     If predel then begin
         a[nomer-1] := a[nomer-1] + 1;
         a[nomer] := a[nomer-1]-1;
         a[nomer+1] := a[nomer]+2;
                    for i:= (nomer+2) to n do
                        a[i]:=a[i-1}+1;
     end
     else
         a[n]:=a[n] +1;
     see(n);
end;

{-*-*-*-*-*-*-*-*-*-*-*-*-}

function factorial(m:longint):longint;
begin
     factorial(1):=1;
     factorial:=factorial(m-1)*m:
end;

{-*-*-*-*-*-*-*-*-*-*-*-*-}

begin
     read(n);
     perestanovki(factoreal(n));
end.

[volvo]

А с чего это она должна компилироваться?

    a: array [1..100]

неполное описание... Это не Бейсик, а Паскаль, нужно типы указывать...

+ Perestanovka в названии функции

+ ошибки в самой логике программы...

[K Y S K A]

Я уже исправила, для н=6 не работает!!!!

Программа для всех н до 5 работает, а для н=6 и более нет, что больше lONGINTа??????

черт, не работает и для 4, но как это исправить????

Сообщение отредактировано: K Y S K A - 8.12.2005 1:11

[volvo]

K Y S K A, ну я же говорил -

ошибки в самой логике программы...

Вот так рекурсивно генерируются перестановки (работает для любого N, конкретно здесь - до 20)

const
  n: integer = 3;

var
  a: array[0 .. 20] of longint;

procedure print(T: integer);
var i: integer;
begin
  for i := 1 to T do write(a[i]:3);
  writeln
end;

procedure swap(var a, b: integer);
var T: integer;
begin T := a; a := b; b := T end;

procedure solve(T: integer);
var i: integer;
begin
  if T >= n then print(t)
  else
    for i := T + 1 to n do begin
      swap(a[T+1], a[i]);
      solve(T+1);
      swap(a[t+1], a[i])
    end
end;

var i: integer;
begin
  readln(n);
  
  for i := 1 to n do a[i] := i;
  solve(0)
end.