unit USteck;

interface
type TZ=^TZap;
TZap=record
inf:integer;
z:TZ; //указатель на предыдущий элемент стека
end;
type TSteck=class(TObject)
p:Tz; //указатель на вершину стека
Constructor Create(p:Tz) ;
procedure AddSteck(var s:integer);
procedure ReadSteck(s:integer);
procedure ReadNSteck( s:integer);
procedure SortAfter(var w:integer);
procedure Sortinf(w:integer);
end;
const n=10;
implementation
Constructor TSteck.Create;
Begin
Inherited Create;
end;

procedure TSteck.AddSteck(var s:integer); //процедура добавления нового элемента стека
var pt:Tz;
k:integer;
begin
randomize;
for k:=0 to n-1 do
s:=random(100)-50;
new(pt); //выделяем память для нового элемента стека
pt.inf:=s; //записываем новое число в элемент стека
pt.z:=p; //запоминаем указатель на предыдущий элемент стека
p:=pt; //возвращаем этот новый указатель на вершину стека
end;

procedure TSteck.ReadSteck;//процедура извлечения числа из стека с
var pt:Tz; //освобождением памяти
begin
pt:=p; //запоминаем старое значение вершины стека
s:=p.inf; //извлекаем число из текущего элемента стека
p:=p.z; //устанавливаем новый указатель на вершину стека
dispose(pt); //освобождаем память старого элемента стека
end;


procedure TSteck.ReadNSteck;
var i:integer;
begin
i:=1;
while (i<>n) or (p<>nil) do
begin
inc(i);
p:=p.z;
end;
if i=n then s:=p.inf;
end;

//Пузырьковая сортировка стека перестановкой адресов (1)
procedure SortAfter(var w:TZap);
var p,t:TZap;
begin
if (w=nil) or (w.a=nil) then exit;//Пуст или 1 элемент
AddStek(w,0); // Добавляем пустой элемент
t:=nil;
repeat
p:=w;
while p^.a^.a<>t do
begin
if p^.a^.inf>p^.a^.a^.inf then RevAfter(p);
p:=p^.a;
end;
t:=p^.a;
until w^.a^.a=t;
DelLast(w,inf); // Удаляем пустой элемент
end;

//Пузырьковая сортировка стека обменом информации (2)
procedure Sortinf(w:TZap);
var p,t:TZap;
begin
if (w=nil)or(w^.a=nil) then exit;//Пуст или 1 элемент
t:=nil;
repeat
p:=w;
while p^.a<>t do
begin
if p^.inf>p^.a^.inf then Revinf(p);
p:=p^.a;
end;
t:=p;
until w^.a=t;
end;

end.
Соседние файлы в папке положительные и отрицательные,ср аривм,среднеквадрат. разброс
  • #
    15.06.20141.76 Кб10USteck.dcu
  • #
    15.06.20142.24 Кб11USteck.pas
  • #
    15.06.20142.24 Кб10USteck.~pa
  • #
    15.06.20141.41 Кб11USteck.~pas