Jump to content
BulForum.com

Pomo6t za edin algoritym

PSYCHOSIS

By PSYCHOSIS
in Разни

Recommended Posts

PSYCHOSIS Jedi Master

PSYCHOSIS

Posted
Posted

Ako nqkoi moje da mi pomogne s tova ne6to, 6te sym mu mnogo blagodaren, za6toto s Pascal ne se opravqm tolkova dobre, kolkoto mi se iska. Vsy6tnost hi4 ne se opravqm :) Ta ideqta e na tozi algoritym da se napi6e komentar za otdelnite proceduri za sortirane - kak to4no stava sortiraneto. Eto go i samiqt algoritym: (baq dylyg e, no mi se struva, 4e za nqkoi navytre v ne6tata 6te se stori mnogo prost). 10x in advance!

 

Program Sorting;

Uses CRT;

Const NMax = 100;

Type Item = Record

key : Integer;

{ razni }

End;

Index = 0..NMax;

Arr = Array [index] of Item;

Var Data : Arr;

N : Index;

ch : Byte;

 

Procedure Input ( Var a : Arr; Var n : Index );

{ Vhod na masiva }

Var i : Index;

ch : char;

Begin

clrscr;

Writeln;

Write(' Broi elementi N = '); Readln(n);

Writeln;

Writeln(' Ot klaviatura - 1');

Writeln(' Sluchaini chisla - 2');

Writeln;

Write(' Izborat e : '); Readln(ch);

Case ch Of

'1' : For i := 1 To n Do

Begin

Write(' A[', i:2, ']= '); Readln(a.key);

End;

'2' : For i := 1 To n Do

Begin

Write(' A[', i:2, ']= ');

a.key := Random(256) * Random(100) div 2;

Writeln(a.key);

End;

End;

Readln

End; { Input }

 

Procedure Output ( Var a : Arr; n : Index );

{ Izvejdane na masiva }

Var i : Index;

Begin

clrscr;

Writeln;

Writeln;

For i := 1 To n Do

Writeln(' A[', i:2, ']= ', a.key);

Readln

End; { Output }

 

Procedure BubleSort ( Var a : Arr; n : Index );

{ metod na priaka razmiana (mehurcheto) }

Var i, j : Index;

help : Item;

Begin

For i := 2 To n Do

For j := n Downto i Do

If a[j-1].key > a[j].key Then

Begin

help := a[j-1];

a[j-1] := a[j];

a[j] := help

End

End; { BubleSort }

{ C = 1/2(n^2-n) C-sravnenia

Mmin = 0 M-dvigenia

Mave = 3/4(n^2-n)

Mmax = 3/2(n^2-n) }

 

Procedure BubleSort_Flag ( Var a : Arr; n : Index );

Var i, j : Index;

help : Item;

flag : Boolean;

Begin

i := 2;

flag := True;

While flag Do

Begin

flag := False;

For j := n Downto i Do

If a[j-1].key > a[j].key Then

Begin

help := a[j-1];

a[j-1] := a[j];

a[j] := help;

flag := True

End;

i := i+1;

End

End; { BubleSort_Flag }

 

Procedure ShakerSort ( Var a : Arr; n : Index );

{ malko podobrenie na metoda na priakata razmiana -

metod chrez klatene }

Var j, k, left, right : Index;

help : Item;

Begin

left := 2;

right := n;

k := n;

Repeat

For j := k Downto left Do

If a[j-1].key > a[j].key Then

Begin

help := a[j-1];

a[j-1] := a[j];

a[j] := help;

k := j

End;

left := k+1;

For j:= left To right Do

If a[j-1].key > a[j].key Then

Begin

help := a[j-1];

a[j-1] := a[j];

a[j] := help;

k := j

End;

right := k-1;

Until left > right

End; { ShakeBSort }

{ Cmin = n-1

Cave = 1/2(n^2-n(k2+ln(n)))

Sredna stoinost na preminavaniata = n-k1sqrt(n) }

 

Procedure StraightInsertion ( Var a : Arr; n : Index);

{ Metod na priakoto vmakvane }

Var i, j : Index;

help : Item;

Begin

For i := 2 To n Do

Begin

help := a;

a[0] := help;

j := i-1;

While help.key < a[j].key Do

Begin

a[j+1] := a[j];

j := j-1

End;

a[j+1] := help

End

End; { StraightInsertion }

{ Cmin = n-1 Cave = 1/4*(n^2+n-2) Cmax = 1/2(n^2+n)+1

Mmin = 2(n-1) Mave = 1/4(n^2+9n-10)

Mmax = 1/2(n^2+3n-4) }

 

Procedure BinaryInsertion ( Var a : Arr; n : Index );

{ dvoichno vmakvane - redicata na mestonaznachenieto e veche podredena }

Var i, j, left, right, ave : Index;

help : Item;

Begin

For i := 2 To n Do

Begin

help := a; left := 1; Right := i-1;

While left <= right Do

Begin

ave := (left + right) div 2;

If help.key < a[ave].key Then right := ave-1

Else left := ave+1

End;

For j := i-1 downto left Do a[j+1] := a[j];

a

:= help

End

End; { BinaryInsertion }

{ podobrenieto e samo v C = n(log(n)-log(e)+-0.5) }

 

Procedure ShellSort ( Var b : Arr; n : Index );

{ metod na Shell - priako vmakvane s namaliava stapka }

Const t = 4; { t - broi na stapkite }

Var i, j, k, s : Index; { h - masiv sas stapkite - h > h[i+1] }

help : Item; { m - broiach za cikala na stapkite }

m : 1..t; { s - pozicia na ogranicitelia }

h : Array [1..t] Of Integer; { k - tekushta stapka }

a : Array [-9..NMax] Of Item;

Begin

For i := 1 To n Do a := b;

h[1] := 9; h[2] := 5; h[3] := 3; h[4] := 1;

For m := 1 To t Do

Begin

k := h[m]; s := -k;

For i := k+1 To n Do

Begin

help := a; j := i-k;

If s = 0 Then s := -k;

s := s+1; a := help;

While help.key < a[j].key Do

Begin

a[j+k] := a[j]; j := j-k

End;

a[j+k] := help

End

End;

For i := 1 To n Do b := a

End; { ShellSort }

 

Procedure StraightSelection ( Var a : Arr; n : Index );

{ metod na priakata razmiana }

Var i, j, k : Index;

help : Item;

Begin

For i := 1 To n Do

Begin

help := a;

k := i;

For j := i+1 To n Do

If a[j].key < help.key Then

Begin

help := a[j];

k := j

End;

a[k] := a;

a := help

End

End; { StraightSelection }

{ C = 1/2(n^2-n)

Mmin = 3(n-1)

Mmax = trunk(n^2/4)+3(n-1)

Mave = n(ln(n)+ gama) gama= 0,5772 }

 

Procedure QuickSort ( Var a : Arr; n : Index );

{ metod na Hoare - metod na bazata na razmianata }

Procedure Sort ( left, right : Index );

Var i, j : Index;

help, ave : Item;

Begin

i := left;

j := right;

ave := a[(left+right) div 2];

Repeat

While a.key < ave.key Do i := i+1;

While a[j].key > ave.key Do j := j-1;

If i <= j Then

Begin

help := a;

a := a[j];

a[j] := help;

i := i+1;

j := j-1

End;

 

Until i > j;

If left < j Then Sort(left, j);

If i < right Then Sort(i, right)

End; { Sort }

Begin

Sort(1,n)

End; { QuickSort }

{ Razdelianeto:

C = n

M = n/6 -1/(6n)

Sortiraneto:

Moptimum = log(n)

Overall:

Coptimum = n*log(n)

Moptimum = n/6*log(n)

Nai - losho n^2

Sredno 2*ln2 }

 

Procedure Find ( Var a : Arr; n : Index; aveind : Index );

{ podobriavane na tarseneto na srednia element -

algoritam na Hoare }

Var left, right, i, j : Index;

ave, help : Item;

Begin

left := 1;

right := n;

While left < right Do

Begin

ave := a[aveind];

i := left;

j := right;

Repeat

While a.key < ave.key Do i := i+1;

While a[j].key > ave.key Do j := j-1;

If i <= j Then

Begin

help := a;

a := a[j];

a[j] := help;

i := i+1;

j := j-1

End;

Until i > j;

If j < aveind Then left := i;

If aveind < i Then right := j;

End

End; { Find }

 

{ Coptimum = 2n

Cmax = n^2 }

 

Procedure HeapSort ( Var a : Arr; n : Index);

{ piramidalno sortirane - bazira se na selekciata }

Var left, right : Index;

help : Item;

Procedure Sift;

{ Otsiavane }

Label 13;

Var i, j : Index;

Begin

i := left;

j := 2*i;

help := a;

While j <= right Do

Begin

If j < right Then

If a[j].key < a[j+1].key Then j := j+1;

If help.key >= a[j].key Then Goto 13;

a := a[j];

i := j;

j := 2*i

End;

13: a := help

End; { Sift }

Begin

left := n div 2 + 1; { generirane na piramidata na miasto }

right := n;

While left > 1 Do

Begin

left := left-1;

Sift;

End;

While right > 1 Do { sortirane }

Begin

help := a[1];

a[1] := a

;

a

:= help;

right := right-1;

Sift

End

End; { HeapSort }

 

{ Cave = 1/2*n*log(n) }

 

Procedure MergeSort ( Var a : Arr; n : Index);

{ priako slivane }

Var i, j, k, l, t : Index; { i,j - ind na nachalnite elementi }

h, m, p, q, r : Integer; { k,l - dvete mestonaznachenia }

up : Boolean; { p - daljina na redichite, koito ste se slivat }

Begin { h - stapkata +-1, t.k. K i L se smeniat alternativno sled vsiako obediniavane }

up := True; { up - posoka na potoka ot danni }

p := 1; { m - broi na elementite za slivane }

Repeat { q,r - daljini saotvetno na I-ta i J-ta seria }

h := 1; m := n;

If up Then { inicializirane na indeksite }

Begin

i := 1; j := n;

k := n+1; l := 2*n

End

Else

Begin

i := n+1; j := 2*n;

k := 1; l := n;

End;

Repeat { obediniavane na seria ot I i J do K }

If m >= p Then q := p

Else q := m;

m := m-q;

If m >= p Then r := p

Else r := m;

m := m-r;

While (q <> 0) and (r <> 0) Do { obediniavane }

Begin

If a.key < a[j].key Then

Begin

a[k] := a; k := k+h;

i := i+1; q := q-1

End

Else

Begin

a[k] := a[j]; k := k+h;

j := j-1; r := r-1

End

End; { While }

While r <> 0 Do { kopirane kraia na J-ta seria }

Begin

a[k] := a[j]; k := k+h;

j := j-1; r := r-1

End;

While q <> 0 Do { kopirane kraia na I-ta seria }

Begin

a[k] := a; k := k+h;

i := i+1; q := q-1

End;

h := -h;

t := k; k := l; l := t;

Until m = 0;

up := not up;

p := 2*p;

Until p >= n;

If not up Then For i := 1 To n Do a := a[i+n]

End; { MergeSort }

{ M = n*log(n)

C e dori po-malko ot M }

 

Begin

Repeat

Clrscr;

Writeln;

Writeln(' Izberete :');

Writeln;

Writeln(' 1 Input');

Writeln(' 2 Output');

Writeln(' 3 BubleSort');

Writeln(' 4 BubleSort_Flag');

Writeln(' 5 ShakerSort');

Writeln(' 6 StraightSelection');

Writeln(' 7 QuickSort');

Writeln(' 8 HeapSort');

Writeln(' 9 MergeSort');

Writeln(' 10 StraightInsertion');

Writeln(' 11 BinaryInsertion');

Writeln(' 12 ShellSort');

Writeln(' 0 Exit');

Writeln;

Write(' Iborat e : '); Readln(ch);

Case ch Of

1 : Input(Data,N);

2 : Output(Data,N);

3 : Begin

BubleSort(Data,N);

Output(Data,N)

End;

4 : Begin

Bublesort_Flag(Data,N);

Output(Data,N)

End;

5 : Begin

ShakerSort(Data,N);

Output(Data,N)

End;

6 : Begin

StraightSelection(Data,N);

Output(Data,N)

End;

7 : Begin

QuickSort(Data,N);

Output(Data,N)

End;

8 : Begin

HeapSort(Data,N);

Output(Data,N)

End;

9 : Begin

MergeSort(Data,N);

Output(Data,N)

End;

10 : Begin

StraightInsertion(Data,N);

Output(Data,N)

End;

11 : Begin

BinaryInsertion(Data,N);

Output(Data,N)

End;

12 : Begin

ShellSort(Data,N);

Output(Data,N)

End;

End;

Until ch = 0

End.

Link to comment
Share on other sites
sasquatch Гуру

sasquatch

Posted
Posted

Ми то така като гледам не е само един а са няколко алгоритъма, всичките класика в жанра :)Има една книга - Алгоритми на C или нещо такова беше има я в Хеликон на главната под Джумаята - там ги има описани повечето от тея алгоритми, има и една бъклгарска книга за алгоритми на Преслав Наков от СУ наскоро си я купих - Програмиране=++Алгоритми;, там също можеш да прочетеш за тези алгоритми, както и за още много други.Хубавото е че имаше и доста писано за алгоритмите изобщо, абе направо rulez (хехе и без това са я преписали от други книги :) ). Aко ще се занимаваш сериозно направо си купувай някоя от двете.

edit:има и една друга книга пак на Преслав Наков - Основи на компютърните алгоритми значи там във втора част ги има описани всичките тея алгоритми за сортиране + още други и примерите са на Pascal, но нея освен от някоя библиотека май няма откъде да я намериш

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.

Go to topic listing
×
×
  • Create New...