IPB
ЛогинПароль:

> Внимание! Действует предмодерация

Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.

> Все о динамических структурах данных.
сообщение
Сообщение #1


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Содержание:
Есть материал по теме? высылайте! ваша информация будет размещена здесь!


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Реализация сортировки стека
В приведенной ниже программе содержимое стека mainStack переносится в отсортированном виде в resStack с использованием дополнительного стека tmpStack):
Исходный код
Const maxStack = 100;
Type
TType = Integer;
TStack = Record
stArr: Array[1 .. maxStack] Of TType;
currTop: Integer;
End;

Procedure Init(Var s: TStack);
Begin
s.currTop := 0
End;

Procedure Push(Var s: TStack; x: TType);
Begin
If s.currTop <> maxStack Then
Begin
Inc(s.currTop); s.stArr[s.currTop] := x;
End;
End;

Function Pop(Var s: TStack): TType;
Begin
If s.currTop <> 0 Then
Begin
Pop := s.stArr[s.currTop]; Dec(s.currTop);
End;
End;

Function Top(Var s: TStack): TType;
Begin
Top := s.stArr[s.currTop];
End;

Function IsEmpty(Var s: TStack): Boolean;
Begin
IsEmpty := (s.currTop = 0)
End;

Procedure Print(Var s: TStack);
Var i: Integer;
Begin
For i := 1 To s.currTop Do
Write(s.stArr[i]:4);
WriteLn
End;


Const
n = 10;
arr: Array[1 .. n] Of TType =
(1, 2, 4, 5, 2, 6, 7, 0, 9, 2);

Var
mainStack, resStack, tmpStack: TStack;
i: integer;

begin
Init(mainStack);
Init(resStack);
Init(tmpStack);

For i := 1 To n Do
Push(mainStack, arr[i]);
Print(mainStack);

While not IsEmpty(mainStack) Do
Begin
If IsEmpty(resStack) or (Top(resStack) < Top(mainStack))
Then Push(resStack, Pop(mainStack))
Else
Begin
While (Top(resStack) > Top(mainStack)) and
(not IsEmpty(resStack)) Do
Push(tmpStack, Pop(resStack));
Push(resStack, Pop(mainStack));
While not IsEmpty(tmpStack) Do
Push(resStack, Pop(tmpStack))
End
End;
Print(resStack)
end.


В присоединенном файле - программа сортировки стека
Прикрепленный файл  s_stack.pas ( 1.65 килобайт ) Кол-во скачиваний: 1584


Реализация сортировки очереди
В примере реализуется сортировка очереди (реализованной в виде объекта) без применения дополнительных очередей.
Исходный код
type
ttype = integer;

ptitem = ^titem;
titem = record
data: ttype;
next: ptitem;
end;

tqueue = object
head, tail: ptitem;

constructor init;
destructor done;

procedure put(x: ttype);
function get: ttype;

function empty: boolean;
procedure print;

function get_count: word;
end;


constructor tqueue.init;
begin
head := nil; tail := nil;
end;
destructor tqueue.done;
begin
while empty do get
end;

procedure tqueue.put(x: ttype);
var p: ptitem;
begin
new(p);
p^.data := x; p^.next := nil;
if empty then head := p
else tail^.next := p;
tail := p
end;

function tqueue.get: ttype;
var p: ptitem;
begin
if not empty then
begin
p := head;
head := head^.next;

get := p^.data;
dispose(p);
end
else
begin
writeln('reading from empty queue');
halt(102)
end;
end;

function tqueue.empty: boolean;
begin
empty := not assigned(head)
end;

procedure tqueue.print;
var p: ptitem;
begin
p := head;
write('(queue) <');
while assigned(p) do
begin
write(p^.data, ' ');
p := p^.next
end;
writeln('>')
end;

function tqueue.get_count: word;
var
count: word;
p: ptitem;
begin
p := head; count := 0;
while assigned(p) do
begin
inc(count);
p := p^.next
end;
get_count := count
end;

{ А вот и сама сортировка очереди }
procedure sort(var q: tqueue);
var
i, j, k,
it, it_next: integer;
len: word;
begin
len := q.get_count;
for i := 1 to len do begin
it := q.get;
for j := 1 to len - i do begin
it_next := q.get;
if it > it_next then begin
q.put(it); it := it_next;
end
else
q.put(it_next)
end;

for k := 1 to pred(i) do
q.put(q.get);

q.put(it);
end;
end;

const
test: array[1 .. 10] of integer =
(2, 5, 17, 7, 9, 3, 4, 6, 11, 71);

var
i: integer;
qint: tqueue;

begin
qint.init;

for i := 1 to 10 do
qint.put(test[i]);
qint.print;
sort(qint);
qint.print;

qint.done;
end.
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 19.11.2019 22:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name