Unnamed

//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.