unit procezeni; interface type keytype = integer; item = record key: keytype; { dalsi polozky } end; soubor = file of item; procedure proced(var inp,out:soubor; var count: longint); { procedura kopiruje prvky ze souboru inp do souboru out tak, aby "co nejvice prodlouzila behy" ; vyuziva k tomu dvou heapu ulozenych v poli ; v parametru count vraci pocet behu ve vystupnim souboru out } implementation procedure newrun(var c:longint); { procedura je volana kdyz se zacina vystup dalsiho heapu } begin c:=c+1; end; procedure proced(var inp,out:soubor; var count:longint); const Mpul = 10 ; M = 2*MPUL; {pro procezovani pouzijeme pole delky M } type index = 1..M; var A : array[index] of item; L, R : index; { v poli A budou ulozeny dva heapy dolni A[1..L] prvku, ktere mohou vystoupit do aktualne vytvareneho behu; horni A[L+1..M] prvku; ktere patri az do dalsiho behu } X : item; procedure sift(L,R:index); { predpoklada, ze pole A[L+1]...A[R] je hromada, prida k ni prvek A[L] } var I,J : integer; X : item; begin {of sift} I:=L; J:=2*I; X:=A[I]; while J<=R do begin if JA[J+1].key then J:=J+1; { J je index syna s mensi hodnotou } if X.key<=A[J].key then {uz je to OK} break; A[I]:=A[J]; {postup mensi syna vzhuru} I:=J; J:=2*I; {dale do stromu} end; A[I]:=X; end; {of sift} begin {of proced ] reset(inp); rewrite(out); {otevreni souboru} count:=0; {krok 1 - naplneni horni poloviny heapu } for L:=M downto Mpul+1 do read(inp,A[L]); {krok 2 - doplneni dolni poloviny heapu } for L:=Mpul downto 1 do begin read(inp,A[L]); sift(L,M); end; {krok 3 - prostrkavani pres naplneny heap } newrun(count); L:=M; while not eof(inp) do begin write(out,A[1]); read(inp,X); if A[1].key<=X.key then { X patri do aktualne vytvareneho behu, zaradime ho tedy do spodniho heapu } begin A[1]:=X; sift(1,L); end else { X patri az do pristiho behu, zaradime ho tedy do horniho heapu } begin { posun spodniho heapu } A[1]:=A[L]; sift(1,L-1); {zarazeni do horniho heapu } A[L]:=X; if L0 do begin write(out,A[1]); A[1]:=A[R]; R:=R-1; sift(1,R); end; end {of proced}; end.