//Robertas Jurkaitis, II kursas, 6 grupe, 5 uzduotis. //5. Igyvendinti ADT heap struktura ir papildyti operacija heap rusiavimas. ADT turi naudoti tik dvipusio saraso operacijas. program DSA_U1; //const left = false; right = true; type DvipSar = ^dvipElem; dvipElem = record info : integer; next : DvipSar; previous : DvipSar; key : integer; // elemK : DvipSar; prpr : DvipSar; //direction : boolean; //links : array [false..true] of DvipSar; end; procedure sukurti(var pradzia, pabaiga : DvipSar; var kiekis : integer); var klaida, info : integer; element, saknis : DvipSar; input : string; begin kiekis := 0; writeln('Iveskite ', kiekis + 1,'-aji saraso elementa. Noredami nutraukti ivedima, rasykite ''stop'''); readln(input); val(input, info, klaida); if klaida = 1 then writeln('Jus ivedete ne skaiciu, prasome ivesti skaiciu') else if (klaida = 0) and (input <> 'stop') then begin new(element); element^.info := info; pradzia := element; pabaiga := element; element^.next := nil; element^.previous := nil; //links[false] := nil; //links[true] := nil; //direction := true; kiekis := kiekis + 1; element^.key := kiekis; end; while input <> 'stop' do begin readln(input); val(input, info, klaida); if klaida = 0 then begin if kiekis >= 1 then begin // insertas(saknis, element); new(element); element^.previous := pabaiga; pabaiga^.next := element; pabaiga := element; element^.info := info; kiekis := kiekis + 1; element^.key := kiekis; end; if (klaida = 1) and (input <> 'stop') then writeln('Jus ivedete ne skaiciu, prasome ivesti skaiciu'); end; end; pradzia^.previous := nil; //writeln(pradzia^.info, ' ', pabaiga^.info); //prpr := pradzia; end; procedure spausdinti(element : DvipSar); begin while element <> nil do begin writeln(element^.key, '. ', element^.info); element := element^.next; end; end; procedure naikinti(pradzia, pabaiga : DvipSar); var element : DvipSar; begin while (pradzia <> nil) do begin element := pradzia; if pabaiga <> pradzia then begin while element^.next <> pabaiga do element := element^.next; pabaiga := element; dispose(element^.next); end else begin dispose(element); pradzia := nil; pabaiga := nil; end; end; end; procedure swap(var elementas1, elementas2 : integer); var temp : integer; begin temp := elementas1; elementas1 := elementas2; elementas2 := temp; end; //procedure insertas(var saknis, element : DvipSar); // { insert a node ( p->node ) into a heap whose root is pointed to by root } // begin // if saknis^.info > element^.info then swap(saknis^.info , element^.info); // saknis^.direction := not saknis^.direction; // if saknis^.links[saknis^.direction] = nil then // saknis^.links[saknis^.direction] := element // else // insert_node_into_heap(saknis^.links[saknis^.direction], element); // end; function getelem(var pradzia : DvipSar; key : integer) : DvipSar; var element : DvipSar; begin element := pradzia; while element <> nil do begin while element^.key <> key do element := element^.next; end; getelem := element; end; procedure heapify(i, kiekis : integer; element : DvipSar); var left, right, maxkey : integer; elemK, elemM, pradzia : DvipSar; begin maxkey := i; left := 2 * i; right := left + 1; getelem(element, i); elemM := element; getelem(element, left); elemK := element; if left <= kiekis then if elemK^.info > elemM^.info then maxkey := left; if right <= kiekis then begin getelem(element, maxkey); elemM := element; if elemK^.next^.info > elemM^.info then maxkey := right; end; if maxkey <> i then begin getelem(element, i); swap(elemM^.info, element^.info); //writeln(element^.info); heapify(i, kiekis, element); //writeln(element^.info); end end; procedure buildheap(var pradzia : DvipSar; kiekis : integer); var i, j : integer; begin j := kiekis; for i := j / 2 downto 1 do heapify(i, kiekis, pradzia); end; procedure heapsort(var pradzia, pabaiga : DvipSar; kiekis : integer); var i : integer; begin buildheap(pradzia, kiekis); for i := kiekis downto 2 do begin pradzia := pabaiga; kiekis := kiekis - 1; heapify(1, kiekis, pradzia); end; end; ////////////////////\\\\\\\\\\\\\\\\\\\\/\/\/\/\/\/\ var pradzia, pabaiga : DvipSar; kiekis : integer; begin writeln('Programa sarase suranda maziausia elementa ir ji pasalina.'); writeln; sukurti(pradzia, pabaiga, kiekis); writeln(''); writeln('Jusu ivestas sarasas: '); spausdinti(pradzia); writeln('tuoj trinsim'); heapsort(pradzia); // naikinti(pradzia, pabaiga); // spausdinti(pradzia); writeln('nutrynem'); readln; end.