Добавил:
Kaz
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:
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.
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.
Соседние файлы в папке положительные и отрицательные,ср аривм,среднеквадрат. разброс