program DSA_U1; type DvipSar = ^dvipElem; dvipElem = record info : integer; next : DvipSar; previous : DvipSar; key : integer; end; procedure sukurti(var pradzia, pabaiga : DvipSar; var kiekis : integer); var klaida, info, ct : integer; laikinas : 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(laikinas); laikinas^.info := info; pradzia := laikinas; pabaiga := laikinas; laikinas^.next := nil; laikinas^.previous := nil; kiekis := kiekis + 1; ct := 1; end; while input <> 'stop' do begin writeln('Iveskite ', kiekis + 1,'-aji saraso elementa. Noredami nutraukti ivedima, rasykite ''stop'''); readln(input); val(input, info, klaida); if klaida = 0 then begin if kiekis >= 1 then new(laikinas); laikinas^.next := pradzia; pradzia := laikinas; laikinas^.next^.previous := pradzia; laikinas^.info := info; ct := ct + 1; laikinas^.key := ct; kiekis := kiekis + 1; end else if (klaida = 1) and (input <> 'stop') then writeln('Jus ivedete ne skaiciu, prasome ivesti skaiciu'); end; pradzia^.previous := nil; //writeln('kgahjkglajg ', laikinas^.info); end; procedure spausdinti(laikinas : DvipSar); begin // laikinas := pradzia; while laikinas <> nil do begin writeln(laikinas^.info); laikinas := laikinas^.previous; end; end; procedure swap(elementas1, elementas2 : DvipSar); var temp : integer; begin temp := elementas1^.info; elementas1^.info := elementas2^.info; elementas2^.info := temp; end; //procedure siftDown(laikinas : DvipSar; start, endz : integer) //var root, a, b : integer; //input: end represents the limit of how far down the heap //begin // to sift. // root := laikinas^.pradzia^.key; // laikinas := pradzia; // while root * 2 + 1 <= endz do //(While the root has at least one child) // begin // a := laikinas^.info; // b := laikinas^.next^.info; // child := root * 2 + 1 //(root*2+1 points to the left child) // // (If the child has a sibling and the child's value is less than its sibling's...) // if (child < endz) and (a < b) then // begin // laikinas := laikinas^.next; //(... then point to the right child instead) // end // if pradzia^.info < laikinas^.info then //(out of max-heap order) // begin // swap(laikinas^.pradzia^.info, laikinas^.info); // //pradzia^.info := laikinas^.info; //(repeat to continue sifting down the child now) // end //end; //procedure heapSort(laikinas : DvipSar; kiekis : integer); //var endz : integer; //begin // heapify(pradzia, kiekis); // // endz := kiekis - 1; // while endz > 0 do // //(swap the root(maximum value) of the heap with the last element of the heap) // swap(a[endz], a[0]) // //(decrease the size of the heap by one so that the previous max value will // //stay in its proper placement) // endz := endz - 1 // //(put the heap back in max-heap order) // siftDown(a, 0, endz) //end; //procedure heapify(laikinas : DvipSar, kiekis : integer) //var integer : start; // (start is assigned the index in a of the last parent node) //begin // start := kiekis / 2 - 1 // // while start >= 0 do // begin // // (sift down the node at index start to the proper place such that all nodes below // // the start index are in heap order) // siftDown(pabaiga, start, kiekis-1) // start := start - 1 // //(after sifting down the root all nodes/elements are in heap order) // end; //end; procedure heapify(laikinas : DvipSar; kiekis : integer); var laponr, l, r, largest : integer; begin l:=1; r:=1; while laikinas <> nil do begin if (l <= kiekis) and laikinas^.larg > laikinas^. //////////////////// 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(pabaiga); //spausdinti(pirmas, kiekis); readln; end.