All pastes #247833 Raw Edit

Miscellany

public text v1 · immutable
#247833 ·published 2006-11-13 22:29 UTC
rendered paste body
program kolejkastos;
{$APPTYPE CONSOLE}
uses
  SysUtils;

type
    stack = ^Tstack;
   	Tstack = record
  	  	data : integer;
  	  	next : stack;
  	end;

    T_Kolejka = record
      StosA : stack;
      StosB : stack;
    end;

// ========================================================================== //
// Dokladanie elementu na stos:
procedure PushS(Value : integer; var Top : stack);
var
 TempItem : stack;
begin
 TempItem := Top;
 New(Top);
 Top.data := value;
 Top.next := TempItem;
end;

// ========================================================================== //
// Usuwanie elementu ze stosu:
function PopS(var Top : stack; var Val : integer) : boolean;
var
 TempItem : stack;
begin
 if Top <> nil then
 begin
  Val := Top.data;
  TempItem := Top;
  Top := Top.next;
  Dispose(TempItem);
  result := true;
 end
 else
  result := false;
end;

// ========================================================================== //
// Kasowanie stosu:
procedure DestroyS(var Top : stack);
var
 TempItem : stack;
begin
 while (Top <> nil) do
 begin
  TempItem := Top.next;
  Dispose(Top);
  Top := TempItem;
 end;
end;


// ========================================================================== //
// Kopiowanie stosu TopS(Source) na stos TopD(Destination):
procedure CopyS(TopS : stack; var TopD : stack);
var
 TopR : stack;
begin
 TopR := nil;

 while (TopS <> nil) do
 begin
  PushS(TopS.data, TopR);
  TopS := TopS.next;
 end;

 while(TopR <> nil) do
 begin
  PushS(TopR.data, TopD);
  TopR := TopR.next;
 end;

 DestroyS(TopR);
end;

// ========================================================================== //
// Dokladanie elementu do kolejki:
procedure Push(Value : integer; var K1 : T_Kolejka);
begin
 PushS(Value, K1.StosA);
end;

// ========================================================================== //
// Kasowanie elementu z kolejki:
function Pop(var K1 : T_Kolejka; var Value : integer) : boolean;
begin
 CopyS(K1.StosA, K1.StosB);
 if (PopS(K1.StosB, Value)) then
 begin
  result := true;
  DestroyS(K1.StosA);
  CopyS(K1.StosB, K1.StosA);
 end
 else
  result := false;

 DestroyS(K1.StosB);
end;



// ================================= TESTER ================================= //
var
 Kolejka : T_Kolejka;
 Value : integer;
 i, j : integer;

begin
 Randomize;

 WriteLN('=== Testowanie wrzucania 15 elementow do kolejki...');
 for i:=1 to 1 do
 begin
  Value := Random(100);
  Push(Value, Kolejka);
  WriteLN('Na stos wrzucono liczbe ', Value);
 end;
 WriteLN('=== OK.');

 WriteLN('=== Testowanie wrzucania 5 elementow z kolejki...');
 for i:=1 to 5 do
 begin
  if Pop(Kolejka, Value) = true then
   WriteLN('Z kolejki zdjeto liczbe: ', Value)
  else
   WriteLN('Brak elementow do zdjecia z kolejki.');
 end;
 WriteLN('=== OK.');



 WriteLN('=== Testowanie zakonczono pomyslnie.');
 ReadLN;
end.