Autors: doc.Guntis Arnicāns

1. Steka reprezentācija nepārtrauktā atmiņā.

function MakeEmptyStack(): pointer

L¬NewCell(Stack)

Length(L)¬0

return L

function IsEmpty Stack(pointer L): boolean

return Length(L)=0

function Top(pointer L): info

if IsEmptyStack(L) then error

else return Infos(L)[Length(L)-1]

function Pop(pointer L): info

if Length(L)=0 then error

else

x¬Top(L)

Length(L)¬Length(L)-1

return x

procedure Push(info x, pointer L):

if Length(L)=N then error

else

Length(L)¬Length(L)+1

Infos(L)[Length(L)-1]¬x

2. Rindas reprezentācija nepārtrauktā atmiņā.

function MakeEmpty Queue(): pointer

L¬NewCell(Queue)

Front(L)¬0

Length(L)¬0

return L

function IsEmpty Queue(pointer L): boolean

return Length(L)=0

function Dequeue(pointer L): info

if IsEmptyQueue(L) then error

else

x¬Infos(L)[Front(L)]

Front(L)¬(Front(L)+1) mod N

Length(L)¬Length(L)-1

return x

procedure Enqueue(info x, pointer L):

if Length(L)=N then error

else

Length(L)¬Length(L)+1

Infos(L)[Front(L)+Length(L)-1) mod N]¬x

procedure Front(pointer L):

if IsEmptyQueue(L) then error

else return Infos(L)[Front(L)]

3. Steka reprezentācija saistītā atmiņā.

function MakeEmptyStack(): pointer

return L

function IsEmpty Stack(pointer L): boolean

return L=L

function Top(pointer L): info

if IsEmptyStack(L) then error

else return Info(L)

function Pop(locative L): info

if IsEmptyStack(L) then error

else

x¬Top(L)

LÜNext(L)

return x

procedure Push(info x, locative L):

P¬NewCell(Node)

Info(P)¬x

Next(P)¬L

LÜP

4. Rindas reprezentācija saistītā atmiņā.

function MakeEmptyQueue(): pointer

L ¬ NewCell(Queue)

Front(L) ¬ Back(L) ¬ L

return L

function IsEmptyQueue(pointer P): boolean

return Front(L) = L

procedure Enqueue(info x, pointer L):

P ¬ NewCell(Node)

Info(P) ¬ x

Next(P) ¬ L

if IsEmptyQueue(L) then Front(L) ¬ P

else Next(Back(L)) ¬ P

Back(L) ¬ P

function Dequeue(pointer L): info

if IsEmptyQueue(L) then error

else

x ¬ Info(Front(L))

Front(L) ¬ Next(Front(L))

if Front(L) = L then Back(L) ¬ L

return x

function Front(pointer L): info

if IsEmptyQueue(L) then error

else return Info(Front(L))

5. Saraksta apstaigāšana.

procedure Traverse(pointer P)

while P¹L do

Visit(Key(P))

P¬Next(P)

6. Algoritmu shēmas apstaigāšanai ar saišu inversiju:

Start Traversal(L): Forward(P,Q): Back(P,Q):

Dubultsaišu saraksts.

procedure DoublyLinkedInsert(pointer P,Q):

{iespraust mezglu, uz kuru norāda P, tieši pēc mezgla, uz kuru norāda Q}

procedure DoublyLinkedDelete(pointer P):

{izmest mezglu, uz kuru norāda P}

7.
Aritmētiku izteiksmi, kas reprezentēta ar koku, var izrēķināt ar funkciju Evaluate.

function Evaluate(pointer P): integer

{ Atdod aritm. izteiksmes, kas reprezentēta ar koku P, vērtību}

if IsLeaf(P) then return Label(P)

else

xl ¬Evaluate(LeftChild(P))

xr¬Evaluate(RightChild(P))

op¬Label(P)

return ApplyOp(op, xl, xr)

Label(v) atdod informāciju, kas piekārtota mezglam v.

ApplyOp(op, x, y) atdod rezultātu pielietojot operāciju op argumentiem x un y.

8. Izteiksmes, kas pierakstīta poļu pierakstā, izpildes algoritms:

procedure PostorderEvaluate(E array[1..n]): integer

{izteiksme ir masīvā a}

for i from 1 to n do

if E[i] ir skaitlis then ielikt to stekā

else

Izņem divus skaitļus no steka

Pielieto tiem operatoru E[i],

kur labais operands skaitlis,

kuru no steka izņēma pirmo

Ieliek rezultātu stekā.

9. Koka apstaigāšana.

procedure Postorder(pointer P):

foreach child Q of P, in order, do

Postorder(Q)

Visit(P)

procedure Preorder(pointer P):

Visit(P)

foreach child Q of P, in order, do

Preorder(Q)

procedure Inorder(pointer P):

{P ir bināra koka sakne}

if P=L then return

else

Inorder(LeftChild(P))

Visit(P)

Inorder(RightChild(P))

10. Apstaigāšana ar saišu inversiju.

procedure LinkInversionTraversal(pointer Q):

{ Pointeris Q norāda uz apstaigājamā koka sakni}

P=L

repeat forever

{Dilst, cik vien var pa kreisi (iespējams, ka vispār nedilst)}

while Q¹L do

PreVisit(Q)

Tag(Q)¬0

descend to left

{Pieaug, cik vien iespējams no labās (iespējams, ka nepieaug)}

while P¹L and Tag(P)=1 do

ascend from right

PostVisit(Q)

if P=L then return {Ja pavadošais pointeris ir L , tad viss}

else {Pieaug no kreisās, dilst uz kreiso, un atkārto}

ascend from left

InVisit(Q)

Tag(Q)¬1

descend to right

descend to left: descend to right:

ascend from left: ascend from right:

11. Koka skanēšana konstantā telpā.

procedure Constant SpaceScan(pointer Q):

{G ir atšķirošā vērtība; sākotnēji Q norāda uz koka sakni}

P¬G

while Q¹G do

if Q¹L then

Visit(Q)

else

P«Q

12. Meklēšana plašumā (Breadth-First search).

procedure BreathFirstSearch(graph G,vertex v):

{Meklēšana grafā G sākas ar virsotni v.}

foreach vertex w in G do Encountered(w)¬false

{Q ir rinda, kurā glabājas sasniegtās, bet neapmeklētās virsotnes}

Q¬MakeEmptyQueue()

Encountered(v)¬true

Enqueue(v,Q)

until IsEmptyQueue(Q) do

{Apstrādā nākošo virsotni}

w¬Dequeue(Q)

Visit(w)

foreach neighbor w'of w do

if not Encountered(w') then

Encountered(w')¬true

Enqueue(w',Q)

13. Meklēšana dziļumā (Depth-First search).

procedure DepthFirstSearch(graph G,vertex v):

{Meklēšana grafā G sākas ar virsotni v.}

foreach vertex w in G do Encountered(w)¬false

RecursiveDFS(v)

procedure RecursiveDFS(vertex v):

Encountered(v)¬true

Previsit(v)

foreach neighbor w of v do

if not Encountered(w) then RecursiveDFS(w)

PostVisit(v)

14. Topoloģiskā kārtošana.

procedure TopologicalSort(graph G):

{G ir grafs, kas ir jāsakārto}

nextnumber ¬ |G|

foreach vertex v in G do Encountered(v) ¬ false

foreach vertex v in G do

if not Encountered(v) then WalkForSort(v)

procedure WalkForSort(vertex v):

Encountered(v) ¬ true

foreach neighbor w of v do

if not Encountered(w) then WalkForSort(w)

Number(v) ¬ nextnumber

nextnumber ¬ nextnumber - 1

procedure InsertionSort(table A[0..n-1])

{Kārto, iespraužot katru elementu kādā pozīcijā pa kreisi}

for i from 1 to n-1 do

j ¬ i { j iet pa kreisi, kamēr atrod A[i] vietu}

x ¬ A[i]

while j>=1 and A[j-1]>x do

A[j] ¬ A[j-1]

j ¬ j-1

A[j] ¬ x

15. Šella algoritms.

procedure ShellSort(table A[0..n-1]):

{Kārtošana ar aprēķinātu soļu virkni }

inc ¬ InitialInc(n)

while inc >= 1 do

for i from inc to n-1 do

j ¬ i

x ¬ j-inc

while j >= inc and A[j-inc] > x do

A[j] ¬ A[j-inc]

j ¬ j - inc

A[j] ¬ x

inc ¬ NextInc(inc,n)

16. Kārtošana ar izvēli.

procedure SelectionSort(table A[0..n-1]):

{Kārto tabulu A atkārtoti izvēloties mazāko elementu no nesakārtotās daļas.}

for i from 0 to n-2 do

j¬i {j būs mazākā elementa indekss masīvā A[0..n-1] }

for k from i+1 to n-1 do

if A[k]then j¬k

A[i]«A[j]

Kaudze (Heap).

procedure HeapDeleteMin(heap h): info

{Izmet elementu ar vismazāko prioritāti no kaudzes h un atdod to. h ir raksts ar diviem laukiem - tabulu H=Table(h) un tās tekošo garumu n=Size(h). Daļēji sakārtots koks ir noglabāts tieši tabulā H[0..N-1], kur, N ir kaudzes maksimālais izmērs.}

H¬Table(h)

n¬Size(h)

if n=0 then error {Kaudze ir tukša. }

I¬Info(H[0]) {Elements, kuru atdos. }

K¬Key(H[n-1]) {Elementa, kuru pārvietos, prioritāte.}

m¬0 {m ir "pointeris", kas iet caur koku.}

while 2m+1and K>Key(H[2m+1])

or 2m+2and K>Key(H[2m+2]) do

if 2m+2then {Mezglam m ir divi bērni.}

if Key(H[2m+1])then

p¬2m+1

else

p¬2m+2

else {Mezglam m ir tikai viens bērns,

pēdējā lapa kokā.}

p¬n-1

H[m]¬H[p] {Pārvieto bērnu uz augšu.}

m¬p {Pārvieto pointeri uz leju.}

H[m]¬H[n-1] {Beidzot pārvieto elementu

uz viņa pozīciju.}

Size(h)¬n-1 {Jaunais kaudzes izmērs.}

return I

procedure HeapInsert(key K, info I, heap h):

{Pievieno pāri kaudzei h.}

H¬Table(h)

n¬Size(h)

if n=N then error {Kaudze ir pilna. }

m¬n {m ir "pointeris", kas pārvietojas

augšup pa koka zaru.}

while m>0 and Kë(m-1)/2û]) do

H[m]¬H[ë(m-1)/2û]

m¬ë(m-1)/2û {Tas ir, m¬Parent(m).}

Key(H[m])¬K; Info(H[m])¬I {Pārvieto elementu uz

viņa vietu.}

Size(h)¬n+1

17. Kārtošana ar kaudzi (Heap Sort).

procedure HeapSort (table A[0 .. n-1]):

{Kārto, pārvēršot A par kaudzi un atkārtoti izvēloties mazāko elementu.}

InitializeHeap(A[0 .. n-1])

for i from 0 to n-2 do

A[i]«A[n-1]

Heapify(A[i+1 .. n-1])

procedure InitializeHeap (table A[0 .. n-1]):

{Pārvērš A par kaudzi.}

for i from 1 to n-1 do Heapify(A[0 .. i])

procedure Heapify(table A[i .. j]):

{ Sākumā A[i .. j - 1] ir daļēji sakārtots}

{ Beigās A[i .. j ir daļēji sakārtots}

if RC(j) >= i and A[RC(j)] <= A[LC(j)] and A[RC(j)] < A[j] then

A[j]«A[RC(j)]

Heapify(A[i .. RC(j)])

else if LC(j) >= i and A[LC(j)] < A[j] then

A[j]«A[LC(j)]

Heapify(A[i .. LC(j)])

18. Kārtošana ar sapludināšanu (Merge Sort).

procedure MergeSort (table T[a.. b]):

{Rekursīvi kārto T, lai T[i] £ T[i+1] katram a £ i < b.}

if a ³ b then return

middle ¬ ë(a + b) / 2û

MergeSort ( T[a..middle])

MergeSort ( T[middle+1..b])

Merge ( T[a..middle],T[middle+1..b])

19. Ātrā kārtošana (Quick Sort).

procedure QuickSort(table T[l.. r]):

{Kārto A[l..r]. Visaugstākais izsaukums būs QuickSort (A[0..n-1]).}

if lthen

i¬l {i iet no kreisās, meklējot elementus ³ par centru .}

j¬r+1 {j iet no labās, meklējot elementus £ par centru .}

v¬A[l] {v ir centra elements.}

while ido

i¬i+1

while i£r and A[i]do i¬i+1

j¬j-1

while j³l and A[j]>v do j¬j-1

A[i]«A[j]

A[i]«A[j] {Izlabo lieko apmaiņu ieprekšējā cikla beigās.}

A[j]«A[l] {Pārvieto centra elementu uz tam piemērotu vietu.}

QuickSort (A[l..j-1])

QuickSort (A[j+1..r])

20. Bucket Sort.

procedure BucketSort(table A[0..n-1]

{ A ir pointeru uz rakstiem masīvs, kas jāsakārto pēc to atslēgas laukiem.}

{S[0..n-1] ir kopu masīvs.}

for i from 0 to N-1do S[i]¬MakeEmptySet()

for j from 0 to n-1do Insert(A[j],S[Key(A[j])])

j¬0

for i from 0 to N-1do

until IsEmptySet(S[i]) do

x¬any memeber of S[i]

Delete(x,S[i])

A[j]¬x

j¬j+1

21. Radix Sort.

procedure RadixSort (table A[0..n-1]):

{A ir kārtojamais pointeru masīvs.}

{S[0..N-1] ir rindu tabula.}

for i from 0 to N-1do S[i] ¬ MakeEmptyQueue()

for k from 0 to K-1do

for j from 0 to n-1do Enqueue(A[j], S[Keyk(A[j])])

j ¬ 0

for i from 0 to N-1do

until IsEmptySet(S[i]) do

A[j]¬Dequeue(S[i])

j ¬ j+1

22. Binārā meklēšana.

function BinarySearchLookUp(key K, table T[0..n-1]): info

{Atdod informāciju, kas noglabāta T ar atslēgu K, vai L, ja K nepieder T.}

Left¬0

Right¬n-1

repeat forever

if Rightthen

return L

else

Middle¬ë(Left+Right)/2û

if K=Key(T[Middle]) then

return Info(T[Middle])

else

if K<Key(T[Middle]) then

Right¬Middle-1

else

Left¬Middle+1

23. Interpolējošā meklēšana.

function InterpolationSearchLookUp(key K, table T[0..n-1]): info

{Atdod informāciju, kas noglabāta sakārtotā tabulā T ar atslēgu K, vai L, ja K nav tabulā. Algoritmā pieņemts, ka tabulas pozīcijas T[-1] un T[n] ir pieejamas. }

Key(T[-1]) ¬ -1

Key(T[n]) ¬ N

Left ¬ 0

Right ¬ n - 1

repeat forever

if Right < Left then

return L

else

Middle ¬ ëp * (Right - Left + 1) û + Left

if K = Key(T[Middle]) then

return Info(T[Middle])

else

if K < Key(T[Middle]) then

Right ¬ Middle - 1

else

Left ¬ Middle + 1

24. Binārie meklēšanas koki.

function BinaryTreeLookUp(key K, pointer P): info

{ Atrod atslēgu K kokā P, izmantojot rekusīvo meklēšanu, un atdod tās Info. }

{ Atdod L, ja nav šāda raksta. }

if P = L then

return L

else

if K = Key(P) then

return Info(P)

else

if K < Key(P) then

return BinaryTreeLookUp(K, LC(P))

else

return BinaryTreeLookUp(K, RC(P))

function BinaryTreeLookUp(key K, pointer P): info

{ Atrod atslēgu K kokā P, izmantojot iteratīvo meklēšanu, un atdod tās Info. }

{ Atdod L, ja nav šāda raksta. }

while P ¹ L do

if K = Key(P) then

return Info(P)

else

if K < Key(P) then

P ¬ LC(P)

else

P ¬ RC(P)

return L

25. Binārais koks

procedure BinaryTreeInsert(key K, info I, locative P):

{ Sākotnēji P ir lokatīvs, kas norāda uz koka sakni. }

while P ¹ L do

if K = Key(P) then

Info(P) ¬ I

return

else

if K < Key(P) then

P ¬ LC(P)

else

P ¬ RC(P)

{ Radam jaunu mezglu un pievienojam kā lapu. }

Q ¬ NewCell(Node)

Key(Q) ¬ K; Info(Q) ¬ I

LC(Q) ¬ RC(Q) ¬ L

P Ü Q

procedure BinaryTreeDelete(key K, locative P):

{ K ir atslēga izmetamajam elementam }

{ Sākotnēji P ir lokatīvs, kas norāda uz koka sakni. }

while P ¹ L and Key(P) ¹ K do

if K < Key(P) then P ¬ LC(P) else P ¬ RC(P)

if P = L then return

if RC(P)=L then PÜLC(P)

else {Lokatīvs P norāda uz izmetamo virsotnu.}

{Meklē pēcteci inorder kārtībā.}

Q¬RC(P)

while LC(Q)¹L do Q¬LC(Q)

{Aizvieto izmetamo virsotni P ar tās inorder pēcteci Q, un izmet šo mezglu. }

Pielikums (sortēšanas kodi Paskālā 7.0)

1. BinaryInsertionSort

2. BubbleSort

3. CombSort

4. HeapSort

5. QuickSort

6. QuickSortNonRecursive

7. ShakerSort

8. ShellSort

9. StraightInsertionSort

10. StraightSelectionSort

11. TreeSort

UNIT TVSorts;

USES Objects;

TYPE

TCompareFunction = FUNCTION (Item1, Item2 : Pointer) : Integer;

{ A TCompareFunction must return: }

{ 1 if the Item1 > Item2 }

{ 0 if the Item1 = Item2 }

{ -1 if the Item1 < Item2 }

TSortProcedure = PROCEDURE (ACollection : PCollection;

Compare : TCompareFunction);

{ Sort Procedures }

PROCEDURE BinaryInsertionSort (ACollection : PCollection;

Compare : TCompareFunction);

PROCEDURE BubbleSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE CombSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE HeapSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE QuickSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE QuickSortNonRecursive (ACollection : PCollection;

Compare : TCompareFunction);

PROCEDURE ShakerSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE ShellSort (ACollection : PCollection; Compare : TCompareFunction);

PROCEDURE StraightInsertionSort (ACollection : PCollection;

Compare : TCompareFunction);

PROCEDURE StraightSelectionSort (ACollection : PCollection;

Compare : TCompareFunction);

PROCEDURE TreeSort (ACollection : PCollection; Compare : TCompareFunction);

{ Compare Procedures - Must write your own Compare for pointer variables. }

{ This allows one sort routine to be used on any array. }

FUNCTION CompareChars (Item1, Item2 : Pointer) : Integer; FAR;

FUNCTION CompareInts (Item1, Item2 : Pointer) : Integer; FAR;

FUNCTION CompareLongInts (Item1, Item2 : Pointer) : Integer; FAR;

FUNCTION CompareReals (Item1, Item2 : Pointer) : Integer; FAR;

FUNCTION CompareStrs (Item1, Item2 : Pointer) : Integer; FAR;

{****************************************************************************}

IMPLEMENTATION

{****************************************************************************}

{ }

{ Local Procedures and Functions }

{ }

{****************************************************************************}

PROCEDURE Swap (ACollection : PCollection; A, B : Integer);

VAR Item : Pointer;

BEGIN

Item := ACollection^.At(A);

ACollection^.AtPut(A,ACollection^.At(B));

ACollection^.AtPut(B,Item);

END;

{****************************************************************************}

{ }

{ Global Procedures and Functions }

{ }

{****************************************************************************}

PROCEDURE BinaryInsertionSort (ACollection : PCollection;

Compare : TCompareFunction);

VAR i, j, Middle, Left, Right : LongInt;

BEGIN

FOR i := 0 TO (ACollection^.Count - 1) DO

BEGIN

Left := 0;

Right := i;

WHILE Left < Right DO

BEGIN

Middle := (Left + Right) DIV 2;

WITH ACollection^ DO

IF Compare(At(Middle),At(i)) < 1

THEN Left := Middle + 1

ELSE Right := Middle;

END;

FOR j := i DOWNTO (Right + 1) DO

Swap(ACollection,j,j-1);

END;

{****************************************************************************}

PROCEDURE BubbleSort (ACollection : PCollection; Compare : TCompareFunction);

VAR i, j : Integer;

BEGIN

WITH ACollection^ DO

FOR i := 1 TO (Count - 1) DO

FOR j := (Count - 1) DOWNTO i DO

IF Compare(At(j-1),At(j)) = 1

THEN Swap(ACollection,j,j-1);

END;

{****************************************************************************}

PROCEDURE CombSort (ACollection : PCollection; Compare : TCompareFunction);

{ The combsort is an optimised version of the bubble sort. It uses a }

{ decreasing gap in order to compare values of more than one element }

{ apart. By decreasing the gap the array is gradually "combed" into }

{ order ... like combing your hair. First you get rid of the large }

{ tangles, then the smaller ones ... }

{ }

{ There are a few particular things about the combsort. Firstly, the }

{ optimal shrink factor is 1.3 (worked out through a process of }

{ exhaustion by the guys at BYTE magazine). Secondly, by never }

{ having a gap of 9 or 10, but always using 11, the sort is faster. }

{ }

{ This sort approximates an n log n sort - it's faster than any }

{ other sort I've seen except the quicksort (and it beats that too }

{ sometimes ... have you ever seen a quicksort become an (n-1)^2 }

{ sort ... ?). The combsort does not slow down under *any* }

{ circumstances. In fact, on partially sorted lists (including }

{ *reverse* sorted lists) it speeds up. }

{ }

{ More information in the April 1991 BYTE magazine. }

CONST ShrinkFactor = 1.3;

VAR Gap, i : LongInt;

Finished : Boolean;

BEGIN

Gap := Round((ACollection^.Count-1)/ShrinkFactor);

WITH ACollection^ DO

REPEAT

Finished := TRUE;

Gap := Trunc(Gap/ShrinkFactor);

IF Gap < 1

THEN Gap := 1

ELSE IF ((Gap = 9) OR (Gap = 10))

THEN Gap := 11;

FOR i := 0 TO ((Count - 1) - Gap) DO

IF Compare(At(i),At(i+Gap)) = 1

THEN BEGIN

Swap(ACollection,i,i+gap);

Finished := False;

END;

UNTIL ((Gap = 1) AND Finished);

END;

{****************************************************************************}

PROCEDURE HeapSort (ACollection : PCollection; Compare : TCompareFunction);

{ Performs best when items are in inverse order. }

VAR L, R : LongInt;

X : Pointer;

{*****************************************}

PROCEDURE Sift;

VAR i, j : LongInt;

Label 13;

BEGIN

i := L;

j := 2 * i;

X := ACollection^.At(i);

WITH ACollection^ DO

WHILE j <= R DO

BEGIN

IF j < R

THEN IF Compare(At(j),At(j+1)) = -1

THEN Inc(j);

IF Compare(X,At(j)) >= 0

THEN GoTo 13;

AtPut(i,At(j));

i := j;

j := 2 * i;

END;

13: ACollection^.AtPut(i,X);

END;

{*****************************************}

BEGIN

L := ((ACollection^.Count - 1) DIV 2) + 1;

R := ACollection^.Count - 1;

WHILE L > 0 DO

BEGIN

Dec(L);

Sift;

END;

WHILE R > 0 DO

BEGIN

X := ACollection^.At(1);

Swap(ACollection,0,R);

Dec(R);

Sift;

END;

{****************************************************************************}

PROCEDURE QuickSort (ACollection : PCollection; Compare : TCompareFunction);

{****************************************************************}

PROCEDURE Sort (Left, Right : LongInt);

VAR i, j : LongInt;

X : Pointer;

BEGIN

WITH ACollection^ DO

BEGIN

i := Left;

j := Right;

X := At((Left + Right) DIV 2);

REPEAT

WHILE Compare(At(i),X) = -1 DO Inc(i);

WHILE Compare(X,At(j)) = -1 DO Dec(j);

IF i <= j

THEN BEGIN

Swap(ACollection,i,j);

Inc(i);

Dec(j)

END;

UNTIL i > j;

IF Left < j

THEN Sort(Left,j);

IF i < Right

THEN Sort(i,Right)

END;

{****************************************************************}

BEGIN

Sort(0,ACollection^.Count-1);

END;

{****************************************************************************}

PROCEDURE QuickSortNonRecursive (ACollection : PCollection;

Compare : TCompareFunction);

CONST m = 12;

VAR i, j, L, R : LongInt;

x : Pointer;

s : 0..m;

Stack : ARRAY[1..m] OF RECORD

l, r : LongInt;

END;

BEGIN

s := 1;

Stack[1].l := 0;

Stack[1].r := ACollection^.Count - 1;

WITH ACollection^ DO

REPEAT

L := Stack[s].l;

R := Stack[s].r;

Dec(S);

REPEAT

i := L;

j := R;

x := At((L + R) DIV 2);

REPEAT

WHILE Compare(x,At(i)) = 1 DO Inc(i);

WHILE Compare(x,At(j)) = -1 DO Dec(j);

IF i <= j

THEN BEGIN

Swap(ACollection,i,j);

Inc(i);

Dec(j);

END;

UNTIL i > j;

IF i < R

THEN BEGIN

Inc(s);

Stack[s].l := i;

Stack[s].r := R;

END;

R := j;

UNTIL L >= R;

UNTIL s = 0;

END;

{****************************************************************************}

PROCEDURE ShakerSort (ACollection : PCollection; Compare : TCompareFunction);

{ Works for any array and any index range. }

VAR j, k, Left, Right : LongInt;

BEGIN

Left := 1;

Right := (ACollection^.Count - 1);

k := Right;

WITH ACollection^ DO

REPEAT

FOR j := Right DOWNTO Left DO

IF Compare(At(j-1),At(j)) = 1

THEN BEGIN

Swap(ACollection,j,j-1);

k := j;

END;

Left := k + 1;

FOR j := Left TO Right DO

IF Compare(At(j-1),At(j)) = 1

THEN BEGIN

Swap(ACollection,j,j-1);

k := j;

END;

Right := k - 1;

UNTIL Left > Right;

END;

{****************************************************************************}

PROCEDURE ShellSort (ACollection : PCollection; Compare : TCompareFunction);

VAR Gap, i, j, k : LongInt;

BEGIN

Gap := (ACollection^.Count - 1) DIV 2;

WHILE (Gap > 0) DO

BEGIN

FOR i := Gap TO (ACollection^.Count - 1) DO

BEGIN

j := i - Gap;

WHILE (j > -1) DO

BEGIN

k := j + Gap;

IF Compare(ACollection^.At(j),ACollection^.At(k)) < 1

THEN j := 0

ELSE Swap(ACollection,j,k);

Dec(j,Gap);

END;

Gap := Gap DIV 2;

END;

{****************************************************************************}

PROCEDURE StraightInsertionSort (ACollection : PCollection;

Compare : TCompareFunction);

VAR i, j : LongInt;

X : Pointer;

BEGIN

WITH ACollection^ DO

FOR i := 0 TO (Count - 1) DO

BEGIN

X := At(i);

j := i;

WHILE (j > 0) AND (Compare(X,At(j-1)) = -1) DO

BEGIN

AtPut(j,At(j-1));

Dec(j);

END;

AtPut(j,X);

END;

{****************************************************************************}

PROCEDURE StraightSelectionSort (ACollection : PCollection;

Compare : TCompareFunction);

VAR i, j, k : LongInt;

BEGIN

FOR i := 0 TO (ACollection^.Count - 1) DO

BEGIN

k := i;

FOR j := (i + 1) TO (ACollection^.Count - 1) DO

IF Compare(ACollection^.At(j),ACollection^.At(k)) = -1

THEN k := j;

Swap(ACollection,i,k);

END;

{****************************************************************************}

PROCEDURE TreeSort (ACollection : PCollection; Compare : TCompareFunction);

{after D.Cooke, A.H.Craven, G.M.Clarke: Statistical Computing

in Pascal, Publisher: Edward Arnold, London 1985 ISBN 0-7131-3545-X }

TYPE PNode = ^Node;

Node = RECORD

Value : Pointer;

Left : PNode;

Right : PNode;

END;

VAR Add, Top : PNode;

i : LongInt;

{***********************************************************}

PROCEDURE MakeTree (VAR Node : PNode);

BEGIN

IF Node = NIL

THEN Node := Add

ELSE IF Compare(Add^.Value,Node^.Value) = 1

THEN MakeTree(Node^.Right)

ELSE MakeTree(Node^.Left);

END;

{**********************************************************}

PROCEDURE StripTree (Node : PNode);

BEGIN

IF Node <> NIL

THEN BEGIN

StripTree(Node^.Left);

ACollection^.AtPut(i,Node^.Value);

Inc(i);

StripTree(Node^.Right)

END;

{**********************************************************}

BEGIN

Top := NIL;

FOR i := 0 TO (ACollection^.Count - 1) DO

BEGIN

New(Add);

Add^.Value := ACollection^.At(i);

Add^.Left := NIL;

Add^.Right := NIL;

MakeTree(Top)

END;

i := 0;

StripTree(Top)

END;

{****************************************************************************}

{ }

{ Compare Procedures }

{ }

{****************************************************************************}

FUNCTION CompareChars (Item1, Item2 : Pointer) : Integer;

BEGIN

IF Char(Item1^) < Char(Item2^)

THEN CompareChars := -1

ELSE CompareChars := Ord(Char(Item1^) <> Char(Item2^));

END;

{*****************************************************************************}

FUNCTION CompareInts (Item1, Item2 : Pointer) : Integer;

BEGIN

IF Integer(Item1^) < Integer(Item2^)

THEN CompareInts := -1

ELSE CompareInts := Ord(Integer(Item1^) <> Integer(Item2^));

END;

{*****************************************************************************}

FUNCTION CompareLongInts (Item1, Item2 : Pointer) : Integer;

BEGIN

IF LongInt(Item1^) < LongInt(Item2^)

THEN CompareLongInts := -1

ELSE CompareLongInts := Ord(LongInt(Item1^) <> LongInt(Item2^));

END;

{*****************************************************************************}

FUNCTION CompareReals (Item1, Item2 : Pointer) : Integer;

BEGIN

IF Real(Item1^) < Real(Item2^)

THEN CompareReals := -1

ELSE CompareReals := Ord(Real(Item1^) <> Real(Item2^));

END;

{*****************************************************************************}

FUNCTION CompareStrs (Item1, Item2 : Pointer) : Integer;

BEGIN

IF String(Item1^) < String(Item2^)

THEN CompareStrs := -1

ELSE CompareStrs := Ord(String(Item1^) <> String(Item2^));

END;

{*****************************************************************************}

BEGIN

END.

Algoritmi Kursam “Pamatalgoritmi” (1998)

1. Steka reprezentācija nepārtrauktā atmiņā.

7. Aritmētiku izteiksmi, kas reprezentēta ar koku, var izrēķināt ar funkciju Evaluate.

Nav komentāru:

Ierakstīt komentāru

7.
Aritmētiku izteiksmi, kas reprezentēta ar koku, var izrēķināt ar funkciju Evaluate.