Все о динамических структурах данных. |
Все о динамических структурах данных. |
Altair |
4.10.2004 6:07
Сообщение
#1
|
Ищущий истину Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: 45 |
Содержание:
-------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
volvo |
28.01.2005 20:53
Сообщение
#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 килобайт ) Кол-во скачиваний: 1691 Реализация сортировки очереди В примере реализуется сортировка очереди (реализованной в виде объекта) без применения дополнительных очередей. Исходный код 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. |
Текстовая версия | 27.05.2024 4:02 |