All pastes #734314 Raw Edit

Stuff

public text v1 · immutable
·published 2007-10-12 16:22 UTC
rendered paste body
//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;

type DvipSar = ^dvipElem;
     dvipElem = record
                    info : integer;
                    next : DvipSar;
                    previous : DvipSar;
                    key : integer;
                end;


procedure spausdinti(element : DvipSar);
begin
    while element <> nil do
    begin
        writeln(element^.key, '. ', element^.info);
        element := element^.next;
    end;
end;


procedure naikinti(var pradzia, pabaiga : DvipSar);
var element : DvipSar;
begin
    while (pradzia <> nil) do
    begin
        element := pradzia;
        if pabaiga <> pradzia then
        begin
            while element^.next <> pabaiga do
            begin
                element := element^.next;
                pabaiga := element;
                dispose(element^.next);
            end;
        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;


function getelem(element : DvipSar; key : integer) : DvipSar;
var i : integer;
begin
    //writeln(element^.info, '<--cia pradzia');
    for i := 1 to key-1 do
    begin
        if element^.next <> nil then //begin
        //writeln('blblblaaaaa');
        element := element^.next;
        //writeln('shit stinks ', element^.info);  end;
    end;
    getelem := element;
end;


procedure heapify(i, kiekis : integer; var pradzia : DvipSar);
var left, right, maxkey : integer;
    elemLeft, elemRoot, elemRight, element, elemMax : DvipSar;

begin
    maxkey := i;
    left := 2 * i;
    right := left + 1;
    element := getelem(pradzia, i);;

    elemRoot := element;

    element := getelem(pradzia, left);

    elemLeft := element;
    writeln('tararara');
    spausdinti(pradzia);
    if left <= kiekis then
    if elemLeft^.info > elemRoot^.info then maxkey := left
                                       else maxkey := i;
    if right <= kiekis then
    begin
        element := getelem(pradzia, right);
        elemRight := element;
        element := getelem(pradzia, maxkey);
        elemMax := element;
        if elemRight^.info > elemMax^.info then maxkey := right;
    end;
    
    if maxkey <> i then
    begin
        //getelem(pradzia, i);
        swap(elemRoot^.info, elemMax^.info);
        writeln('asdadagg');
        element := getelem(pradzia, maxkey);
        writeln('chchchchc');
        elemMax^.key := maxkey;
        writeln('muumumu');
        heapify(i, elemMax^.key, pradzia);
        writeln('wtfwtfwtf');
        //writeln(element^.info);
    end
end;


procedure buildheap(var element : DvipSar; kiekis : integer);
var i : integer;
    el : DvipSar;
begin
    //writeln('asdadzzzz', element^.info);
    //element := getelem(element, 5);
    //writeln('asdadzzzz', element^.info);
    while element^.next <> nil do
    begin
        element := element^.next;
        heapify(i, kiekis, element);
    end;
    for i := (kiekis div 2) downto 1 do heapify(i, kiekis, element);
end;


//procedure heapsort(var pradzia, pabaiga : DvipSar; kiekis : integer);
//var i : integer;
//begin
//    buildheap(pradzia, kiekis);
//    for i := kiekis downto 2 do
//    begin
//        swap(pradzia^.info, pabaiga^.info);
//        kiekis := kiekis - 1;
//        heapify(1, kiekis, pradzia);
//    end;
//end;

//\\//\\//\\//\\//\\ MAIN //\\//\\//\\//\\//\\

var pradzia, pabaiga, element : DvipSar;
    kiekis, i, klaida, info : integer;
    input : string;

begin
    writeln('Programa igyvendina HEAP ir HEAPSORTA saraso pagalba. Rusiuojamu duomenu tipas - integer');
    writeln;

    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;
        kiekis := kiekis + 1;
        element^.key := kiekis;
    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
            begin
                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('');
    writeln('Jusu ivestas sarasas: ');
    spausdinti(pradzia);
    writeln('tuoj trinsim');
//    heapify(i, kiekis, pradzia);
    spausdinti(pradzia);
    buildheap(pradzia, kiekis);
//    heapsort(pradzia);
//    naikinti(pradzia, pabaiga);
//    spausdinti(pradzia);
    spausdinti(pradzia);
    writeln('nutrynem');
    readln;
end.