Последовательность натуральных чисел

🕛 15.06.2009, 14:36

{ Бэк-трекинг: Последовательность }
{-}
{ Дана последовательность натуральных чисел (значение каждого числа }
{ от 1 до 1000). После-довательность может быть не отсортирована. }
{ Надо найти вариант самой большой (по количеству элементов) неубывающей }
{ последовательности, составленной из чисел этого ряда. Порядок включения }
{ чисел в неубывающую последовательность должен соответствовать порядку }
{ следования чисел в первоначальной последова-тельности. Иными словами, }
{ числа с большими номерам и в новой последовательности размещаются правее }
{ чисел с меньшими номерами. }
{ }
{ Входные данные: файл SEQ.IN в 1-й строке содержит количество чисел в }
{ последовательности - N (1<=N<=100). }
{ Со 2-й строки и далее указан ряд чисел, каждое число размещается на }
{ новой строке. Поиск ошибок в файле не требуется, входные данные }
{ корректны. }
{ }
{ Выходные данные: }
{ В файле SEQ.OUT помещаются выходные данные. }
{ 1-я строка содержит длину максимальной неубыващей последовательности. }
{ 2-я строка и далее - пример такой последовательности, каждое число в }
{ порядке следования размещается на новой строке. }
{ }
{ Пример возможного теста: }
{ }
{ Файл "SEQ.IN" Файл "SEQ.OUT" }
{ 12 7 }
{ 59 4 }
{ 4 21 }
{ 21 27 }
{ 36 34 }
{ 18 45 }
{ 27 47 }
{ 79 93 }
{ 34 }
{ 45 }
{ 47 }
{ 34 }
{ 93 }
{-}

{$M $8000,0,$4ffff} (* последовательность, Никитин *)

Const MaxItem = 100; TimeLimit = 29*18; {29 sec}
var Numbers, Seq, Best: array[1..MaxItem] of integer; pc,maxpc,num:integer; timer:longint absolute $0040:$006C; jiffy:longint;

Procedure Init;
var i:integer;
begin jiffy:=timer; fillchar(Numbers, Sizeof(Numbers),#0); Seq:=Numbers; Best:=Numbers; pc:=0; maxpc:=0; assign(input,'seq.in'); reset(input); readln(num); if num>MaxItem then num:=MaxItem; for i:=1 to num do readln(Numbers[i]); close(input);
end;

Procedure Done;
var i:integer;
begin assign(output,'seq.out'); rewrite(output); writeln(maxpc); for i:=1 to maxpc do writeln(Best[i]); close(output);
end;

procedure StoreChain;
begin if (pc>maxpc) then begin Best:=Seq; maxpc:=pc; if (maxpc=num) then begin Done; Halt(0); end; end;
end;

function testFWD(i:integer):integer;
var m:integer;
begin m:=Numbers[i]; inc(i); while (i<=num) and (m>Numbers[i]) do inc(i); if i>num then testFWD:=0 else testFWD:=i;
end;

procedure solution(n:integer); { Основная процедура }
var i,s:integer;
begin if ((timer-jiffy)>TimeLimit) then exit; i:=testFWD(n); if (i=0) then begin StoreChain; end else begin inc(pc); {проверили этот путь} Seq[pc]:=Numbers[i]; solution(i); dec(pc); {идем по другому} s:=Numbers[i]; Numbers[i]:=-1; {вычеркнули} solution(n); Numbers[i]:=s; {вернули} end;
end;

var index:integer;
begin Init; index:=1; repeat pc:=1; Seq[pc]:=Numbers[index]; solution(index); while (index<=num) and (Numbers[index]>=Seq[pc]) do inc(index); until (index>num); Done;
end.